[elpa] 04/21: Add company-transformers

[Dmitry Gutov]

dgutov pushed a commit to branch master
in repository elpa.

commit 6b3d2cc8920bcfde63f26213666f1d4e762fd3ee
Author: Dmitry Gutov <address@hidden>
Date:   Thu Jan 30 18:45:59 2014 +0200

    Add company-transformers
    
    Closes #52
---
 NEWS.md    |    2 ++
 company.el |   53 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 54 insertions(+), 1 deletions(-)

diff --git a/NEWS.md b/NEWS.md
index 9916054..309b915 100644
--- a/NEWS.md
+++ b/NEWS.md
@@ -2,6 +2,8 @@
 
 ## Next
 
+* New user option `company-transformers`.
+* First transformer, `company-sort-by-occurrence`.
 * New user options controlling `company-dabbrev` and `company-dabbrev-code`.
 
 ## 2014-01-25 (0.6.14)
diff --git a/company.el b/company.el
index 9d8ca68..cb46efa 100644
--- a/company.el
+++ b/company.el
@@ -358,6 +358,15 @@ does not know about.  It should also be callable 
interactively and use
 
 (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."
+  :type '(repeat
+          (choice
+           (const :tag "Sort by occurrence" 'company-sort-by-occurrence)
+           (function :tag "Custom function"))))
+
 (defcustom company-completion-started-hook nil
   "Hook run when company starts completing.
 The hook is called with one argument that is non-nil if the completion was
@@ -899,14 +908,56 @@ can retrieve meta-data for them."
               (while c2
                 (setcdr c2 (progn (while (equal (pop c2) (car c2)))
                                   c2)))))))
+    (setq candidates (company--transform-candidates candidates))
     (when candidates
       (if (or (cdr candidates)
               (not (eq t (compare-strings (car candidates) nil nil
                                           prefix nil nil ignore-case))))
-          candidates
+          (company--transform-candidates candidates)
         ;; Already completed and unique; don't start.
         t))))
 
+(defun company--transform-candidates (candidates)
+  (let ((c candidates))
+    (dolist (tr company-transformers)
+      (setq c (funcall tr c)))
+    c))
+
+(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."
+  (let* (occurs
+         (noccurs
+          (delete-if
+           (lambda (candidate)
+             (when (or
+                    (save-excursion
+                      (and (zerop (forward-line -1))
+                           (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-call-backend 'prefix)))
+                                (and (stringp prefix)
+                                     (= (length prefix) (- end beg))))))
+                   (push (cons candidate (if (< beg (point))
+                                             (- (point) end)
+                                           (- beg (window-start))))
+                         occurs)
+                   t))))
+           candidates)))
+    (nconc
+     (mapcar #'car (sort occurs (lambda (e1 e2) (< (cdr e1) (cdr e2)))))
+     noccurs)))
+
 (defun company-idle-begin (buf win tick pos)
   (and company-mode
        (eq buf (current-buffer))