(require 'company)
(require 'cl-lib)
- (defvar-local company--capf-data nil)
-
- (defun company--capf-clear-data (&optional _ignore)
- (setq company--capf-data nil)
- (remove-hook 'company-completion-cancelled-hook 'company--capf-clear-data t)
- (remove-hook 'company-completion-finished-hook 'company--capf-clear-data t))
-
(defun company--capf-data ()
(cl-letf* (((default-value 'completion-at-point-functions)
;; Ignore tags-completion-at-point-function because it subverts
(when res
(if (> (nth 2 res) (point))
'stop
- (setq company--capf-data res)
- (add-hook 'company-completion-cancelled-hook 'company--capf-clear-data nil t)
- (add-hook 'company-completion-finished-hook 'company--capf-clear-data nil t)
(buffer-substring-no-properties (nth 1 res) (point))))))
(`candidates
- (let ((res company--capf-data))
+ (let ((res (company--capf-data)))
(when res
(let* ((table (nth 3 res))
(pred (plist-get (nthcdr 4 res) :predicate))
candidates))
candidates)))))
(`sorted
- (let ((res company--capf-data))
+ (let ((res (company--capf-data)))
(when res
(let ((meta (completion-metadata
(buffer-substring (nth 1 res) (nth 2 res))
(`no-cache t) ;Not much can be done here, as long as we handle
;non-prefix matches.
(`meta
- (let ((f (plist-get (nthcdr 4 company--capf-data) :company-docsig)))
+ (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-docsig)))
(when f (funcall f arg))))
(`doc-buffer
- (let ((f (plist-get (nthcdr 4 company--capf-data) :company-doc-buffer)))
+ (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-doc-buffer)))
(when f (funcall f arg))))
(`location
- (let ((f (plist-get (nthcdr 4 company--capf-data) :company-location)))
+ (let ((f (plist-get (nthcdr 4 (company--capf-data)) :company-location)))
(when f (funcall f arg))))
(`annotation
(save-excursion
;; FIXME: `company-begin' sets `company-point' after calling
;; `company--begin-new'. We shouldn't rely on `company-point' here,
- ;; better to cache the capf-data value instead.
+ ;; better to cache the capf-data value instead. However: we can't just
+ ;; save the last capf-data value in `prefix', because that command can
+ ;; get called more often than `candidates', and at any point in the
+ ;; buffer (https://github.com/company-mode/company-mode/issues/153).
+ ;; We could try propertizing the returned prefix string, but it's not
+ ;; passed to `annotation', and `company-prefix' is set only after
+ ;; `company--strip-duplicates' is called.
(when company-point
(goto-char company-point))
- (let ((f (plist-get (nthcdr 4 company--capf-data) :annotation-function)))
+ (let ((f (plist-get (nthcdr 4 (company--capf-data)) :annotation-function)))
(when f (funcall f arg)))))
(`require-match
- (plist-get (nthcdr 4 company--capf-data) :company-require-match))
+ (plist-get (nthcdr 4 (company--capf-data)) :company-require-match))
(`init nil) ;Don't bother: plenty of other ways to initialize the code.
(`post-completion
- (let* ((res company--capf-data)
+ (let* ((res (company--capf-data))
(exit-function (plist-get (nthcdr 4 res) :exit-function)))
(if exit-function
(funcall exit-function arg 'finished))))
;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
- ;; Version: 0.8.1
+ ;; Version: 0.8.2
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
"Face used for the common part of completions in the echo area.")
(defun company-frontends-set (variable value)
- ;; uniquify
- (let ((remainder value))
- (setcdr remainder (delq (car remainder) (cdr remainder))))
- (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
- (memq 'company-pseudo-tooltip-frontend value)
- (error "Pseudo tooltip frontend cannot be used twice"))
- (and (memq 'company-preview-if-just-one-frontend value)
- (memq 'company-preview-frontend value)
- (error "Preview frontend cannot be used twice"))
- (and (memq 'company-echo value)
- (memq 'company-echo-metadata-frontend value)
- (error "Echo area cannot be used twice"))
- ;; preview must come last
- (dolist (f '(company-preview-if-just-one-frontend company-preview-frontend))
- (when (memq f value)
- (setq value (append (delq f value) (list f)))))
- (set variable value))
+ ;; Uniquify.
+ (let ((value (delete-dups (copy-sequence value))))
+ (and (memq 'company-pseudo-tooltip-unless-just-one-frontend value)
+ (memq 'company-pseudo-tooltip-frontend value)
+ (error "Pseudo tooltip frontend cannot be used twice"))
+ (and (memq 'company-preview-if-just-one-frontend value)
+ (memq 'company-preview-frontend value)
+ (error "Preview frontend cannot be used twice"))
+ (and (memq 'company-echo value)
+ (memq 'company-echo-metadata-frontend value)
+ (error "Echo area cannot be used twice"))
+ ;; Preview must come last.
+ (dolist (f '(company-preview-if-just-one-frontend company-preview-frontend))
+ (when (cdr (memq f value))
+ (setq value (append (delq f value) (list f)))))
+ (set variable value)))
(defcustom company-frontends '(company-pseudo-tooltip-unless-just-one-frontend
company-preview-if-just-one-frontend
(defcustom company-idle-delay .5
"The idle delay in seconds until completion starts automatically.
- A value of nil means no idle completion, t means show candidates
- immediately when a prefix of `company-minimum-prefix-length' is reached."
+ The prefix still has to satisfy `company-minimum-prefix-length' before that
+ happens. The value of nil means no idle completion."
:type '(choice (const :tag "never (nil)" nil)
- (const :tag "immediate (t)" t)
+ (const :tag "immediate (0)" 0)
(number :tag "seconds")))
(defcustom company-begin-commands '(self-insert-command org-self-insert-command)
nil company-lighter company-mode-map
(if company-mode
(progn
+ (when (eq company-idle-delay t)
+ (setq company-idle-delay 0)
+ (warn "Setting `company-idle-delay' to t is deprecated. Set it to 0 instead."))
(add-hook 'pre-command-hook 'company-pre-command nil t)
(add-hook 'post-command-hook 'company-post-command nil t)
(mapc 'company-init-backend company-backends))
candidate))
(defun company--should-complete ()
- (and (eq company-idle-delay t)
+ (and (eq company-idle-delay 'now)
(not (or buffer-read-only overriding-terminal-local-map
overriding-local-map))
;; Check if in the middle of entering a key combination.
(setq c (funcall tr c)))
c))
+ (defcustom company-occurrence-weight-function
+ #'company-occurrence-prefer-closest-above
+ "Function to weigh matches in `company-sort-by-occurrence'.
+ It's called with three arguments: cursor position, the beginning and the
+ end of the match."
+ :type '(choice
+ (const :tag "First above point, then below point"
+ company-occurrence-prefer-closest-above)
+ (const :tag "Prefer closest in any direction"
+ company-occurrence-prefer-any-closest)))
+
+ (defun company-occurrence-prefer-closest-above (pos match-beg match-end)
+ "Give priority to the matches above point, then those below point."
+ (if (< match-beg pos)
+ (- pos match-end)
+ (- match-beg (window-start))))
+
+ (defun company-occurrence-prefer-any-closest (pos _match-beg match-end)
+ "Give priority to the matches closest to the point."
+ (abs (- pos match-end)))
+
(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.
+ prioritizes the matches according to `company-occurrence-weight-function'.
+ The rest of the list is appended unchanged.
Keywords and function definition names are ignored."
- (let* (occurs
+ (let* ((w-start (window-start))
+ (w-end (window-end))
+ (start-point (point))
+ occurs
(noccurs
- (cl-delete-if
- (lambda (candidate)
- (when (or
- (save-excursion
- (progn (forward-char (- (length company-prefix)))
- (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--prefix-str
- (company-call-backend 'prefix))))
- (and (stringp prefix)
- (= (length prefix) (- end beg))))))
- (push (cons candidate (if (< beg (point))
- (- (point) end)
- (- beg (window-start))))
- occurs)
- t))))
- candidates)))
+ (save-excursion
+ (cl-delete-if
+ (lambda (candidate)
+ (when (catch 'done
+ (goto-char w-start)
+ (while (search-forward candidate w-end t)
+ (when (and (not (eq (point) start-point))
+ (save-match-data
+ (company--occurrence-predicate)))
+ (throw 'done t))))
+ (push
+ (cons candidate
+ (funcall company-occurrence-weight-function
+ start-point
+ (match-beginning 0)
+ (match-end 0)))
+ occurs)
+ t))
+ candidates))))
(nconc
(mapcar #'car (sort occurs (lambda (e1 e2) (<= (cdr e1) (cdr e2)))))
noccurs)))
+ (defun company--occurrence-predicate ()
+ (let ((beg (match-beginning 0))
+ (end (match-end 0)))
+ (save-excursion
+ (goto-char end)
+ (and (not (memq (get-text-property (1- (point)) 'face)
+ '(font-lock-function-name-face
+ font-lock-keyword-face)))
+ (let ((prefix (company--prefix-str
+ (company-call-backend 'prefix))))
+ (and (stringp prefix)
+ (= (length prefix) (- end beg))))))))
+
(defun company-sort-by-backend-importance (candidates)
"Sort CANDIDATES as two priority groups.
If `company-backend' is a function, do nothing. If it's a list, move
(defun company-auto-begin ()
(and company-mode
(not company-candidates)
- (let ((company-idle-delay t))
+ (let ((company-idle-delay 'now))
(condition-case-unless-debug err
(company--perform)
(error (message "Company: An error occurred in auto-begin")
(condition-case err
(progn
(unless (equal (point) company-point)
- (let ((company-idle-delay (and (eq company-idle-delay t)
- (company--should-begin)
- t)))
+ (let (company-idle-delay) ; Against misbehavior while debugging.
(company--perform)))
(if company-candidates
(company-call-frontends 'post-command)
(overlay-put ov 'company-column column)
(overlay-put ov 'company-height height)))))
- (defun company-pseudo-tooltip-show-at-point (pos)
+ (defun company-pseudo-tooltip-show-at-point (pos column-offset)
(let ((row (company--row pos))
- (col (company--column pos)))
+ (col (- (company--column pos) column-offset)))
+ (when (< col 0) (setq col 0))
(company-pseudo-tooltip-show (1+ row) col company-selection)))
(defun company-pseudo-tooltip-edit (selection)
(overlay-put company-pseudo-tooltip-overlay 'window (selected-window))))
(defun company-pseudo-tooltip-guard ()
- (buffer-substring-no-properties
- (point) (overlay-start company-pseudo-tooltip-overlay)))
+ (list
+ (save-excursion (beginning-of-visual-line))
+ (let ((ov company-pseudo-tooltip-overlay))
+ (when (>= (overlay-get ov 'company-height) 0)
+ (buffer-substring-no-properties (point) (overlay-start ov))))))
(defun company-pseudo-tooltip-frontend (command)
"`company-mode' front-end similar to a tooltip but based on overlays."
(cl-case command
(pre-command (company-pseudo-tooltip-hide-temporarily))
(post-command
- (let ((old-height (if (overlayp company-pseudo-tooltip-overlay)
- (overlay-get company-pseudo-tooltip-overlay
- 'company-height)
- 0))
- (new-height (company--pseudo-tooltip-height)))
- (unless (and (>= (* old-height new-height) 0)
- (>= (abs old-height) (abs new-height))
- (equal (company-pseudo-tooltip-guard)
- (overlay-get company-pseudo-tooltip-overlay
- 'company-guard)))
- ;; Redraw needed.
- (company-pseudo-tooltip-show-at-point (- (point)
- (length company-prefix)))
- (overlay-put company-pseudo-tooltip-overlay
- 'company-guard (company-pseudo-tooltip-guard))))
+ (unless (when (overlayp company-pseudo-tooltip-overlay)
+ (let* ((ov company-pseudo-tooltip-overlay)
+ (old-height (overlay-get ov 'company-height))
+ (new-height (company--pseudo-tooltip-height)))
+ (and
+ (>= (* old-height new-height) 0)
+ (>= (abs old-height) (abs new-height))
+ (equal (company-pseudo-tooltip-guard)
+ (overlay-get ov 'company-guard)))))
+ ;; Redraw needed.
+ (company-pseudo-tooltip-show-at-point (point) (length company-prefix))
+ (overlay-put company-pseudo-tooltip-overlay
+ 'company-guard (company-pseudo-tooltip-guard)))
(company-pseudo-tooltip-unhide))
(hide (company-pseudo-tooltip-hide)
(setq company-tooltip-offset 0))