branch: master
commit 2452ff7db09251b65d5f7125a15a74b07e9a9b69
Merge: 0d834ff f8d15c7
Author: Dmitry Gutov <dgu...@yandex.ru>
Commit: Dmitry Gutov <dgu...@yandex.ru>
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 <i.loh...@gmail.com>
+;; 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
