diff options
| author | Stefan Monnier | 2013-06-03 11:40:35 -0400 |
|---|---|---|
| committer | Stefan Monnier | 2013-06-03 11:40:35 -0400 |
| commit | bbcc4d97447a8a138c65bc94f800c0165f556610 (patch) | |
| tree | e977e8710fd79c681b7082a67e2244f84f9c00b5 | |
| parent | 1f8fdd5391e2346e181ab7cb19144d072efdc7f7 (diff) | |
| download | emacs-bbcc4d97447a8a138c65bc94f800c0165f556610.tar.gz emacs-bbcc4d97447a8a138c65bc94f800c0165f556610.zip | |
* lisp.el: Provide completion of locally bound variables in Elisp.
* lisp/emacs-lisp/lisp.el: Use lexical-binding.
(lisp--local-variables-1, lisp--local-variables): New functions.
(lisp--local-variables-completion-table): New var.
(lisp-completion-at-point): Use it to provide completion of let-bound vars.
| -rw-r--r-- | lisp/ChangeLog | 5 | ||||
| -rw-r--r-- | lisp/emacs-lisp/lisp.el | 104 |
2 files changed, 101 insertions, 8 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog index ac3dbcf906b..29c912933c8 100644 --- a/lisp/ChangeLog +++ b/lisp/ChangeLog | |||
| @@ -1,5 +1,10 @@ | |||
| 1 | 2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> | 1 | 2013-06-03 Stefan Monnier <monnier@iro.umontreal.ca> |
| 2 | 2 | ||
| 3 | * emacs-lisp/lisp.el: Use lexical-binding. | ||
| 4 | (lisp--local-variables-1, lisp--local-variables): New functions. | ||
| 5 | (lisp--local-variables-completion-table): New var. | ||
| 6 | (lisp-completion-at-point): Use it to provide completion of let-bound vars. | ||
| 7 | |||
| 3 | * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros | 8 | * emacs-lisp/lisp-mode.el (eval-sexp-add-defvars): Expand macros |
| 4 | eagerly (bug#14422). | 9 | eagerly (bug#14422). |
| 5 | 10 | ||
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index b221d2f823d..a31bef2391d 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el | |||
| @@ -1,4 +1,4 @@ | |||
| 1 | ;;; lisp.el --- Lisp editing commands for Emacs | 1 | ;;; lisp.el --- Lisp editing commands for Emacs -*- lexical-binding:t -*- |
| 2 | 2 | ||
| 3 | ;; Copyright (C) 1985-1986, 1994, 2000-2013 Free Software Foundation, | 3 | ;; Copyright (C) 1985-1986, 1994, 2000-2013 Free Software Foundation, |
| 4 | ;; Inc. | 4 | ;; Inc. |
| @@ -262,9 +262,9 @@ is called as a function to find the defun's beginning." | |||
| 262 | ;; convention, fallback on the old implementation. | 262 | ;; convention, fallback on the old implementation. |
| 263 | (wrong-number-of-arguments | 263 | (wrong-number-of-arguments |
| 264 | (if (> arg 0) | 264 | (if (> arg 0) |
| 265 | (dotimes (i arg) | 265 | (dotimes (_ arg) |
| 266 | (funcall beginning-of-defun-function)) | 266 | (funcall beginning-of-defun-function)) |
| 267 | (dotimes (i (- arg)) | 267 | (dotimes (_ (- arg)) |
| 268 | (funcall end-of-defun-function)))))) | 268 | (funcall end-of-defun-function)))))) |
| 269 | 269 | ||
| 270 | ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start) | 270 | ((or defun-prompt-regexp open-paren-in-column-0-is-defun-start) |
| @@ -442,7 +442,7 @@ it marks the next defun after the ones already marked." | |||
| 442 | (beginning-of-defun)) | 442 | (beginning-of-defun)) |
| 443 | (re-search-backward "^\n" (- (point) 1) t))))) | 443 | (re-search-backward "^\n" (- (point) 1) t))))) |
| 444 | 444 | ||
| 445 | (defun narrow-to-defun (&optional arg) | 445 | (defun narrow-to-defun (&optional _arg) |
| 446 | "Make text outside current defun invisible. | 446 | "Make text outside current defun invisible. |
| 447 | The defun visible is the one that contains point or follows point. | 447 | The defun visible is the one that contains point or follows point. |
| 448 | Optional ARG is ignored." | 448 | Optional ARG is ignored." |
| @@ -662,10 +662,96 @@ considered." | |||
| 662 | (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) | 662 | (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) |
| 663 | (plist-get plist :predicate)))))) | 663 | (plist-get plist :predicate)))))) |
| 664 | 664 | ||
| 665 | 665 | (defun lisp--local-variables-1 (vars sexp) | |
| 666 | (defun lisp-completion-at-point (&optional predicate) | 666 | "Return the vars locally bound around the witness, or nil if not found." |
| 667 | (let (res) | ||
| 668 | (while | ||
| 669 | (unless | ||
| 670 | (setq res | ||
| 671 | (pcase sexp | ||
| 672 | (`(,(or `let `let*) ,bindings) | ||
| 673 | (let ((vars vars)) | ||
| 674 | (when (eq 'let* (car sexp)) | ||
| 675 | (dolist (binding (cdr (reverse bindings))) | ||
| 676 | (push (or (car-safe binding) binding) vars))) | ||
| 677 | (lisp--local-variables-1 | ||
| 678 | vars (car (cdr-safe (car (last bindings))))))) | ||
| 679 | (`(,(or `let `let*) ,bindings . ,body) | ||
| 680 | (let ((vars vars)) | ||
| 681 | (dolist (binding bindings) | ||
| 682 | (push (or (car-safe binding) binding) vars)) | ||
| 683 | (lisp--local-variables-1 vars (car (last body))))) | ||
| 684 | (`(lambda ,_) (setq sexp nil)) | ||
| 685 | (`(lambda ,args . ,body) | ||
| 686 | (lisp--local-variables-1 | ||
| 687 | (append args vars) (car (last body)))) | ||
| 688 | (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e)) | ||
| 689 | (`(condition-case ,v ,_ . ,catches) | ||
| 690 | (lisp--local-variables-1 | ||
| 691 | (cons v vars) (cdr (car (last catches))))) | ||
| 692 | (`(,_ . ,_) | ||
| 693 | (lisp--local-variables-1 vars (car (last sexp)))) | ||
| 694 | (`lisp--witness--lisp (or vars '(nil))) | ||
| 695 | (_ nil))) | ||
| 696 | (setq sexp (ignore-errors (butlast sexp))))) | ||
| 697 | res)) | ||
| 698 | |||
| 699 | (defun lisp--local-variables () | ||
| 700 | "Return a list of locally let-bound variables at point." | ||
| 701 | (save-excursion | ||
| 702 | (skip-syntax-backward "w_") | ||
| 703 | (let* ((ppss (syntax-ppss)) | ||
| 704 | (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point)) | ||
| 705 | (or (nth 8 ppss) (point)))) | ||
| 706 | (closer ())) | ||
| 707 | (dolist (p (nth 9 ppss)) | ||
| 708 | (push (cdr (syntax-after p)) closer)) | ||
| 709 | (setq closer (apply #'string closer)) | ||
| 710 | (let* ((sexp (car (read-from-string | ||
| 711 | (concat txt "lisp--witness--lisp" closer)))) | ||
| 712 | (macroexpand-advice (lambda (expander form &rest args) | ||
| 713 | (condition-case nil | ||
| 714 | (apply expander form args) | ||
| 715 | (error form)))) | ||
| 716 | (sexp | ||
| 717 | (unwind-protect | ||
| 718 | (progn | ||
| 719 | (advice-add 'macroexpand :around macroexpand-advice) | ||
| 720 | (macroexpand-all sexp)) | ||
| 721 | (advice-remove 'macroexpand macroexpand-advice))) | ||
| 722 | (vars (lisp--local-variables-1 nil sexp))) | ||
| 723 | (delq nil | ||
| 724 | (mapcar (lambda (var) | ||
| 725 | (and (symbolp var) | ||
| 726 | (not (string-match (symbol-name var) "\\`[&_]")) | ||
| 727 | ;; Eliminate uninterned vars. | ||
| 728 | (intern-soft var) | ||
| 729 | var)) | ||
| 730 | vars)))))) | ||
| 731 | |||
| 732 | (defvar lisp--local-variables-completion-table | ||
| 733 | ;; Use `defvar' rather than `defconst' since defconst would purecopy this | ||
| 734 | ;; value, which would doubly fail: it would fail because purecopy can't | ||
| 735 | ;; handle the recursive bytecode object, and it would fail because it would | ||
| 736 | ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! | ||
| 737 | (let ((lastpos nil) (lastvars nil)) | ||
| 738 | (letrec ((hookfun (lambda () | ||
| 739 | (setq lastpos nil) | ||
| 740 | (remove-hook 'post-command-hook hookfun)))) | ||
| 741 | (completion-table-dynamic | ||
| 742 | (lambda (_string) | ||
| 743 | (save-excursion | ||
| 744 | (skip-syntax-backward "_w") | ||
| 745 | (let ((newpos (cons (point) (current-buffer)))) | ||
| 746 | (unless (equal lastpos newpos) | ||
| 747 | (add-hook 'post-command-hook hookfun) | ||
| 748 | (setq lastpos newpos) | ||
| 749 | (setq lastvars | ||
| 750 | (mapcar #'symbol-name (lisp--local-variables)))))) | ||
| 751 | lastvars))))) | ||
| 752 | |||
| 753 | (defun lisp-completion-at-point (&optional _predicate) | ||
| 667 | "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." | 754 | "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." |
| 668 | ;; FIXME: the `end' could be after point? | ||
| 669 | (with-syntax-table emacs-lisp-mode-syntax-table | 755 | (with-syntax-table emacs-lisp-mode-syntax-table |
| 670 | (let* ((pos (point)) | 756 | (let* ((pos (point)) |
| 671 | (beg (condition-case nil | 757 | (beg (condition-case nil |
| @@ -691,7 +777,9 @@ considered." | |||
| 691 | ;; use it to provide a more specific completion table in some | 777 | ;; use it to provide a more specific completion table in some |
| 692 | ;; cases. E.g. filter out keywords that are not understood by | 778 | ;; cases. E.g. filter out keywords that are not understood by |
| 693 | ;; the macro/function being called. | 779 | ;; the macro/function being called. |
| 694 | (list nil obarray ;Could be anything. | 780 | (list nil (completion-table-in-turn |
| 781 | lisp--local-variables-completion-table | ||
| 782 | obarray) ;Could be anything. | ||
| 695 | :annotation-function | 783 | :annotation-function |
| 696 | (lambda (str) (if (fboundp (intern-soft str)) " <f>"))) | 784 | (lambda (str) (if (fboundp (intern-soft str)) " <f>"))) |
| 697 | ;; Looks like a funcall position. Let's double check. | 785 | ;; Looks like a funcall position. Let's double check. |