+(defun company--fetch-candidates (prefix)
+ (let ((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))
+ (win (selected-window))
+ (tick (buffer-chars-modified-tick))
+ (pt (point))
+ (backend company-backend))
+ (funcall
+ (cdr c)
+ (lambda (candidates)
+ (if (not (and candidates (eq res 'done)))
+ ;; Fetcher called us right back.
+ (setq res candidates)
+ (setq company-backend backend
+ company-candidates-cache
+ (list (cons prefix
+ (company--process-candidates
+ candidates))))
+ (company-idle-begin buf win tick pt)))))
+ ;; FIXME: Relying on the fact that the callers
+ ;; will interpret nil as "do nothing" is shaky.
+ ;; A throw-catch would be one possible improvement.
+ (or res
+ (progn (setq res 'done) nil)))))
+
+(defun company--process-candidates (candidates)
+ (when company-candidates-predicate
+ (setq candidates
+ (company-apply-predicate candidates
+ company-candidates-predicate)))
+ (unless (company-call-backend 'sorted)
+ (setq candidates (sort candidates 'string<)))
+ (when (company-call-backend 'duplicates)
+ (company--strip-duplicates candidates))
+ candidates)
+
+(defun company--strip-duplicates (candidates)
+ (let ((c2 candidates))
+ (while c2
+ (setcdr c2
+ (let ((str (car c2))
+ (anno 'unk))
+ (pop c2)
+ (while (let ((str2 (car c2)))
+ (if (not (equal str str2))
+ nil
+ (when (eq anno 'unk)
+ (setq anno (company-call-backend
+ 'annotation str)))
+ (equal anno
+ (company-call-backend
+ 'annotation str2))))
+ (pop c2))
+ c2)))))
+
+(defun company--transform-candidates (candidates)
+ (let ((c candidates))
+ (dolist (tr company-transformers)
+ (setq c (funcall tr c)))
+ c))
+
+(defun company-sort-by-occurrence (candidates)
+ "Sort CANDIDATES according to their occurrences.
+Searches for each in the currently visible part of the current buffer and
+gives priority to the closest ones above point, then closest ones below
+point. The rest of the list is appended unchanged.
+Keywords and function definition names are ignored."
+ (let* (occurs
+ (noccurs
+ (delete-if
+ (lambda (candidate)
+ (when (or
+ (save-excursion
+ (progn (forward-line 0)
+ (search-backward candidate (window-start) t)))
+ (save-excursion
+ (search-forward candidate (window-end) t)))
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (when (save-excursion
+ (goto-char end)
+ (and (not (memq (get-text-property (point) 'face)
+ '(font-lock-function-name-face
+ font-lock-keyword-face)))
+ (let* ((prefix (company-call-backend 'prefix))
+ (prefix (or (car-safe prefix) prefix)))
+ (and (stringp prefix)
+ (= (length prefix) (- end beg))))))
+ (push (cons candidate (if (< beg (point))
+ (- (point) end)
+ (- beg (window-start))))
+ occurs)
+ t))))
+ candidates)))
+ (nconc
+ (mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
+ noccurs)))
+