;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.8.1-cvs
+;; Version: 0.8.3-cvs
;; 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
company-oddmuse company-files company-dabbrev)
"The list of active back-ends (completion engines).
+Only one back-end is used at a time. The choice depends on the order of
+the items in this list, and on the values they return in response to the
+`prefix' command (see below). But a back-end can also be a \"grouped\"
+one (see below).
+
`company-begin-backend' can be used to start a specific back-end,
`company-other-backend' will skip to the next matching back-end in the list.
`prefix': The back-end should return the text to be completed. It must be
text immediately before point. Returning nil passes control to the next
back-end. The function should return `stop' if it should complete but
-cannot \(e.g. if it is in the middle of a string\). Instead of a string,
+cannot (e.g. if it is in the middle of a string). Instead of a string,
the back-end may return a cons where car is the prefix and cdr is used in
`company-minimum-prefix-length' test. It must be either number or t, and
in the latter case the test automatically succeeds.
(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")
company-point)
company-prefix)))
-(defun company--continue-failed ()
+(defun company--continue-failed (new-prefix)
(let ((input (buffer-substring-no-properties (point) company-point)))
(cond
((company-auto-complete-p input)
(let ((company--auto-completion t))
(company-complete-selection))
nil))
+ ((and (or (not (company-require-match-p))
+ ;; Don't require match if the new prefix
+ ;; doesn't continue the old one, and the latter was a match.
+ (<= (length new-prefix) (length company-prefix)))
+ (member company-prefix company-candidates))
+ ;; Last input was a success,
+ ;; but we're treating it as an abort + input anyway,
+ ;; like the `unique' case below.
+ (company-cancel 'non-unique))
((company-require-match-p)
- ;; wrong incremental input, but required match
+ ;; Wrong incremental input, but required match.
(delete-char (- (length input)))
(ding)
(message "Matching input is required")
company-candidates)
- ((equal company-prefix (car company-candidates))
- ;; last input was actually success
- (company-cancel company-prefix))
(t (company-cancel)))))
(defun company--good-prefix-p (prefix)
((eq c t)
;; t means complete/unique.
;; Handle it like completion was aborted, to differentiate from user
- ;; calling one of Company's commands to insert the candidate.
+ ;; calling one of Company's commands to insert the candidate,
+ ;; not to trigger template expansion, etc.
(company-cancel 'unique))
((consp c)
;; incremental match
c)
((not (company--incremental-p))
(company-cancel))
- (t (company--continue-failed)))))
+ (t (company--continue-failed new-prefix)))))
(defun company--begin-new ()
(let (prefix c)
;; Only set unmodified when tick remained the same since insert,
;; and the buffer wasn't modified before.
(set-buffer-modified-p nil))
- (when company-prefix
- (if (stringp result)
- (progn
- (company-call-backend 'pre-completion result)
- (run-hook-with-args 'company-completion-finished-hook result)
- (company-call-backend 'post-completion result))
- (run-hook-with-args 'company-completion-cancelled-hook result)))
- (setq company-added-newline nil
- company-backend nil
- company-prefix nil
- company-candidates nil
- company-candidates-length nil
- company-candidates-cache nil
- company-candidates-predicate nil
- company-common nil
- company-selection 0
- company-selection-changed nil
- company--manual-action nil
- company--manual-prefix nil
- company-lighter company-default-lighter
- company--point-max nil
- company-point nil)
- (when company-timer
- (cancel-timer company-timer))
- (company-search-mode 0)
- (company-call-frontends 'hide)
- (company-enable-overriding-keymap nil)
+ (unwind-protect
+ (when company-prefix
+ (if (stringp result)
+ (progn
+ (company-call-backend 'pre-completion result)
+ (run-hook-with-args 'company-completion-finished-hook result)
+ (company-call-backend 'post-completion result))
+ (run-hook-with-args 'company-completion-cancelled-hook result)))
+ (setq company-added-newline nil
+ company-backend nil
+ company-prefix nil
+ company-candidates nil
+ company-candidates-length nil
+ company-candidates-cache nil
+ company-candidates-predicate nil
+ company-common nil
+ company-selection 0
+ company-selection-changed nil
+ company--manual-action nil
+ company--manual-prefix nil
+ company-lighter company-default-lighter
+ company--point-max nil
+ company-point nil)
+ (when company-timer
+ (cancel-timer company-timer))
+ (company-search-mode 0)
+ (company-call-frontends 'hide)
+ (company-enable-overriding-keymap nil))
;; Make return value explicit.
nil)
(defun company-abort ()
(interactive)
- (company-cancel t))
+ (company-cancel 'abort))
(defun company-finish (result)
(company--insert-candidate result)
(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)
(defun company-fill-propertize (value annotation width selected left right)
(let* ((margin (length left))
- (common (+ (or (company-call-backend 'match value)
- (length company-common)) margin))
+ (common (or (company-call-backend 'match value)
+ (length company-common)))
(ann-ralign company-tooltip-align-annotations)
(ann-truncate (< width
(+ (length value) (length annotation)
(- width (length annotation)))
annotation))
right)))
+ (setq common (+ (min common width) margin))
(setq width (+ width margin (length right)))
(add-text-properties 0 width '(face company-tooltip
(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))
projects / sojka / company-mode.git / blobdiff