]> code.delx.au - gnu-emacs-elpa/blobdiff - company.el
New transformer: company-sort-prefer-same-case-prefix
[gnu-emacs-elpa] / company.el
index 9c44f4b2c09a28e0f8a34777369338098aea3e1f..28ed56be3286e6ce640b75efdbc50323dd7d6a88 100644 (file)
@@ -45,8 +45,7 @@
 ;;
 ;; (defun company-my-backend (command &optional arg &rest ignored)
 ;;   (pcase command
-;;     (`prefix (when (looking-back "foo\\>")
-;;               (match-string 0)))
+;;     (`prefix (company-grab-symbol))
 ;;     (`candidates (list "foobar" "foobaz" "foobarbaz"))
 ;;     (`meta (format "This value is named %s" arg))))
 ;;
@@ -313,9 +312,10 @@ This doesn't include the margins and the scroll bar."
                               company-eclim company-semantic company-clang
                               company-xcode company-cmake
                               company-capf
+                              company-files
                               (company-dabbrev-code company-gtags company-etags
                                company-keywords)
-                              company-oddmuse company-files company-dabbrev)
+                              company-oddmuse company-dabbrev)
   "The list of active backends (completion engines).
 
 Only one backend is used at a time.  The choice depends on the order of
@@ -334,10 +334,10 @@ of the following:
 text immediately before point.  Returning nil from this command passes
 control to the next backend.  The function should return `stop' if it
 should complete but cannot (e.g. if it is in the middle of a string).
-Instead of a string, the backend may return a cons where car is the prefix
-and cdr is used instead of the actual prefix length in the comparison
-against `company-minimum-prefix-length'.  It must be either number or t,
-and in the latter case the test automatically succeeds.
+Instead of a string, the backend may return a cons (PREFIX . LENGTH)
+where LENGTH is a number used in place of PREFIX's length when
+comparing against `company-minimum-prefix-length'.  LENGTH can also
+be just t, and in the latter case the test automatically succeeds.
 
 `candidates': The second argument is the prefix to be completed.  The
 return value should be a list of candidates that match the prefix.
@@ -432,7 +432,8 @@ Asynchronous backends
 The return value of each command can also be a cons (:async . FETCHER)
 where FETCHER is a function of one argument, CALLBACK.  When the data
 arrives, FETCHER must call CALLBACK and pass it the appropriate return
-value, as described above.
+value, as described above.  That call must happen in the same buffer as
+where completion was initiated.
 
 True asynchronous operation is only supported for command `candidates', and
 only during idle completion.  Other commands will block the user interface,
@@ -464,6 +465,8 @@ without duplicates."
           (const :tag "Sort by occurrence" (company-sort-by-occurrence))
           (const :tag "Sort by backend importance"
                  (company-sort-by-backend-importance))
+          (const :tag "Prefer case sensitive prefix"
+                 (company-sort-prefer-same-case-prefix))
           (repeat :tag "User defined" (function))))
 
 (defcustom company-completion-started-hook nil
@@ -832,7 +835,8 @@ means that `company-mode' is always turned on except in `message-mode' buffers."
 If EXPRESSION is non-nil, return the match string for the respective
 parenthesized expression in REGEXP.
 Matching is limited to the current line."
-  (company-grab regexp expression (point-at-bol)))
+  (let ((inhibit-field-text-motion t))
+    (company-grab regexp expression (point-at-bol))))
 
 (defun company-grab-symbol ()
   "If point is at the end of a symbol, return it.
@@ -854,7 +858,7 @@ Otherwise, if point is not inside a symbol, return an empty string."
 
 (defun company-grab-symbol-cons (idle-begin-after-re &optional max-len)
   "Return a string SYMBOL or a cons (SYMBOL . t).
-SYMBOL is as returned by `company-grab-symbol'.  If the text before poit
+SYMBOL is as returned by `company-grab-symbol'.  If the text before point
 matches IDLE-BEGIN-AFTER-RE, return it wrapped in a cons."
   (let ((symbol (company-grab-symbol)))
     (when symbol
@@ -1094,7 +1098,8 @@ can retrieve meta-data for them."
 
 (defun company--group-lighter (candidate base)
   (let ((backend (or (get-text-property 0 'company-backend candidate)
-                     (car company-backend))))
+                     (cl-some (lambda (x) (and (not (keywordp x)) x))
+                              company-backend))))
     (when (and backend (symbolp backend))
       (let ((name (replace-regexp-in-string "company-\\|-company" ""
                                             (symbol-name backend))))
@@ -1164,10 +1169,11 @@ can retrieve meta-data for them."
         t))))
 
 (defun company--fetch-candidates (prefix)
-  (let ((c (if company--manual-action
-               (company-call-backend 'candidates prefix)
-             (company-call-backend-raw 'candidates prefix)))
-        res)
+  (let* ((non-essential (not (company-explicit-action-p)))
+         (c (if company--manual-action
+                (company-call-backend 'candidates prefix)
+              (company-call-backend-raw 'candidates prefix)))
+         res)
     (if (not (eq (car c) :async))
         c
       (let ((buf (current-buffer))
@@ -1186,7 +1192,11 @@ can retrieve meta-data for them."
                    company-candidates-cache
                    (list (cons prefix
                                (company--preprocess-candidates candidates))))
-             (company-idle-begin buf win tick pt)))))
+             (unwind-protect
+                 (company-idle-begin buf win tick pt)
+               (unless company-candidates
+                 (setq company-backend nil
+                       company-candidates-cache nil)))))))
       ;; FIXME: Relying on the fact that the callers
       ;; will interpret nil as "do nothing" is shaky.
       ;; A throw-catch would be one possible improvement.
@@ -1194,10 +1204,11 @@ can retrieve meta-data for them."
           (progn (setq res 'done) nil)))))
 
 (defun company--preprocess-candidates (candidates)
+  (cl-assert (cl-every #'stringp candidates))
   (unless (company-call-backend 'sorted)
     (setq candidates (sort candidates 'string<)))
   (when (company-call-backend 'duplicates)
-    (setq candidates (company--strip-duplicates candidates)))
+    (company--strip-duplicates candidates))
   candidates)
 
 (defun company--postprocess-candidates (candidates)
@@ -1208,37 +1219,27 @@ can retrieve meta-data for them."
   (company--transform-candidates candidates))
 
 (defun company--strip-duplicates (candidates)
-  (let* ((annos 'unk)
-         (str (car candidates))
-         (ref (cdr candidates))
-         res str2 anno2)
-    (while ref
-      (setq str2 (pop ref))
-      (if (not (equal str str2))
-          (progn
-            (push str res)
-            (setq str str2)
-            (setq annos 'unk))
-        (setq anno2 (company-call-backend
-                     'annotation str2))
-        (cond
-         ((null anno2))             ; Skip it.
-         ((when (eq annos 'unk)
-            (let ((ann1 (company-call-backend 'annotation str)))
-              (if (null ann1)
-                  ;; No annotation on the earlier element, drop it.
-                  t
-                (setq annos (list ann1))
-                nil)))
-          (setq annos (list anno2))
-          (setq str str2))
-         ((member anno2 annos))     ; Also skip.
-         (t
-          (push anno2 annos)
-          (push str res)            ; Maintain ordering.
-          (setq str str2)))))
-    (when str (push str res))
-    (nreverse res)))
+  (let ((c2 candidates)
+        (annos 'unk))
+    (while c2
+      (setcdr c2
+              (let ((str (pop c2)))
+                (while (let ((str2 (car c2)))
+                         (if (not (equal str str2))
+                             (progn
+                               (setq annos 'unk)
+                               nil)
+                           (when (eq annos 'unk)
+                             (setq annos (list (company-call-backend
+                                                'annotation str))))
+                           (let ((anno2 (company-call-backend
+                                         'annotation str2)))
+                             (if (member anno2 annos)
+                                 t
+                               (push anno2 annos)
+                               nil))))
+                  (pop c2))
+                c2)))))
 
 (defun company--transform-candidates (candidates)
   (let ((c candidates))
@@ -1332,6 +1333,16 @@ from the rest of the backends in the group, if any, will be left at the end."
                  (let ((b1 (get-text-property 0 'company-backend c1)))
                    (or (not b1) (not (memq b1 low-priority)))))))))))
 
+(defun company-sort-prefer-same-case-prefix (candidates)
+  "Prefer CANDIDATES with the same case sensitive prefix.
+If a backend returns case insensitive matches, candidates with the an exact
+prefix match will be prioritized even if this changes the lexical order."
+  (cl-loop for candidate in candidates
+           if (string-prefix-p company-prefix candidate)
+           collect candidate into same-case
+           else collect candidate into other-case
+           finally return (append same-case other-case)))
+
 (defun company-idle-begin (buf win tick pos)
   (and (eq buf (current-buffer))
        (eq win (selected-window))
@@ -1356,6 +1367,7 @@ from the rest of the backends in the group, if any, will be left at the end."
                   (company-cancel))
            (quit (company-cancel))))))
 
+;;;###autoload
 (defun company-manual-begin ()
   (interactive)
   (company-assert-enabled)
@@ -1587,7 +1599,8 @@ from the rest of the backends in the group, if any, will be left at the end."
   (company-uninstall-map))
 
 (defun company-post-command ()
-  (when (null this-command)
+  (when (and company-candidates
+             (null this-command))
     ;; Happens when the user presses `C-g' while inside
     ;; `flyspell-post-command-hook', for example.
     ;; Or any other `post-command-hook' function that can call `sit-for',
@@ -1642,7 +1655,9 @@ each one wraps a part of the input string."
           (const :tag "Exact match" regexp-quote)
           (const :tag "Words separated with spaces" company-search-words-regexp)
           (const :tag "Words separated with spaces, in any order"
-                 company-search-words-in-any-order-regexp)))
+                 company-search-words-in-any-order-regexp)
+          (const :tag "All characters in given order, with anything in between"
+                 company-search-flex-regexp)))
 
 (defvar-local company-search-string "")
 
@@ -1672,6 +1687,15 @@ each one wraps a part of the input string."
                permutations
                "\\|")))
 
+(defun company-search-flex-regexp (input)
+  (if (zerop (length input))
+      ""
+    (concat (regexp-quote (string (aref input 0)))
+            (mapconcat (lambda (c)
+                         (concat "[^" (string c) "]*"
+                                 (regexp-quote (string c))))
+                       (substring input 1) ""))))
+
 (defun company--permutations (lst)
   (if (not lst)
       '(nil)
@@ -2036,6 +2060,7 @@ With ARG, move by that many elements."
                  (eq old-tick (buffer-chars-modified-tick)))
         (company-complete-common))))))
 
+;;;###autoload
 (defun company-complete ()
   "Insert the common part of all candidates or the current selection.
 The first time this is called, the common part is inserted, the second