X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/c97828cfcff0bddaeba5c22be5a102a3f0b3b4ca..b8f877703a0d50b46254fcfee3c815ae5e386013:/company.el diff --git a/company.el b/company.el index 20aedc834..28ed56be3 100644 --- a/company.el +++ b/company.el @@ -465,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 @@ -833,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. @@ -855,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 @@ -1095,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)))) @@ -1165,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)) @@ -1199,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) @@ -1213,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)) @@ -1337,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)) @@ -1361,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) @@ -1592,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', @@ -2052,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