(let ((bare (bare-symbol arg))
(beg (scope-sym-pos arg)))
(cond
- ((functionp bare)
+ ((or (functionp bare) scope-assume-func-p)
(when beg
(funcall scope-callback 'function beg (length (symbol-name bare)) nil)))
((or (assq bare scope-flet-alist) (consp arg))
(memq macro scope-safe-macros)
(get macro 'safe-macro)))
+(defvar warning-minimum-log-level)
+
(defun scope-1 (local form &optional top-level)
(cond
((consp form)
'((static-if) (rx) (cl-eval-when)
(eval-when-compile) (eval-and-compile))
macroexpand-all-environment))
- (macroexp-inhibit-compiler-macros t))
+ (macroexp-inhibit-compiler-macros t)
+ (warning-minimum-log-level :emergency))
(macroexpand-1 form macroexpand-all-environment))))))))
;; Assume nothing about unknown top-level forms.
- (top-level nil)
- (scope-assume-func-p (scope-n local forms))))))
+ (top-level
+ (when (symbol-with-pos-p f)
+ (funcall scope-callback 'top-level
+ (symbol-with-pos-pos f) (length (symbol-name bare))
+ nil)))
+ (scope-assume-func-p
+ (when (symbol-with-pos-p f)
+ (funcall scope-callback 'function
+ (symbol-with-pos-pos f) (length (symbol-name bare))
+ nil))
+ (scope-n local forms))))))
((symbol-with-pos-p form) (scope-s local form))))
(defun scope-n (local body) (dolist (form body) (scope-1 local form)))
(boundp (intern-soft (symbol-name sym))))
(defun elisp-completion-at-point ()
- "Function used for `completion-at-point-functions' in `emacs-lisp-mode'.
-If the context at point allows only a certain category of
-symbols (e.g. functions, or variables) then the returned
-completions are restricted to that category. In contexts where
-any symbol is possible (following a quote, for example),
-functions are annotated with \"<f>\" via the
-`:annotation-function' property."
(with-syntax-table emacs-lisp-mode-syntax-table
- (let* ((pos (point))
- (beg (condition-case nil
- (save-excursion
- (backward-sexp 1)
- (skip-chars-forward "`',‘#")
- (min (point) pos))
- (scan-error pos)))
- (end
- (cond
- ((and (< beg (point-max))
- (memq (char-syntax (char-after beg))
- '(?w ?\\ ?_)))
- (condition-case nil
- (save-excursion
- (goto-char beg)
- (forward-sexp 1)
- (skip-chars-backward "'’")
- (when (>= (point) pos)
- (point)))
- (scan-error pos)))
- ((or (>= beg (point-max))
- (memq (char-syntax (char-after beg))
- '(?\) ?\s)))
- beg)))
- ;; t if in function position.
- (funpos (eq (char-before beg) ?\())
- (quoted (elisp--form-quoted-p beg))
- (is-ignore-error
- (condition-case nil
- (save-excursion
- (up-list -1)
- (forward-char 1)
- (looking-at-p "ignore-error\\>"))
- (error nil))))
- (when (and end (or (not (nth 8 (syntax-ppss)))
- (memq (char-before beg) '(?` ?‘))))
- (let ((table-etc
- (if (or (not funpos) quoted)
- (cond
- ;; FIXME: We could look at the first element of
- ;; the current form and use it to provide a more
- ;; specific completion table in more cases.
- (is-ignore-error
- (list t (elisp--completion-local-symbols)
- :predicate (lambda (sym)
- (get sym 'error-conditions))))
- ((elisp--expect-function-p beg)
- (list nil (elisp--completion-local-symbols)
- :predicate
- #'elisp--shorthand-aware-fboundp
- :company-kind #'elisp--company-kind
- :company-doc-buffer #'elisp--company-doc-buffer
- :company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location
- :company-deprecated #'elisp--company-deprecated))
- (quoted
- (list nil (elisp--completion-local-symbols)
- ;; Don't include all symbols (bug#16646).
- :predicate (lambda (sym)
- ;; shorthand-aware
- (let ((sym (intern-soft (symbol-name sym))))
- (or (boundp sym)
- (fboundp sym)
- (featurep sym)
- (symbol-plist sym))))
- :annotation-function
- (lambda (str) (if (fboundp (intern-soft str)) " <f>"))
- :company-kind #'elisp--company-kind
- :company-doc-buffer #'elisp--company-doc-buffer
- :company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location
- :company-deprecated #'elisp--company-deprecated))
- (t
- (list nil (completion-table-merge
- elisp--local-variables-completion-table
- (apply-partially #'completion-table-with-predicate
- (elisp--completion-local-symbols)
- #'elisp--shorthand-aware-boundp
- 'strict))
- :company-kind
- (lambda (s)
- (if (test-completion s elisp--local-variables-completion-table)
- 'value
- 'variable))
- :company-doc-buffer #'elisp--company-doc-buffer
- :company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location
- :company-deprecated #'elisp--company-deprecated)))
- ;; 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 ?_))
- (let ((pt (point)))
- (forward-sexp)
- (intern-soft
- (buffer-substring pt (point))))))))
- (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
- nil))))) ; Copy both alists.
- ((and (or 'condition-case 'condition-case-unless-debug)
- (guard (save-excursion
- (ignore-errors
- (forward-sexp 2)
- (< (point) beg)))))
- (list t (elisp--completion-local-symbols)
- :predicate (lambda (sym) (get sym 'error-conditions))))
- ;; `ignore-error' with a list CONDITION parameter.
- ('ignore-error
- (list t (elisp--completion-local-symbols)
- :predicate (lambda (sym)
- (get sym 'error-conditions))))
- ((and (or ?\( 'let 'let*)
- (guard (save-excursion
- (goto-char (1- beg))
- (when (eq parent ?\()
- (up-list -1))
- (forward-symbol -1)
- (looking-at "\\_<let\\*?\\_>"))))
- (list t (elisp--completion-local-symbols)
- :predicate #'elisp--shorthand-aware-boundp
- :company-kind (lambda (_) 'variable)
- :company-doc-buffer #'elisp--company-doc-buffer
- :company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location
- :company-deprecated #'elisp--company-deprecated))
- (_ (list nil (elisp--completion-local-symbols)
- :predicate #'elisp--shorthand-aware-fboundp
- :company-kind #'elisp--company-kind
- :company-doc-buffer #'elisp--company-doc-buffer
- :company-docsig #'elisp--company-doc-string
- :company-location #'elisp--company-location
- :company-deprecated #'elisp--company-deprecated
- ))))))))
- (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)))))))))
+ (when-let ((pos (point))
+ (scope-assume-func-p t)
+ (predicate (cl-case (save-excursion
+ (goto-char pos)
+ (beginning-of-defun)
+ (catch 'sym-type
+ (scope (lambda (type beg len _bin)
+ (when (<= beg pos (+ beg len))
+ (throw 'sym-type type)))
+ (current-buffer))
+ nil))
+ ((variable constant) #'elisp--shorthand-aware-boundp)
+ ((function macro special-form top-level) #'elisp--shorthand-aware-fboundp)
+ ((nil) (lambda (sym)
+ (let ((sym (intern-soft (symbol-name sym))))
+ (or (boundp sym)
+ (fboundp sym)
+ (featurep sym)
+ (symbol-plist sym)))))))
+ (beg-end (bounds-of-thing-at-point 'symbol))
+ (beg (car beg-end))
+ (end (cdr beg-end)))
+ (list beg end (elisp--completion-local-symbols) :predicate predicate :exclusive 'no))))
(defun elisp--company-kind (str)
(let ((sym (intern-soft str)))
projects / emacs.git / commitdiff