diff options
author | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-09-26 23:57:41 -0400 |
---|---|---|
committer | Stefan Monnier <monnier@iro.umontreal.ca> | 2014-09-26 23:57:41 -0400 |
commit | e6cfa098ae23e34c5415642e2f848a92982924ef (patch) | |
tree | 99f569a54971a64e06420953928fb3bfcb803125 /lisp/emacs-lisp/lisp.el | |
parent | 6a19cde634d233f44c8db61ae4f6d54c07e277fb (diff) | |
download | emacs-e6cfa098ae23e34c5415642e2f848a92982924ef.tar.gz |
Introduce global-eldoc-mode. Move Elisp-specific code to elisp-mode.el.
* lisp/emacs-lisp/eldoc.el (global-eldoc-mode): New minor mode.
(eldoc-schedule-timer): Obey it.
(eldoc-documentation-function): Default to nil.
(eldoc-mode): Don't enable if eldoc-documentation-function is not set.
(eldoc-documentation-function-default, eldoc-get-fnsym-args-string)
(eldoc-highlight-function-argument, eldoc-get-var-docstring)
(eldoc-last-data-store, eldoc-docstring-first-line)
(eldoc-docstring-format-sym-doc, eldoc-fnsym-in-current-sexp)
(eldoc-beginning-of-sexp, eldoc-current-symbol)
(eldoc-function-argstring): Move to elisp-mode.el.
(eldoc-symbol-function): Remove, unused.
* lisp/progmodes/elisp-mode.el: New file. Rename all "eldoc-*" to "elisp--*".
(elisp-completion-at-point): Rename from lisp-completion-at-point.
(elisp--preceding-sexp): Rename from preceding-sexp.
* lisp/loadup.el: Load new file progmodes/elisp-mode.
* lisp/ielm.el (inferior-emacs-lisp-mode): Set eldoc-documentation-function.
* lisp/emacs-lisp/lisp.el (lisp--local-variables-1, lisp--local-variables)
(lisp--local-variables-completion-table, lisp--expect-function-p)
(lisp--form-quoted-p, lisp--company-doc-buffer)
(lisp--company-doc-string, lisp--company-location)
(lisp-completion-at-point): Move to elisp-mode.el.
* lisp/emacs-lisp/lisp-mode.el (lisp--mode-syntax-table): New syntax-table,
extracted from emacs-lisp-mode-syntax-table.
(emacs-lisp-mode-abbrev-table, emacs-lisp-mode-syntax-table): Move to
elisp-mode.el.
(lisp-imenu-generic-expression): Add comments to document what comes
from which Lisp dialect.
(emacs-lisp-mode-map, emacs-lisp-byte-compile)
(emacs-lisp-byte-compile-and-load, emacs-lisp-mode-hook)
(emacs-lisp-mode, emacs-list-byte-code-comment-re)
(emacs-lisp-byte-code-comment)
(emacs-lisp-byte-code-syntax-propertize, emacs-lisp-byte-code-mode)
(lisp-interaction-mode-map, lisp-interaction-mode)
(eval-print-last-sexp, last-sexp-setup-props)
(last-sexp-toggle-display, prin1-char, preceding-sexp)
(eval-last-sexp-1, eval-last-sexp-print-value)
(eval-last-sexp-fake-value, eval-sexp-add-defvars, eval-last-sexp)
(eval-defun-1, eval-defun-2, eval-defun): Move to elisp-mode.el.
* src/lisp.mk (lisp): Add elisp-mode.elc.
Diffstat (limited to 'lisp/emacs-lisp/lisp.el')
-rw-r--r-- | lisp/emacs-lisp/lisp.el | 300 |
1 files changed, 0 insertions, 300 deletions
diff --git a/lisp/emacs-lisp/lisp.el b/lisp/emacs-lisp/lisp.el index 7e5f47b80b7..31682d036bf 100644 --- a/lisp/emacs-lisp/lisp.el +++ b/lisp/emacs-lisp/lisp.el @@ -758,304 +758,4 @@ considered." (completion-in-region (nth 0 data) (nth 1 data) (nth 2 data) (plist-get plist :predicate)))))) -(defun lisp--local-variables-1 (vars sexp) - "Return the vars locally bound around the witness, or nil if not found." - (let (res) - (while - (unless - (setq res - (pcase sexp - (`(,(or `let `let*) ,bindings) - (let ((vars vars)) - (when (eq 'let* (car sexp)) - (dolist (binding (cdr (reverse bindings))) - (push (or (car-safe binding) binding) vars))) - (lisp--local-variables-1 - vars (car (cdr-safe (car (last bindings))))))) - (`(,(or `let `let*) ,bindings . ,body) - (let ((vars vars)) - (dolist (binding bindings) - (push (or (car-safe binding) binding) vars)) - (lisp--local-variables-1 vars (car (last body))))) - (`(lambda ,_) (setq sexp nil)) - (`(lambda ,args . ,body) - (lisp--local-variables-1 - (append args vars) (car (last body)))) - (`(condition-case ,_ ,e) (lisp--local-variables-1 vars e)) - (`(condition-case ,v ,_ . ,catches) - (lisp--local-variables-1 - (cons v vars) (cdr (car (last catches))))) - (`(,_ . ,_) - (lisp--local-variables-1 vars (car (last sexp)))) - (`lisp--witness--lisp (or vars '(nil))) - (_ nil))) - (setq sexp (ignore-errors (butlast sexp))))) - res)) - -(defun lisp--local-variables () - "Return a list of locally let-bound variables at point." - (save-excursion - (skip-syntax-backward "w_") - (let* ((ppss (syntax-ppss)) - (txt (buffer-substring-no-properties (or (car (nth 9 ppss)) (point)) - (or (nth 8 ppss) (point)))) - (closer ())) - (dolist (p (nth 9 ppss)) - (push (cdr (syntax-after p)) closer)) - (setq closer (apply #'string closer)) - (let* ((sexp (condition-case nil - (car (read-from-string - (concat txt "lisp--witness--lisp" closer))) - (end-of-file nil))) - (macroexpand-advice (lambda (expander form &rest args) - (condition-case nil - (apply expander form args) - (error form)))) - (sexp - (unwind-protect - (progn - (advice-add 'macroexpand :around macroexpand-advice) - (macroexpand-all sexp)) - (advice-remove 'macroexpand macroexpand-advice))) - (vars (lisp--local-variables-1 nil sexp))) - (delq nil - (mapcar (lambda (var) - (and (symbolp var) - (not (string-match (symbol-name var) "\\`[&_]")) - ;; Eliminate uninterned vars. - (intern-soft var) - var)) - vars)))))) - -(defvar lisp--local-variables-completion-table - ;; Use `defvar' rather than `defconst' since defconst would purecopy this - ;; value, which would doubly fail: it would fail because purecopy can't - ;; handle the recursive bytecode object, and it would fail because it would - ;; move `lastpos' and `lastvars' to pure space where they'd be immutable! - (let ((lastpos nil) (lastvars nil)) - (letrec ((hookfun (lambda () - (setq lastpos nil) - (remove-hook 'post-command-hook hookfun)))) - (completion-table-dynamic - (lambda (_string) - (save-excursion - (skip-syntax-backward "_w") - (let ((newpos (cons (point) (current-buffer)))) - (unless (equal lastpos newpos) - (add-hook 'post-command-hook hookfun) - (setq lastpos newpos) - (setq lastvars - (mapcar #'symbol-name (lisp--local-variables)))))) - lastvars))))) - -(defun lisp--expect-function-p (pos) - "Return non-nil if the symbol at point is expected to be a function." - (or - (and (eq (char-before pos) ?') - (eq (char-before (1- pos)) ?#)) - (save-excursion - (let ((parent (nth 1 (syntax-ppss pos)))) - (when parent - (goto-char parent) - (and - (looking-at (concat "(\\(cl-\\)?" - (regexp-opt '("declare-function" - "function" "defadvice" - "callf" "callf2" - "defsetf")) - "[ \t\r\n]+")) - (eq (match-end 0) pos))))))) - -(defun lisp--form-quoted-p (pos) - "Return non-nil if the form at POS is not evaluated. -It can be quoted, or be inside a quoted form." - ;; FIXME: Do some macro expansion maybe. - (save-excursion - (let ((state (syntax-ppss pos))) - (or (nth 8 state) ; Code inside strings usually isn't evaluated. - ;; FIXME: The 9th element is undocumented. - (let ((nesting (cons (point) (reverse (nth 9 state)))) - res) - (while (and nesting (not res)) - (goto-char (pop nesting)) - (cond - ((or (eq (char-after) ?\[) - (progn - (skip-chars-backward " ") - (memq (char-before) '(?' ?`)))) - (setq res t)) - ((eq (char-before) ?,) - (setq nesting nil)))) - res))))) - -;; FIXME: Support for Company brings in features which straddle eldoc. -;; We should consolidate this, so that major modes can provide all that -;; data all at once: -;; - a function to extract "the reference at point" (may be more complex -;; than a mere string, to distinguish various namespaces). -;; - a function to jump to such a reference. -;; - a function to show the signature/interface of such a reference. -;; - a function to build a help-buffer about that reference. -;; FIXME: Those functions should also be used by the normal completion code in -;; the *Completions* buffer. - -(defun lisp--company-doc-buffer (str) - (let ((symbol (intern-soft str))) - ;; FIXME: we really don't want to "display-buffer and then undo it". - (save-window-excursion - ;; Make sure we don't display it in another frame, otherwise - ;; save-window-excursion won't be able to undo it. - (let ((display-buffer-overriding-action - '(nil . ((inhibit-switch-frame . t))))) - (ignore-errors - (cond - ((fboundp symbol) (describe-function symbol)) - ((boundp symbol) (describe-variable symbol)) - ((featurep symbol) (describe-package symbol)) - ((facep symbol) (describe-face symbol)) - (t (signal 'user-error nil))) - (help-buffer)))))) - -(defun lisp--company-doc-string (str) - (let* ((symbol (intern-soft str)) - (doc (if (fboundp symbol) - (documentation symbol t) - (documentation-property symbol 'variable-documentation t)))) - (and (stringp doc) - (string-match ".*$" doc) - (match-string 0 doc)))) - -(declare-function find-library-name "find-func" (library)) - -(defun lisp--company-location (str) - (let ((sym (intern-soft str))) - (cond - ((fboundp sym) (find-definition-noselect sym nil)) - ((boundp sym) (find-definition-noselect sym 'defvar)) - ((featurep sym) - (require 'find-func) - (cons (find-file-noselect (find-library-name - (symbol-name sym))) - 0)) - ((facep sym) (find-definition-noselect sym 'defface))))) - -(defun lisp-completion-at-point (&optional _predicate) - "Function used for `completion-at-point-functions' in `emacs-lisp-mode'." - (with-syntax-table emacs-lisp-mode-syntax-table - (let* ((pos (point)) - (beg (condition-case nil - (save-excursion - (backward-sexp 1) - (skip-syntax-forward "'") - (point)) - (scan-error pos))) - (end - (unless (or (eq beg (point-max)) - (member (char-syntax (char-after beg)) - '(?\s ?\" ?\( ?\)))) - (condition-case nil - (save-excursion - (goto-char beg) - (forward-sexp 1) - (skip-chars-backward "'") - (when (>= (point) pos) - (point))) - (scan-error pos)))) - ;; t if in function position. - (funpos (eq (char-before beg) ?\())) - (when (and end (or (not (nth 8 (syntax-ppss))) - (eq (char-before beg) ?`))) - (let ((table-etc - (if (not funpos) - ;; FIXME: We could look at the first element of the list and - ;; use it to provide a more specific completion table in some - ;; cases. E.g. filter out keywords that are not understood by - ;; the macro/function being called. - (cond - ((lisp--expect-function-p beg) - (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - ((lisp--form-quoted-p beg) - (list nil obarray - ;; Don't include all symbols - ;; (bug#16646). - :predicate (lambda (sym) - (or (boundp sym) - (fboundp sym) - (symbol-plist sym))) - :annotation-function - (lambda (str) (if (fboundp (intern-soft str)) " <f>")) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (t - (list nil (completion-table-merge - lisp--local-variables-completion-table - (apply-partially #'completion-table-with-predicate - obarray - #'boundp - 'strict)) - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location))) - ;; Looks like a funcall position. Let's double check. - (save-excursion - (goto-char (1- beg)) - (let ((parent - (condition-case nil - (progn (up-list -1) (forward-char 1) - (let ((c (char-after))) - (if (eq c ?\() ?\( - (if (memq (char-syntax c) '(?w ?_)) - (read (current-buffer)))))) - (error nil)))) - (pcase parent - ;; FIXME: Rather than hardcode special cases here, - ;; we should use something like a symbol-property. - (`declare - (list t (mapcar (lambda (x) (symbol-name (car x))) - (delete-dups - ;; FIXME: We should include some - ;; docstring with each entry. - (append - macro-declarations-alist - defun-declarations-alist))))) - ((and (or `condition-case `condition-case-unless-debug) - (guard (save-excursion - (ignore-errors - (forward-sexp 2) - (< (point) beg))))) - (list t obarray - :predicate (lambda (sym) (get sym 'error-conditions)))) - ((and ?\( - (guard (save-excursion - (goto-char (1- beg)) - (up-list -1) - (forward-symbol -1) - (looking-at "\\_<let\\*?\\_>")))) - (list t obarray - :predicate #'boundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location)) - (_ (list nil obarray - :predicate #'fboundp - :company-doc-buffer #'lisp--company-doc-buffer - :company-docsig #'lisp--company-doc-string - :company-location #'lisp--company-location - )))))))) - (nconc (list beg end) - (if (null (car table-etc)) - (cdr table-etc) - (cons - (if (memq (char-syntax (or (char-after end) ?\s)) - '(?\s ?>)) - (cadr table-etc) - (apply-partially 'completion-table-with-terminator - " " (cadr table-etc))) - (cddr table-etc))))))))) - ;;; lisp.el ends here |