;;; company.el --- Modular text completion framework -*- lexical-binding: t -*-
-;; Copyright (C) 2009-2014 Free Software Foundation, Inc.
+;; Copyright (C) 2009-2015 Free Software Foundation, Inc.
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.8.8-cvs
+;; Version: 0.8.9-cvs
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
(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))
(define-key keymap (kbd "M-p") 'company-select-previous)
(define-key keymap (kbd "<down>") 'company-select-next-or-abort)
(define-key keymap (kbd "<up>") 'company-select-previous-or-abort)
+ (define-key keymap [remap scroll-up-command] 'company-next-page)
+ (define-key keymap [remap scroll-down-command] 'company-previous-page)
(define-key keymap [down-mouse-1] 'ignore)
(define-key keymap [down-mouse-3] 'ignore)
(define-key keymap [mouse-1] 'company-complete-mouse)
(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)
company-selection)))))
(setq company-selection 0
company-candidates candidates))
- ;; Save in cache:
- (push (cons company-prefix company-candidates) company-candidates-cache)
;; Calculate common.
(let ((completion-ignore-case (company-call-backend 'ignore-case)))
;; We want to support non-prefix completion, so filtering is the
company-candidates-cache)))
(setq candidates (all-completions prefix prev))
(cl-return t)))))
- ;; no cache match, call back-end
- (setq candidates
- (company--process-candidates
- (company--fetch-candidates prefix))))
- (setq candidates (company--transform-candidates candidates))
+ (progn
+ ;; No cache match, call the backend.
+ (setq candidates (company--preprocess-candidates
+ (company--fetch-candidates prefix)))
+ ;; Save in cache.
+ (push (cons prefix candidates) company-candidates-cache)))
+ ;; 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
(setq company-backend backend
company-candidates-cache
(list (cons prefix
- (company--process-candidates
- candidates))))
+ (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 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)))))
;;; search ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar-local company-search-string nil)
+(defvar-local company-search-string "")
+
+(defvar company-search-lighter '(" "
+ (company-search-filtering "Filter" "Search")
+ ": \""
+ company-search-string
+ "\""))
-(defvar-local company-search-lighter " Search: \"\"")
+(defvar-local company-search-filtering nil
+ "Non-nil to filter the completion candidates by the search string")
-(defvar-local company-search-old-selection 0)
+(defvar-local company--search-old-selection 0)
-(defun company-search (text lines)
+(defun company--search (text lines)
(let ((quoted (regexp-quote text))
(i 0))
(cl-dolist (line lines)
(defun company-search-printing-char ()
(interactive)
- (company-search-assert-enabled)
- (company-search--update-string (concat company-search-string
- (string last-command-event))))
-
-(defun company-search--update-string (new)
- (let* ((pos (company-search new (nthcdr company-selection company-candidates))))
+ (company--search-assert-enabled)
+ (let ((ss (concat company-search-string (string last-command-event))))
+ (when company-search-filtering
+ (company--search-update-predicate ss))
+ (company--search-update-string ss)))
+
+(defun company--search-update-predicate (&optional ss)
+ (let* ((company-candidates-predicate
+ (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-update-string (new)
+ (let* ((pos (company--search new (nthcdr company-selection company-candidates))))
(if (null pos)
(ding)
- (setq company-search-string new
- company-search-lighter (concat " Search: \"" new "\""))
+ (setq company-search-string new)
(company-set-selection (+ company-selection pos) t))))
-(defun company-search--assert-input ()
- (company-search-assert-enabled)
- (unless (cl-plusp (length company-search-string))
+(defun company--search-assert-input ()
+ (company--search-assert-enabled)
+ (when (string= company-search-string "")
(error "Empty search string")))
(defun company-search-repeat-forward ()
"Repeat the incremental search in completion candidates forward."
(interactive)
- (company-search--assert-input)
- (let ((pos (company-search company-search-string
- (cdr (nthcdr company-selection
- company-candidates)))))
+ (company--search-assert-input)
+ (let ((pos (company--search company-search-string
+ (cdr (nthcdr company-selection
+ company-candidates)))))
(if (null pos)
(ding)
(company-set-selection (+ company-selection pos 1) t))))
(defun company-search-repeat-backward ()
"Repeat the incremental search in completion candidates backwards."
(interactive)
- (company-search--assert-input)
- (let ((pos (company-search company-search-string
- (nthcdr (- company-candidates-length
- company-selection)
- (reverse company-candidates)))))
+ (company--search-assert-input)
+ (let ((pos (company--search company-search-string
+ (nthcdr (- company-candidates-length
+ company-selection)
+ (reverse company-candidates)))))
(if (null pos)
(ding)
(company-set-selection (- company-selection pos 1) t))))
-(defun company-create-match-predicate ()
- (let ((ss company-search-string))
- (setq company-candidates-predicate
- (when ss (lambda (candidate) (string-match ss candidate)))))
- (company-update-candidates
- (company-apply-predicate company-candidates company-candidates-predicate))
- ;; Invalidate cache.
- (setq company-candidates-cache (cons company-prefix company-candidates)))
-
-(defun company-filter-printing-char ()
- (interactive)
- (company-search-assert-enabled)
- (company-search-printing-char)
- (company-create-match-predicate)
- (company-call-frontends 'update))
-
-(defun company-search-kill-others ()
- "Limit the completion candidates to the ones matching the search string."
+(defun company-search-toggle-filtering ()
+ "Toggle `company-search-filtering'."
(interactive)
- (company-search-assert-enabled)
- (company-create-match-predicate)
- (company-search-mode 0)
- (company-call-frontends 'update))
+ (company--search-assert-enabled)
+ (setq company-search-filtering (not company-search-filtering))
+ (let ((ss company-search-string))
+ (company--search-update-predicate ss)
+ (company--search-update-string ss)))
(defun company-search-abort ()
"Abort searching the completion candidates."
(interactive)
- (company-search-assert-enabled)
- (company-set-selection company-search-old-selection t)
- (company-search-mode 0))
+ (company--search-assert-enabled)
+ (company-search-mode 0)
+ (company-set-selection company--search-old-selection t))
(defun company-search-other-char ()
(interactive)
- (company-search-assert-enabled)
+ (company--search-assert-enabled)
(company-search-mode 0)
(company--unread-last-input))
(defun company-search-delete-char ()
(interactive)
- (company-search-assert-enabled)
- (when (cl-plusp (length company-search-string))
- (company-search--update-string (substring company-search-string 0 -1))))
+ (company--search-assert-enabled)
+ (if (string= company-search-string "")
+ (ding)
+ (let ((ss (substring company-search-string 0 -1)))
+ (when company-search-filtering
+ (company--search-update-predicate ss))
+ (company--search-update-string ss))))
(defvar company-search-map
(let ((i 0)
(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)
(define-key keymap "\C-g" 'company-search-abort)
(define-key keymap "\C-s" 'company-search-repeat-forward)
(define-key keymap "\C-r" 'company-search-repeat-backward)
- (define-key keymap "\C-o" 'company-search-kill-others)
+ (define-key keymap "\C-o" 'company-search-toggle-filtering)
keymap)
"Keymap used for incrementally searching the completion candidates.")
(if company-search-mode
(if (company-manual-begin)
(progn
- (setq company-search-old-selection company-selection)
- (company-call-frontends 'update))
+ (setq company--search-old-selection company-selection)
+ (company-call-frontends 'update)
+ (company-enable-overriding-keymap company-search-map))
(setq company-search-mode nil))
(kill-local-variable 'company-search-string)
- (kill-local-variable 'company-search-lighter)
- (kill-local-variable 'company-search-old-selection)
+ (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 ()
+(defun company--search-assert-enabled ()
(company-assert-enabled)
(unless company-search-mode
(company-uninstall-map)
- `company-search-repeat-forward' (\\[company-search-repeat-forward])
- `company-search-repeat-backward' (\\[company-search-repeat-backward])
- `company-search-abort' (\\[company-search-abort])
+- `company-search-delete-char' (\\[company-search-delete-char])
Regular characters are appended to the search string.
-The command `company-search-kill-others' (\\[company-search-kill-others])
-uses the search string to limit the completion candidates."
+The command `company-search-toggle-filtering' (\\[company-search-toggle-filtering])
+uses the search string to filter the completion candidates."
(interactive)
- (company-search-mode 1)
- (company-enable-overriding-keymap company-search-map))
+ (company-search-mode 1))
(defvar company-filter-map
(let ((keymap (make-keymap)))
(defun company-filter-candidates ()
"Start filtering the completion candidates incrementally.
This works the same way as `company-search-candidates' immediately
-followed by `company-search-kill-others' after each input."
+followed by `company-search-toggle-filtering'."
(interactive)
(company-search-mode 1)
- (company-enable-overriding-keymap company-filter-map))
+ (setq company-search-filtering t))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(company-abort)
(company--unread-last-input)))
+(defun company-next-page ()
+ "Select the candidate one page further."
+ (interactive)
+ (when (company-manual-begin)
+ (company-set-selection (+ company-selection
+ company-tooltip-limit))))
+
+(defun company-previous-page ()
+ "Select the candidate one page earlier."
+ (interactive)
+ (when (company-manual-begin)
+ (company-set-selection (- company-selection
+ company-tooltip-limit))))
+
(defvar company-pseudo-tooltip-overlay)
(defvar company-tooltip-offset)
(when company-common
(company--insert-candidate company-common)))))
+(defun company-complete-common-or-cycle ()
+ "Insert the common part of all candidates, or select the next one."
+ (interactive)
+ (when (company-manual-begin)
+ (let ((tick (buffer-chars-modified-tick)))
+ (call-interactively 'company-complete-common)
+ (when (eq tick (buffer-chars-modified-tick))
+ (let ((company-selection-wrap-around t))
+ (call-interactively 'company-select-next))))))
+
(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
mouse-face company-tooltip-mouse)
line))
(when selected
- (if (and 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)))
(end (+ margin (match-end 0))))
(add-text-properties beg end '(face company-tooltip-search)
- line)
- (when (< beg common)
- (add-text-properties beg common
- '(face company-tooltip-common-selection)
- line)))
+ line))
(add-text-properties 0 width '(face company-tooltip-selection
mouse-face company-tooltip-selection)
line)
(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
(dotimes (_ len)
(let* ((value (pop lines-copy))
(annotation (company-call-backend 'annotation value)))
- (setq value (company--clean-string value))
+ (setq value (company--clean-string (company-reformat value)))
(when annotation
(when company-tooltip-align-annotations
;; `lisp-completion-at-point' adds a space.
(dotimes (i len)
(let* ((item (pop items))
- (str (company-reformat (car item)))
+ (str (car item))
(annotation (cdr item))
(right (company-space-string company-tooltip-margin))
(width width))