(put 'company-backends 'safe-local-variable 'company-safe-backends-p)
(defcustom company-transformers nil
- "Functions to change the list of candidates received from backends,
-after sorting and removal of duplicates (if appropriate).
-Each function gets called with the return value of the previous one."
+ "Functions to change the list of candidates received from backends.
+
+Each function gets called with the return value of the previous one.
+The first one gets passed the list of candidates, already sorted and
+without duplicates."
:type '(choice
(const :tag "None" nil)
(const :tag "Sort by occurrence" (company-sort-by-occurrence))
(symbol-name backend))))
(setq company-lighter (format " company-<%s>" name)))))))
-(defun company-apply-predicate (candidates predicate)
- (let (new)
- (dolist (c candidates)
- (when (funcall predicate c)
- (push c new)))
- (nreverse new)))
-
(defun company-update-candidates (candidates)
(setq company-candidates-length (length candidates))
(if (> company-selection 0)
(cl-return t)))))
(progn
;; No cache match, call the backend.
- (setq candidates (company--fetch-candidates prefix))
- ;; Save in cache (without the predicate applied).
+ (setq candidates (company--preprocess-candidates
+ (company--fetch-candidates prefix)))
+ ;; Save in cache.
(push (cons prefix candidates) company-candidates-cache)))
- (setq candidates (company--process-candidates candidates))
+ ;; Only now apply the predicate and transformers.
+ (setq candidates (company--postprocess-candidates candidates))
(when candidates
(if (or (cdr candidates)
(not (eq t (compare-strings (car candidates) nil nil
;; or the fetcher called us back right away.
(setq res candidates)
(setq company-backend backend
- company-candidates-cache (list (cons prefix candidates)))
+ company-candidates-cache
+ (list (cons prefix
+ (company--preprocess-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.
(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)))
+(defun company--preprocess-candidates (candidates)
(unless (company-call-backend 'sorted)
- (setq candidates (sort (copy-sequence candidates) 'string<)))
+ (setq candidates (sort candidates 'string<)))
(when (company-call-backend 'duplicates)
(company--strip-duplicates candidates))
+ candidates)
+
+(defun company--postprocess-candidates (candidates)
+ (when (or company-candidates-predicate company-transformers)
+ (setq candidates (copy-sequence candidates)))
+ (when company-candidates-predicate
+ (setq candidates (cl-delete-if-not company-candidates-predicate candidates)))
(company--transform-candidates candidates))
(defun company--strip-duplicates (candidates)
- (let ((c2 candidates))
+ (let ((c2 candidates)
+ (annos 'unk))
(while c2
(setcdr c2
- (let ((str (car c2))
- (anno 'unk))
- (pop c2)
+ (let ((str (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))))
+ (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)))))
(company--search-update-string ss)))
(defun company--search-update-predicate (&optional ss)
- (or ss (setq ss company-search-string))
(let* ((company-candidates-predicate
- (when company-search-filtering
- (lambda (candidate) (string-match ss candidate))))
+ (and (not (string= ss ""))
+ company-search-filtering
+ (lambda (candidate) (string-match ss candidate))))
(cc (company-calculate-candidates company-prefix)))
(unless cc (error "No match"))
(company-update-candidates cc)))
(defun company--search-assert-input ()
(company--search-assert-enabled)
- (unless (cl-plusp (length company-search-string))
+ (when (string= company-search-string "")
(error "Empty search string")))
(defun company-search-repeat-forward ()
"Abort searching the completion candidates."
(interactive)
(company--search-assert-enabled)
- (company--search-update-predicate "")
- (company-set-selection company--search-old-selection t)
- (company-search-mode 0))
+ (company-search-mode 0)
+ (company-set-selection company--search-old-selection t))
(defun company-search-other-char ()
(interactive)
(defun company-search-delete-char ()
(interactive)
(company--search-assert-enabled)
- (when (cl-plusp (length company-search-string))
+ (if (string= company-search-string "")
+ (ding)
(let ((ss (substring company-search-string 0 -1)))
(when company-search-filtering
(company--search-update-predicate ss))
(define-key keymap (char-to-string meta-prefix-char) meta-map)
(define-key keymap [escape] meta-map))
(define-key keymap (vector meta-prefix-char t) 'company-search-other-char)
+ (define-key keymap (kbd "M-n") 'company-select-next)
+ (define-key keymap (kbd "M-p") 'company-select-previous)
(define-key keymap "\e\e\e" 'company-search-other-char)
(define-key keymap [escape escape escape] 'company-search-other-char)
(define-key keymap (kbd "DEL") 'company-search-delete-char)
(kill-local-variable 'company-search-lighter)
(kill-local-variable 'company-search-filtering)
(kill-local-variable 'company--search-old-selection)
+ (when company-backend
+ (company--search-update-predicate "")
+ (company-call-frontends 'update))
(company-enable-overriding-keymap company-active-map)))
(defun company--search-assert-enabled ()
mouse-face company-tooltip-mouse)
line))
(when selected
- (if (and (cl-plusp (length company-search-string))
+ (if (and (not (string= company-search-string ""))
(string-match (regexp-quote company-search-string) value
(length company-prefix)))
(let ((beg (+ margin (match-beginning 0)))
(defun company-buffer-lines (beg end)
(goto-char beg)
(let (lines lines-moved)
- (while (and (> (setq lines-moved (vertical-motion 1)) 0)
+ (while (and (not (eobp)) ; http://debbugs.gnu.org/19553
+ (> (setq lines-moved (vertical-motion 1)) 0)
(<= (point) end))
(let ((bound (min end (1- (point)))))
;; A visual line can contain several physical lines (e.g. with outline's