;; Author: Nikolaj Schumacher
;; Maintainer: Dmitry Gutov <dgutov@yandex.ru>
;; URL: http://company-mode.github.io/
-;; Version: 0.8.2-cvs
+;; Version: 0.8.3-cvs
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
(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-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