[Emacs-diffs] trunk r117903: Make lisp-completion-at-point more discerning

[Dmitry Gutov]

------------------------------------------------------------
revno: 117903
revision-id: address@hidden
parent: address@hidden
committer: Dmitry Gutov <address@hidden>
branch nick: trunk
timestamp: Fri 2014-09-19 07:10:29 +0400
message:
  Make lisp-completion-at-point more discerning
  
  * lisp/emacs-lisp/lisp.el (lisp--expect-function-p)
  (lisp--form-quoted-p): New functions.
  (lisp-completion-at-point): Use them to see if we're completing a
  variable reference, a function name, or just any symbol.
  http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/emacs-lisp/lisp.el        lisp.el-20091113204419-o5vbwnq5f7feedwu-131

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2014-09-18 19:18:34 +0000
+++ b/lisp/ChangeLog    2014-09-19 03:10:29 +0000
@@ -1,3 +1,11 @@
+2014-09-19  Dmitry Gutov  <address@hidden>
+
+       * emacs-lisp/lisp.el (lisp--expect-function-p)
+       (lisp--form-quoted-p): New functions.
+       (lisp-completion-at-point): Use them to see if we're completing a
+       variable reference, a function name, or just any symbol.
+       http://lists.gnu.org/archive/html/emacs-devel/2014-02/msg00229.html
+
 2014-09-18  Ivan Kanis  <address@hidden>
 
        * net/shr.el, net/eww.el: Don't override `shr-width', but

=== modified file 'lisp/emacs-lisp/lisp.el'
--- a/lisp/emacs-lisp/lisp.el   2014-07-04 02:00:54 +0000
+++ b/lisp/emacs-lisp/lisp.el   2014-09-19 03:10:29 +0000
@@ -848,6 +848,46 @@
                      (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:
@@ -927,22 +967,41 @@
                 ;; 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.
-                (list nil (completion-table-merge
-                           lisp--local-variables-completion-table
-                           (apply-partially #'completion-table-with-predicate
-                                            obarray
-                                            ;; Don't include all symbols
-                                            ;; (bug#16646).
-                                            (lambda (sym)
-                                              (or (boundp sym)
-                                                  (fboundp sym)
-                                                  (symbol-plist sym)))
-                                            'strict))
+                (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 (completion-table-merge
+                             ;; FIXME: Is this table useful for this case?
+                             lisp--local-variables-completion-table
+                             (apply-partially #'completion-table-with-predicate
+                                              obarray
+                                              ;; Don't include all symbols
+                                              ;; (bug#16646).
+                                              (lambda (sym)
+                                                (or (boundp sym)
+                                                    (fboundp sym)
+                                                    (symbol-plist sym)))
+                                              'strict))
                       :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)
+                      :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))