company-statistics-0.2.3/0000755000175200017530000000000013053656065014014 5ustar elpaelpacompany-statistics-0.2.3/README.org0000644000175200017530000000272712544204617015466 0ustar elpaelpa* 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-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!
company-statistics-0.2.3/.dir-locals.el0000644000175200017530000000023312462402442016432 0ustar elpaelpa((nil . ((indent-tabs-mode . nil)
(fill-column . 80)
(sentence-end-double-space . t)
(emacs-lisp-docstring-fill-column . 75))))
company-statistics-0.2.3/ChangeLog0000644000175200017530000000321113053656003015553 0ustar elpaelpa2017-02-23 Ingo Lohmar
Merge commit 'e62157d43b2c874d2edbd547c3bdfb05d0a7ae5c' from
company-statistics
* commit 'e62157d43b2c874d2edbd547c3bdfb05d0a7ae5c':
Bump version
Avoid write-file side-effects, fixed encoding
Fix byte-compile warnings about unused variable
2015-11-26 Ingo Lohmar
Merge commit '906d8137224c1a5bd1dc913940e0d32ffecf5523' from
company-statistics
* commit '906d8137224c1a5bd1dc913940e0d32ffecf5523':
Bump version
Fix --last-keyword
2015-06-28 Ingo Lohmar
Merge commit '45bc13aec56fcd0b55686d2305cf6e6852d467e8' from
company-statistics
* commit '45bc13aec56fcd0b55686d2305cf6e6852d467e8':
Bump version
Cleanup similar to ELPA version
Update version
Offer light and heavy context scoring
fix typo
Conflicts:
packages/company-statistics/company-statistics.el
2015-04-26 Stefan Monnier
* packages/company-statistics/company-statistics.el: Use
lexical-binding. Remove redundant :group args.
2015-02-07 Ingo Lohmar
Merge commit 'd1e03c129603bf589e2c6d98cc93d05de48138c6'
Fix again for ELPA inclusion
2015-02-07 Ingo Lohmar
Merge commit '50127e91c39a8c72eb2ea1ffadf708f31699cf84'
Correct license wording Only save when variables have been initialized
2015-01-28 Dmitry Gutov
Add 'packages/company-statistics/' from commit
'f8d15c7edb2a182f484c5e6eb86f322df473e763'
git-subtree-dir: packages/company-statistics git-subtree-mainline:
0d834ff627ae024cd1edfb21023f506737139f24 git-subtree-split:
f8d15c7edb2a182f484c5e6eb86f322df473e763
company-statistics-0.2.3/company-statistics-tests.el0000644000175200017530000003467612544204617021350 0ustar elpaelpa;;; company-statistics-tests.el --- company-statistics tests -*- lexical-binding: t -*-
;; Copyright (C) 2014-2015 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 .
;;; Commentary:
;; emacs -batch -L . -L ../company-mode/ -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)
(company-statistics--context
'((:keyword "if")
(:symbol "parent")
(:file "foo-file"))))
(company-statistics--finished "foo"))
(let ((major-mode 'foo-mode)
(company-statistics--context
'((:symbol "statistics")
(:file "bar-file"))))
(company-statistics--finished "bar"))
(let ((major-mode 'baz-mode)
(company-statistics--context
'((:keyword "unless")
(:symbol "company"))))
(company-statistics--finished "baz"))
(let ((major-mode 'baz-mode)
(company-statistics--context
'((:keyword "when")
(:file "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-light ()
"Test a few things about the default score updates."
(let ((major-mode 'foobar-mode))
(should (equal (company-statistics-score-change-light "dummy")
'((nil . 1) (foobar-mode . 1))))))
(ert-deftest c-s-score-calc-light ()
"Test score calculation default."
(cs-fixture
;; FIXME assumes that light context is a subset of the heavy context?
(let ((major-mode 'foo-mode))
(should (eq (company-statistics-score-calc-light "foo") 2))
(should (eq (company-statistics-score-calc-light "bar") 2))
(should (eq (company-statistics-score-calc-light "baz") 1))
(should (eq (company-statistics-score-calc-light "quux") 1)))
(let ((major-mode 'baz-mode))
(should (eq (company-statistics-score-calc-light "foo") 1))
(should (eq (company-statistics-score-calc-light "bar") 1))
(should (eq (company-statistics-score-calc-light "baz") 2))
(should (eq (company-statistics-score-calc-light "quux") 2)))))
(ert-deftest c-s-score-change-heavy ()
"Test a few things about the heavy score updates."
(let ((major-mode 'foobar-mode))
(should (equal (company-statistics-score-change-heavy "dummy")
'((nil . 1) (foobar-mode . 1))))
(let ((company-statistics--context
'((:keyword "kwd")
nil ;deliberately omit parent symbol
(:file "test-file.XYZ"))))
(should (equal (company-statistics-score-change-heavy "dummy")
'((nil . 1) (foobar-mode . 1)
((:keyword "kwd") . 1)
((:file "test-file.XYZ") . 1)))))))
(ert-deftest c-s-score-calc-heavy ()
"Test heavy score calculation."
(cs-fixture
(let ((major-mode 'foo-mode)
(company-statistics--context
'((:symbol "company")
(:file "foo-file"))))
(should (eq (company-statistics-score-calc-heavy "dummy") 0))
(should (eq (company-statistics-score-calc-heavy "foo") 3))
(should (eq (company-statistics-score-calc-heavy "bar") 2))
(should (eq (company-statistics-score-calc-heavy "baz") 2))
(should (eq (company-statistics-score-calc-heavy "quux") 1)))
(let ((major-mode 'foo-mode)
(company-statistics--context
'((:keyword "unless")
(:symbol "parent")
(:file "quux-file"))))
(should (eq (company-statistics-score-calc-heavy "dummy") 0))
(should (eq (company-statistics-score-calc-heavy "foo") 3))
(should (eq (company-statistics-score-calc-heavy "bar") 2))
(should (eq (company-statistics-score-calc-heavy "baz") 2))
(should (eq (company-statistics-score-calc-heavy "quux") 2)))
(let ((major-mode 'baz-mode)
(company-statistics--context
'((:keyword "when")
(:file "baz-file"))))
(should (eq (company-statistics-score-calc-heavy "dummy") 0))
(should (eq (company-statistics-score-calc-heavy "foo") 1))
(should (eq (company-statistics-score-calc-heavy "bar") 1))
(should (eq (company-statistics-score-calc-heavy "baz") 2))
(should (eq (company-statistics-score-calc-heavy "quux") 3)))
(let ((major-mode 'baz-mode)
(company-statistics--context
'((:keyword "if")
(:symbol "statistics")
(:file "quux-file"))))
(should (eq (company-statistics-score-calc-heavy "dummy") 0))
(should (eq (company-statistics-score-calc-heavy "foo") 2))
(should (eq (company-statistics-score-calc-heavy "bar") 2))
(should (eq (company-statistics-score-calc-heavy "baz") 2))
(should (eq (company-statistics-score-calc-heavy "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...
company-statistics-0.2.3/company-statistics-pkg.el0000644000175200017530000000044213053656065020753 0ustar elpaelpa;; Generated package description from company-statistics.el
(define-package "company-statistics" "0.2.3" "Sort candidates using completion history" '((emacs "24.3") (company "0.8.5")) :url "https://github.com/company-mode/company-statistics" :keywords '("abbrev" "convenience" "matching"))
company-statistics-0.2.3/company-statistics.el0000644000175200017530000003627413053655742020211 0ustar elpaelpa;;; company-statistics.el --- Sort candidates using completion history -*- lexical-binding: t -*-
;; Copyright (C) 2014-2017 Free Software Foundation, Inc.
;; Author: Ingo Lohmar
;; URL: https://github.com/company-mode/company-statistics
;; Version: 0.2.3
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
;; 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 .
;;; 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 (heavy)
;; configuration, we track the overall frequency, the major-mode of the buffer,
;; the last preceding keyword, the parent symbol, 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."
:type 'integer
:initialize #'custom-initialize-default
:set #'company-statistics--log-resize)
(defcustom company-statistics-file
(concat user-emacs-directory "company-statistics-cache.el")
"File to save company-statistics state."
:type 'string)
(defcustom company-statistics-auto-save t
"Whether to save the statistics when leaving emacs."
:type 'boolean)
(defcustom company-statistics-auto-restore t
"Whether to restore statistics when company-statistics is enabled and has
not been used before."
:type 'boolean)
(defcustom company-statistics-capture-context #'company-statistics-capture-context-heavy
"Function called with single argument (t if completion started manually).
This is the place to store any context information for a completion run."
:type 'function)
(defcustom company-statistics-score-change #'company-statistics-score-change-heavy
"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."
:type 'function)
(defcustom company-statistics-score-calc #'company-statistics-score-calc-heavy
"Function called with completion candidate. Using arbitrary other info,
eg, on the current context, it should evaluate to the candidate's score (a
number)."
: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
(set-buffer-multibyte nil)
(let (print-level print-length)
(encode-coding-string
(format
"%S"
`(setq
company-statistics--scores ,company-statistics--scores
company-statistics--log ,company-statistics--log
company-statistics--index ,company-statistics--index))
'utf-8 nil (current-buffer))
(let ((coding-system-for-write 'binary))
(write-region nil nil company-statistics-file)))))
(defun company-statistics--maybe-save ()
(when (and (company-statistics--initialized-p)
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-light (_cand)
"Count for global score and mode context."
(list (cons nil 1)
(cons major-mode 1))) ;major-mode is never nil
(defun company-statistics-score-calc-light (cand)
"Global score, and bonus for matching major mode."
(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))
0)))
(defvar company-statistics--context nil
"Current completion context, a list of entries searched using `assoc'.")
(defun company-statistics--last-keyword ()
"Return last keyword, ie, text of region fontified with the
font-lock-keyword-face up to point, or nil."
(let ((face-pos (point)))
(while (and (number-or-marker-p face-pos)
(< (point-min) face-pos)
(not (eq (get-text-property (1- face-pos) 'face)
'font-lock-keyword-face)))
(setq face-pos
(previous-single-property-change face-pos 'face nil (point-min))))
(when (and (number-or-marker-p face-pos)
(eq (get-text-property (max (point-min) (1- face-pos)) 'face)
'font-lock-keyword-face))
(list :keyword
(buffer-substring-no-properties
(previous-single-property-change face-pos 'face nil (point-min))
face-pos)))))
(defun company-statistics--parent-symbol ()
"Return symbol immediately preceding current completion prefix, or nil.
May be separated by punctuation, but not by whitespace."
;; expects to be at start of company-prefix; little sense for lisps
(let ((preceding (save-excursion
(unless (zerop (skip-syntax-backward "."))
(substring-no-properties (symbol-name (symbol-at-point)))))))
(when preceding
(list :symbol preceding))))
(defun company-statistics--file-name ()
"Return buffer file name, or nil."
(when buffer-file-name
(list :file buffer-file-name)))
(defun company-statistics-capture-context-heavy (_manual)
"Calculate some context, once for the whole completion run."
(save-excursion
(backward-char (length company-prefix))
(setq company-statistics--context
(delq nil
(list (company-statistics--last-keyword)
(company-statistics--parent-symbol)
(company-statistics--file-name))))))
(defun company-statistics-score-change-heavy (_cand)
"Count for global score, mode context, last keyword, parent symbol,
buffer file name."
(let ((last-kwd (assoc :keyword company-statistics--context))
(parent-symbol (assoc :symbol company-statistics--context))
(file (assoc :file company-statistics--context)))
(nconc ;when's nil is removed
(list (cons nil 1)
(cons major-mode 1)) ;major-mode is never nil
;; only add pieces of context if non-nil
(when last-kwd (list (cons last-kwd 1)))
(when parent-symbol (list (cons parent-symbol 1)))
(when file (list (cons file 1))))))
(defun company-statistics-score-calc-heavy (cand)
"Global score, and bonus for matching major mode, last keyword, parent
symbol, buffer file name."
(let ((scores (gethash cand company-statistics--scores))
(last-kwd (assoc :keyword company-statistics--context))
(parent-symbol (assoc :symbol company-statistics--context))
(file (assoc :file company-statistics--context)))
(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)
;; some context may not apply, make sure to not get nil context
(or (cdr (when last-kwd (assoc last-kwd scores))) 0)
(or (cdr (when parent-symbol (assoc parent-symbol scores))) 0)
(or (cdr (when file (assoc file 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--start (manual)
(funcall company-statistics-capture-context manual))
(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-started-hook
'company-statistics--start)
(add-hook 'company-completion-finished-hook
'company-statistics--finished))
(setq company-transformers
(delq 'company-sort-by-statistics company-transformers))
(remove-hook 'company-completion-started-hook
'company-statistics--start)
(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