[elpa] master 2452ff7 13/13: Add 'packages/company-statistics/' from commit 'f8d15c7edb2a182f484c5e6eb86f322df473e763'

[Dmitry Gutov]

branch: master
commit 2452ff7db09251b65d5f7125a15a74b07e9a9b69
Merge: 0d834ff f8d15c7
Author: Dmitry Gutov <address@hidden>
Commit: Dmitry Gutov <address@hidden>

    Add 'packages/company-statistics/' from commit 
'f8d15c7edb2a182f484c5e6eb86f322df473e763'
    
    git-subtree-dir: packages/company-statistics
    git-subtree-mainline: 0d834ff627ae024cd1edfb21023f506737139f24
    git-subtree-split: f8d15c7edb2a182f484c5e6eb86f322df473e763
---
 packages/company-statistics/.dir-locals.el         |    4 +
 packages/company-statistics/.gitignore             |    2 +
 packages/company-statistics/README.org             |   34 +++
 .../company-statistics/company-statistics-tests.el |  282 +++++++++++++++++++
 packages/company-statistics/company-statistics.el  |  292 ++++++++++++++++++++
 5 files changed, 614 insertions(+), 0 deletions(-)

diff --git a/packages/company-statistics/.dir-locals.el 
b/packages/company-statistics/.dir-locals.el
new file mode 100644
index 0000000..79d9a12
--- /dev/null
+++ b/packages/company-statistics/.dir-locals.el
@@ -0,0 +1,4 @@
+((nil . ((indent-tabs-mode . nil)
+         (fill-column . 80)
+         (sentence-end-double-space . t)
+         (emacs-lisp-docstring-fill-column . 75))))
diff --git a/packages/company-statistics/.gitignore 
b/packages/company-statistics/.gitignore
new file mode 100644
index 0000000..2ecd291
--- /dev/null
+++ b/packages/company-statistics/.gitignore
@@ -0,0 +1,2 @@
+*.elc
+ert.el
diff --git a/packages/company-statistics/README.org 
b/packages/company-statistics/README.org
new file mode 100644
index 0000000..3fef3a4
--- /dev/null
+++ b/packages/company-statistics/README.org
@@ -0,0 +1,34 @@
+* company-statistics
+** About
+Company-statistics is a global minor mode built on top of the in-buffer
+completion system [[http://company-mode.github.io/][company-mode]].  The idea 
is to keep a log of a certain number
+of completions you choose, along with some context information, and use that to
+rank candidates the next time you have to choose --- hopefully showing you
+likelier candidates at the top of the list.
+** Use It
+Using the package is simple.
+
+If you install it from the elpa.gnu.org repository with Emacs' package manager,
+you only need to enable the mode, e.g., in your =init.el= file:
+#+begin_src emacs-lisp
+(add-to-hook 'after-init-hook 'company-statistics-mode)
+#+end_src
+
+Alternatively, make sure =company-statistics.el= is in your =load-path=, and 
add
+to your =init.el= file
+#+begin_src emacs-lisp
+(require 'company-statistics)
+(company-statistics-mode)
+#+end_src
+to load the package manually and turn on the mode.
+
+See the (few but powerful) customizable options for details =M-x 
customize-group
+company-statistics=.
+** Design
+Company-statistics is an add-on for company-mode, but is only loosely coupled 
to
+it (it works by adding a sorting function to =company-transformers= as well as 
a
+handler to =company-completion-finished-hook=).  It is designed with some
+flexibility in mind as for the recorded context information and the way
+candidates are scored: the default pair of functions are only examples!  The
+stats are automatically persistent between sessions.
+** Have Fun!
diff --git a/packages/company-statistics/company-statistics-tests.el 
b/packages/company-statistics/company-statistics-tests.el
new file mode 100644
index 0000000..6e0b460
--- /dev/null
+++ b/packages/company-statistics/company-statistics-tests.el
@@ -0,0 +1,282 @@
+;;; company-statistics-tests.el --- company-statistics tests
+
+;; Copyright (C) 2014  Free Software Foundation, Inc.
+
+;; Author: Ingo Lohmar
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+
+;;; Commentary:
+;; emacs -batch -L . -l ert -l company-statistics-tests.el  -f 
ert-run-tests-batch-and-exit
+
+;;; Code:
+
+(require 'ert)
+
+(require 'company-statistics)
+(setq company-statistics-auto-restore nil
+      company-statistics-auto-save nil)
+
+(company-statistics-mode)
+
+;;; Core
+
+(defun my/hash-compare (h1 h2 &optional pred)
+  "Check that hashes H1 and H2 use the same test, contain the same keys (as
+per that test), and that their stored values agree (as per PRED, which
+defaults to `equal')."
+  (let ((key-test (hash-table-test h1))
+        (pred (or pred 'equal)))
+    (and (eq key-test (hash-table-test h2))
+         (eq (hash-table-count h1) (hash-table-count h2))
+         (let ((keys nil))
+           (maphash (lambda (k v) (push k keys)) h1) ;get keys
+           (null                                     ;expect no mismatch
+            (catch 'mismatch
+              (while keys               ;if this finishes, it's nil
+                (let* ((k (car keys))
+                       (v1 (gethash k h1))
+                       (v2 (gethash k h2)))
+                  (setq keys (cdr keys))
+                  (unless (funcall pred v1 v2)
+                    (throw 'mismatch k))))))))))
+
+(defun my/vector-slice-compare (v1 i1 v2 i2 count &optional pred)
+  "Check that COUNT vector entries of V1 (starting at index I1) and
+V2 (starting at index I2) satisfy the binary predicate PRED, default
+`equal'.  Wraps around if index exceeds corresponding vector length."
+  (let ((pred (or pred 'equal)))
+    (null
+     (let ((l1 (length v1))
+           (l2 (length v2)))
+       (catch 'mismatch
+         (dolist (i (number-sequence 0 (1- count)))
+           (unless (funcall pred
+                            (aref v1 (mod (+ i1 i) l1))
+                            (aref v2 (mod (+ i2 i) l2)))
+             (throw 'mismatch t))))))))
+
+(defmacro cs-fixture (&rest body)
+  "Set up a completion history."
+  `(unwind-protect
+       ;; some setup to get a completion history
+       (let ((company-statistics-size 5))
+         (company-statistics--init)
+         (let ((major-mode 'foo-mode)
+               (buffer-file-name nil))
+           (company-statistics--finished "foo"))
+         (let ((major-mode 'foo-mode)
+               (buffer-file-name "bar-file"))
+           (company-statistics--finished "bar"))
+         (let ((major-mode 'baz-mode)
+               (buffer-file-name nil))
+           (company-statistics--finished "baz"))
+         (let ((major-mode 'baz-mode)
+               (buffer-file-name "quux-file"))
+           (company-statistics--finished "quux"))
+         ,@body)
+     ;; tear down to clean slate
+     (company-statistics--init)))
+
+(defmacro cs-persistence-fixture (&rest body)
+  "Check and prepare for persistence, clean up."
+  `(let ((company-statistics-file "./cs-test-tmp"))
+     (when (and (file-exists-p company-statistics-file)
+                (file-writable-p company-statistics-file))
+       (unwind-protect
+           (progn ,@body)
+         ;; clean up file system
+         (when (file-exists-p company-statistics-file)
+           (delete-file company-statistics-file))))))
+
+;; tests themselves
+
+(ert-deftest c-s-history-resize ()
+  "Test history-resize for shrinking and enlarging."
+  (cs-fixture
+   ;; resize several times
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp)))
+     (company-statistics--log-resize 'dummy 10)
+     ;; scores unaffected?
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     ;; find all 4 old entries
+     (should (my/vector-slice-compare company-statistics--log
+                                      (- company-statistics--index 4)
+                                      cs-history 0
+                                      4))
+     ;; index at "old-size"
+     (should (equal company-statistics--index 5))
+     (company-statistics--log-resize 'dummy 5)
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     (should (my/vector-slice-compare company-statistics--log
+                                      (- company-statistics--index 4)
+                                      cs-history 0
+                                      4))
+     ;; after shrink: index at 0
+     (should (equal company-statistics--index 0))
+     ;; lose oldest entry "foo"
+     (company-statistics--log-resize 'dummy 3)
+     ;; score should be removed
+     (should-not (gethash "foo" company-statistics--scores))
+     ;; find *3* latest entries
+     (should (my/vector-slice-compare company-statistics--log
+                                      (- company-statistics--index 3)
+                                      cs-history 1
+                                      3))
+     (should (equal company-statistics--index 0)))))
+
+(ert-deftest c-s-persistence ()
+  "Test that all statistics are properly saved and restored."
+  (cs-persistence-fixture
+   (cs-fixture
+    (let ((cs-scores (copy-sequence company-statistics--scores))
+          (cs-history (copy-sequence company-statistics--log))
+          (cs-index company-statistics--index))
+      (company-statistics--save)
+      (company-statistics--init)        ;hence shallow copies suffice
+      (company-statistics--load)
+      ;; (should (equal company-statistics--scores cs-scores))
+      (should (my/hash-compare company-statistics--scores cs-scores))
+      (should (equal company-statistics--log cs-history))
+      (should (equal company-statistics--index cs-index))))))
+
+(ert-deftest c-s-score-change-default ()
+  "Test a few things about the default score updates."
+  (let ((major-mode 'foobar-mode)
+        (buffer-file-name nil))         ;must not generate context entries
+    (should (equal (company-statistics-score-change-default "dummy")
+                   '((nil . 1) (foobar-mode . 1))))
+    (let ((buffer-file-name "test-file.XYZ"))
+      (should (equal (company-statistics-score-change-default "dummy")
+                     '((nil . 1) (foobar-mode . 1) ("test-file.XYZ" . 1)))))))
+
+(ert-deftest c-s-score-calc-default ()
+  "Test score calculation default."
+  (cs-fixture
+   (let ((major-mode 'foo-mode)
+         (buffer-file-name nil))
+     (should (eq (company-statistics-score-calc-default "foo") 2))
+     (should (eq (company-statistics-score-calc-default "bar") 2))
+     (should (eq (company-statistics-score-calc-default "baz") 1))
+     (should (eq (company-statistics-score-calc-default "quux") 1)))
+   (let ((major-mode 'foo-mode)
+         (buffer-file-name "bar-file"))
+     (should (eq (company-statistics-score-calc-default "foo") 2))
+     (should (eq (company-statistics-score-calc-default "bar") 3))
+     (should (eq (company-statistics-score-calc-default "baz") 1))
+     (should (eq (company-statistics-score-calc-default "quux") 1)))
+   (let ((major-mode 'baz-mode)
+         (buffer-file-name nil))
+     (should (eq (company-statistics-score-calc-default "foo") 1))
+     (should (eq (company-statistics-score-calc-default "bar") 1))
+     (should (eq (company-statistics-score-calc-default "baz") 2))
+     (should (eq (company-statistics-score-calc-default "quux") 2)))
+   (let ((major-mode 'baz-mode)
+         (buffer-file-name "quux-file"))
+     (should (eq (company-statistics-score-calc-default "foo") 1))
+     (should (eq (company-statistics-score-calc-default "bar") 1))
+     (should (eq (company-statistics-score-calc-default "baz") 2))
+     (should (eq (company-statistics-score-calc-default "quux") 3)))))
+
+(ert-deftest c-s-alist-update ()
+  "Test central helper function for context/score alist update."
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '+)
+                   '((nil . 0) ("a" . 2) ("b" . 2) ("d" . some-symbol) ("c" . 
3)))))
+  ;; filter only checks on merged, so nil entry remains, and symbol should not 
pose a problem:
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '+ 'zerop)
+                   '((nil . 0) ("a" . 2) ("b" . 2) ("d" . some-symbol) ("c" . 
3)))))
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '-)
+                   '((nil . 0) ("a" . 0) ("b" . 2) ("d" . some-symbol) ("c" . 
3)))))
+  (let ((alist '((nil . 0) ("a" . 1) ("b" . 2) ("d" . some-symbol)))
+        (updates '(("a" . 1) ("c" . 3))))
+    (should (equal (company-statistics--alist-update alist updates '- 'zerop)
+                   '((nil . 0) ("b" . 2) ("d" . some-symbol) ("c" . 3))))))
+
+(ert-deftest c-s-scores-add ()
+  "Test adding scores."
+  (cs-fixture
+   ;; new entry
+   (company-statistics--scores-add "zufpah" '((nil . 27)))
+   (should (equal (gethash "zufpah" company-statistics--scores)
+                  '((nil . 27))))
+   ;; update existing entry
+   (company-statistics--scores-add "foo" '((nil . 2)))
+   (let ((h (gethash "foo" company-statistics--scores)))
+     (should (equal (assoc nil h) '(nil . 3)))
+     (should (equal (assoc 'foo-mode h) '(foo-mode . 1))))))
+
+(ert-deftest c-s-history-revert ()
+  "Test reverting a score update stored in history."
+  ;; deep copies throughout!
+  (cs-fixture
+   ;; pointing to nil, should not change anything
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     (company-statistics--log-revert)
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index))))
+  (cs-fixture
+   ;; remove existing item 2: should vanish from scores
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     (company-statistics--log-revert 2)
+     (should-not (gethash "baz" company-statistics--scores))
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index))))
+  (cs-fixture
+   ;; remove just inserted item 3 (scores should be same)
+   (let ((cs-scores (copy-tree company-statistics--scores))
+         (cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     (let ((major-mode 'extra-mode))
+       (company-statistics--finished "foo")) ;adds to scores, history, index
+     (company-statistics--log-revert 4) ;reverts scores only, so...
+     (aset cs-history 4 '("foo" (nil . 1) (extra-mode . 1)))
+     (setq cs-index (mod (1+ cs-index) company-statistics-size))
+     (should (my/hash-compare company-statistics--scores cs-scores))
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index)))))
+
+(ert-deftest c-s-history-store ()
+  "Test insert/overwrite of history item."
+  (cs-fixture
+   (let ((cs-history (copy-tree company-statistics--log 'vecp))
+         (cs-index company-statistics--index))
+     ;; only changes history and index
+     (company-statistics--log-store "foo" '((nil . 27)))
+     (aset cs-history cs-index '("foo" (nil . 27)))
+     (setq cs-index 0)                  ;wraps around
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index))
+     ;; now wrap around to overwrite an entry
+     (company-statistics--log-store "tagyok" '((bla . 42)))
+     (aset cs-history cs-index '("tagyok" (bla . 42)))
+     (setq cs-index 1)
+     (should (equal company-statistics--log cs-history))
+     (should (equal company-statistics--index cs-index)))))
+
+;; test finished and sort functions?  if the above is ok, they are trivial...
diff --git a/packages/company-statistics/company-statistics.el 
b/packages/company-statistics/company-statistics.el
new file mode 100644
index 0000000..a3fef23
--- /dev/null
+++ b/packages/company-statistics/company-statistics.el
@@ -0,0 +1,292 @@
+;;; company-statistics.el --- Sort candidates using completion history
+
+;; Copyright (C) 2014  Free Software Foundation, Inc.
+
+;; Author: Ingo Lohmar <address@hidden>
+;; URL: https://github.com/company-mode/company-statistics
+;; Version: 0.1
+;; Keywords: abbrev, convenience, matching
+;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
+
+;; This file is not part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; Package installed from elpa.gnu.org:
+;;
+;;   (add-hook 'after-init-hook 'company-statistics-mode)
+;;
+;; Manually installed: make sure that this file is in load-path, and
+;;
+;;   (require 'company-statistics)
+;;   (company-statistics-mode)
+;;
+;; Every time a candidate is chosen using company-mode, we keep track of this
+;; (for a limited amount of recent choices).  When presenting completion
+;; candidates next time, they are sorted according to the score thus acquired.
+;;
+;; The same candidate might occur in different modes, projects, files etc., and
+;; possibly has a different meaning each time.  Therefore along with the
+;; completion, we store some context information.  In the default 
configuration,
+;; we track the overall frequency, the major-mode of the buffer, and the
+;; filename (if it applies), and the same criteria are used to score all
+;; possible candidates.
+
+;;; Code:
+
+(require 'company)
+
+(defgroup company-statistics nil
+  "Completion candidates ranking by historical statistics."
+  :group 'company)
+
+(defcustom company-statistics-size 400
+  "Number of completion choices that `company-statistics' keeps track of.
+As this is a global cache, making it too small defeats the purpose."
+  :group 'company-statistics
+  :type 'integer
+  :initialize (lambda (option init-size) (setq company-statistics-size 
init-size))
+  :set 'company-statistics--log-resize)
+
+(defcustom company-statistics-file
+  (concat user-emacs-directory "company-statistics-cache.el")
+  "File to save company-statistics state."
+  :group 'company-statistics
+  :type 'string)
+
+(defcustom company-statistics-auto-save t
+  "Whether to save the statistics when leaving emacs."
+  :group 'company-statistics
+  :type 'boolean)
+
+(defcustom company-statistics-auto-restore t
+  "Whether to restore statistics when company-statistics is enabled and has
+not been used before."
+  :group 'company-statistics
+  :type 'boolean)
+
+(defcustom company-statistics-score-change 
'company-statistics-score-change-default
+  "Function called with completion choice.  Using arbitrary other info,
+it should produce an alist, each entry labeling a context and the
+associated score update: ((ctx-a . 1) (\"str\" . 0.5) (nil . 1)).  Nil is
+the global context."
+  :group 'company-statistics
+  :type 'function)
+
+(defcustom company-statistics-score-calc 'company-statistics-score-calc-default
+  "Function called with completion candidate.  Using arbitrary other info,
+eg, on the current context, it should evaluate to the candidate's score (a
+number)."
+  :group 'company-statistics
+  :type 'function)
+
+;; internal vars, persistence
+
+(defvar company-statistics--scores nil
+  "Store selection frequency of candidates in given contexts.")
+
+(defvar company-statistics--log nil
+  "Ring keeping a log of statistics updates.")
+
+(defvar company-statistics--index nil
+  "Index into the log.")
+
+(defun company-statistics--init ()
+  "Initialize company-statistics."
+  (setq company-statistics--scores
+        (make-hash-table :test 'equal :size company-statistics-size))
+  (setq company-statistics--log (make-vector company-statistics-size nil)
+        company-statistics--index 0))
+
+(defun company-statistics--initialized-p ()
+  (hash-table-p company-statistics--scores))
+
+(defun company-statistics--log-resize (option new-size)
+  (when (company-statistics--initialized-p)
+    ;; hash scoresheet auto-resizes, but log does not
+    (let ((new-hist (make-vector new-size nil))
+          ;; use actual length, to also work for freshly restored stats
+          (company-statistics-size (length company-statistics--log)))
+      ;; copy newest entries (possibly nil) to new-hist
+      (dolist (i (number-sequence 0 (1- (min new-size 
company-statistics-size))))
+        (let ((old-i (mod (+ (- company-statistics--index new-size) i)
+                          company-statistics-size)))
+          (aset new-hist i (aref company-statistics--log old-i))))
+      ;; remove discarded log entry (when shrinking) from scores
+      (when (< new-size company-statistics-size)
+        (dolist (i (number-sequence
+                    company-statistics--index
+                    (+ company-statistics-size
+                       company-statistics--index
+                       (1- new-size))))
+          (company-statistics--log-revert (mod i company-statistics-size))))
+      (setq company-statistics--log new-hist)
+      (setq company-statistics--index (if (<= new-size company-statistics-size)
+                                          0
+                                        company-statistics-size))))
+  (setq company-statistics-size new-size))
+
+(defun company-statistics--save ()
+  "Save statistics."
+  (with-temp-buffer
+    (let (print-level print-length)
+      (insert
+       (format
+        "%S"
+        `(setq
+          company-statistics--scores ,company-statistics--scores
+          company-statistics--log ,company-statistics--log
+          company-statistics--index ,company-statistics--index))))
+    (write-file company-statistics-file)))
+
+(defun company-statistics--maybe-save ()
+  (when company-statistics-auto-save
+    (company-statistics--save)))
+
+(defun company-statistics--load ()
+  "Restore statistics."
+  (load company-statistics-file 'noerror nil 'nosuffix))
+
+;; score calculation for insert/retrieval --- can be changed on-the-fly
+
+(defun company-statistics-score-change-default (cand)
+  "Count for global score, mode context, filename context."
+  (nconc                                ;when's nil is removed
+   (list (cons nil 1) (cons major-mode 1)) ;major-mode is never nil
+   (when buffer-file-name
+     (list (cons buffer-file-name 1)))))
+
+(defun company-statistics-score-calc-default (cand)
+  "Global score, and bonus for matching major mode and filename."
+  (let ((scores (gethash cand company-statistics--scores)))
+    (if scores
+        ;; cand may be in scores and still have no global score left
+        (+ (or (cdr (assoc nil scores)) 0)
+           (or (cdr (assoc major-mode scores)) 0)
+           (or (cdr (when buffer-file-name ;to not get nil context
+                      (assoc buffer-file-name scores))) 0))
+      0)))
+
+;; score manipulation in one place --- know about hash value alist structure
+
+(defun company-statistics--alist-update (alist updates merger &optional filter)
+  "Return new alist with conses from ALIST.  Their cdrs are updated
+to (merger cdr update-cdr) if the UPDATES alist contains an entry with an
+equal-matching car.  If FILTER called with the result is non-nil, remove
+the cons from the result.  If no matching cons exists in ALIST, add the new
+one.  ALIST structure and cdrs may be changed!"
+  (let ((filter (or filter 'ignore))
+        (updated alist)
+        (new nil))
+    (mapc
+     (lambda (upd)
+       (let ((found (assoc (car upd) alist)))
+         (if found
+             (let ((result (funcall merger (cdr found) (cdr upd))))
+               (if (funcall filter result)
+                   (setq updated (delete found updated))
+                 (setcdr found result)))
+           (push upd new))))
+     updates)
+    (nconc updated new)))
+
+(defun company-statistics--scores-add (cand score-updates)
+  (puthash cand
+           (company-statistics--alist-update
+            (gethash cand company-statistics--scores)
+            score-updates
+            '+)
+           company-statistics--scores))
+
+(defun company-statistics--log-revert (&optional index)
+  "Revert score updates for log entry.  INDEX defaults to
+`company-statistics--index'."
+  (let ((hist-entry
+         (aref company-statistics--log
+               (or index company-statistics--index))))
+    (when hist-entry                    ;ignore nil entry
+      (let* ((cand (car hist-entry))
+             (score-updates (cdr hist-entry))
+             (new-scores
+              (company-statistics--alist-update
+               (gethash cand company-statistics--scores)
+               score-updates
+               '-
+               'zerop)))
+        (if new-scores                    ;sth left
+            (puthash cand new-scores company-statistics--scores)
+          (remhash cand company-statistics--scores))))))
+
+(defun company-statistics--log-store (result score-updates)
+  "Insert/overwrite result and associated score updates."
+  (aset company-statistics--log company-statistics--index
+        (cons result score-updates))
+  (setq company-statistics--index
+        (mod (1+ company-statistics--index) company-statistics-size)))
+
+;; core functions: updater, actual sorting transformer, minor-mode
+
+(defun company-statistics--finished (result)
+  "After completion, update scores and log."
+  (let* ((score-updates (funcall company-statistics-score-change result))
+         (result (substring-no-properties result)))
+    (company-statistics--scores-add result score-updates)
+    (company-statistics--log-revert)
+    (company-statistics--log-store result score-updates)))
+
+(defun company-sort-by-statistics (candidates)
+  "Sort candidates by historical statistics.  Stable sort, so order is only
+changed for candidates distinguishable by score."
+  (setq candidates
+        (sort candidates
+              (lambda (cand1 cand2)
+                (>  (funcall company-statistics-score-calc cand1)
+                    (funcall company-statistics-score-calc cand2))))))
+
+;;;###autoload
+(define-minor-mode company-statistics-mode
+  "Statistical sorting for company-mode.  Ranks completion candidates by
+the frequency with which they have been chosen in recent (as given by
+`company-statistics-size') history.
+
+Turning this mode on and off preserves the statistics.  They are also
+preserved automatically between Emacs sessions in the default
+configuration.  You can customize this behavior with
+`company-statistics-auto-save', `company-statistics-auto-restore' and
+`company-statistics-file'."
+  nil nil nil
+  :global t
+  (if company-statistics-mode
+      (progn
+        (unless (company-statistics--initialized-p)
+          (if (and company-statistics-auto-restore
+                   (company-statistics--load))
+              ;; maybe of different size
+              (company-statistics--log-resize nil company-statistics-size)
+            (company-statistics--init)))
+        (add-to-list 'company-transformers
+                     'company-sort-by-statistics 'append)
+        (add-hook 'company-completion-finished-hook
+                  'company-statistics--finished))
+    (setq company-transformers
+          (delq 'company-sort-by-statistics company-transformers))
+    (remove-hook 'company-completion-finished-hook
+                 'company-statistics--finished)))
+
+(add-hook 'kill-emacs-hook 'company-statistics--maybe-save)
+
+(provide 'company-statistics)
+;;; company-statistics.el ends here