1 ;;; company-statistics.el --- Sort candidates using completion history
3 ;; Copyright (C) 2014 Free Software Foundation, Inc.
5 ;; Author: Ingo Lohmar <i.lohmar@gmail.com>
6 ;; URL: https://github.com/company-mode/company-statistics
8 ;; Keywords: abbrev, convenience, matching
9 ;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
11 ;; This file is part of GNU Emacs.
13 ;; GNU Emacs is free software: you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation, either version 3 of the License, or
16 ;; (at your option) any later version.
18 ;; GNU Emacs is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
23 ;; You should have received a copy of the GNU General Public License
24 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
28 ;; Package installed from elpa.gnu.org:
30 ;; (add-hook 'after-init-hook 'company-statistics-mode)
32 ;; Manually installed: make sure that this file is in load-path, and
34 ;; (require 'company-statistics)
35 ;; (company-statistics-mode)
37 ;; Every time a candidate is chosen using company-mode, we keep track of this
38 ;; (for a limited amount of recent choices). When presenting completion
39 ;; candidates next time, they are sorted according to the score thus acquired.
41 ;; The same candidate might occur in different modes, projects, files etc., and
42 ;; possibly has a different meaning each time. Therefore along with the
43 ;; completion, we store some context information. In the default configuration,
44 ;; we track the overall frequency, the major-mode of the buffer, and the
45 ;; filename (if it applies), and the same criteria are used to score all
46 ;; possible candidates.
52 (defgroup company-statistics nil
53 "Completion candidates ranking by historical statistics."
56 (defcustom company-statistics-size 400
57 "Number of completion choices that `company-statistics' keeps track of.
58 As this is a global cache, making it too small defeats the purpose."
59 :group 'company-statistics
61 :initialize (lambda (option init-size) (setq company-statistics-size init-size))
62 :set 'company-statistics--log-resize)
64 (defcustom company-statistics-file
65 (concat user-emacs-directory "company-statistics-cache.el")
66 "File to save company-statistics state."
67 :group 'company-statistics
70 (defcustom company-statistics-auto-save t
71 "Whether to save the statistics when leaving emacs."
72 :group 'company-statistics
75 (defcustom company-statistics-auto-restore t
76 "Whether to restore statistics when company-statistics is enabled and has
77 not been used before."
78 :group 'company-statistics
81 (defcustom company-statistics-score-change 'company-statistics-score-change-default
82 "Function called with completion choice. Using arbitrary other info,
83 it should produce an alist, each entry labeling a context and the
84 associated score update: ((ctx-a . 1) (\"str\" . 0.5) (nil . 1)). Nil is
86 :group 'company-statistics
89 (defcustom company-statistics-score-calc 'company-statistics-score-calc-default
90 "Function called with completion candidate. Using arbitrary other info,
91 eg, on the current context, it should evaluate to the candidate's score (a
93 :group 'company-statistics
96 ;; internal vars, persistence
98 (defvar company-statistics--scores nil
99 "Store selection frequency of candidates in given contexts.")
101 (defvar company-statistics--log nil
102 "Ring keeping a log of statistics updates.")
104 (defvar company-statistics--index nil
105 "Index into the log.")
107 (defun company-statistics--init ()
108 "Initialize company-statistics."
109 (setq company-statistics--scores
110 (make-hash-table :test 'equal :size company-statistics-size))
111 (setq company-statistics--log (make-vector company-statistics-size nil)
112 company-statistics--index 0))
114 (defun company-statistics--initialized-p ()
115 (hash-table-p company-statistics--scores))
117 (defun company-statistics--log-resize (option new-size)
118 (when (company-statistics--initialized-p)
119 ;; hash scoresheet auto-resizes, but log does not
120 (let ((new-hist (make-vector new-size nil))
121 ;; use actual length, to also work for freshly restored stats
122 (company-statistics-size (length company-statistics--log)))
123 ;; copy newest entries (possibly nil) to new-hist
124 (dolist (i (number-sequence 0 (1- (min new-size company-statistics-size))))
125 (let ((old-i (mod (+ (- company-statistics--index new-size) i)
126 company-statistics-size)))
127 (aset new-hist i (aref company-statistics--log old-i))))
128 ;; remove discarded log entry (when shrinking) from scores
129 (when (< new-size company-statistics-size)
130 (dolist (i (number-sequence
131 company-statistics--index
132 (+ company-statistics-size
133 company-statistics--index
135 (company-statistics--log-revert (mod i company-statistics-size))))
136 (setq company-statistics--log new-hist)
137 (setq company-statistics--index (if (<= new-size company-statistics-size)
139 company-statistics-size))))
140 (setq company-statistics-size new-size))
142 (defun company-statistics--save ()
145 (let (print-level print-length)
150 company-statistics--scores ,company-statistics--scores
151 company-statistics--log ,company-statistics--log
152 company-statistics--index ,company-statistics--index))))
153 (write-file company-statistics-file)))
155 (defun company-statistics--maybe-save ()
156 (when (and (company-statistics--initialized-p)
157 company-statistics-auto-save)
158 (company-statistics--save)))
160 (defun company-statistics--load ()
161 "Restore statistics."
162 (load company-statistics-file 'noerror nil 'nosuffix))
164 ;; score calculation for insert/retrieval --- can be changed on-the-fly
166 (defun company-statistics-score-change-default (cand)
167 "Count for global score, mode context, filename context."
168 (nconc ;when's nil is removed
169 (list (cons nil 1) (cons major-mode 1)) ;major-mode is never nil
170 (when buffer-file-name
171 (list (cons buffer-file-name 1)))))
173 (defun company-statistics-score-calc-default (cand)
174 "Global score, and bonus for matching major mode and filename."
175 (let ((scores (gethash cand company-statistics--scores)))
177 ;; cand may be in scores and still have no global score left
178 (+ (or (cdr (assoc nil scores)) 0)
179 (or (cdr (assoc major-mode scores)) 0)
180 (or (cdr (when buffer-file-name ;to not get nil context
181 (assoc buffer-file-name scores))) 0))
184 ;; score manipulation in one place --- know about hash value alist structure
186 (defun company-statistics--alist-update (alist updates merger &optional filter)
187 "Return new alist with conses from ALIST. Their cdrs are updated
188 to (merger cdr update-cdr) if the UPDATES alist contains an entry with an
189 equal-matching car. If FILTER called with the result is non-nil, remove
190 the cons from the result. If no matching cons exists in ALIST, add the new
191 one. ALIST structure and cdrs may be changed!"
192 (let ((filter (or filter 'ignore))
197 (let ((found (assoc (car upd) alist)))
199 (let ((result (funcall merger (cdr found) (cdr upd))))
200 (if (funcall filter result)
201 (setq updated (delete found updated))
202 (setcdr found result)))
205 (nconc updated new)))
207 (defun company-statistics--scores-add (cand score-updates)
209 (company-statistics--alist-update
210 (gethash cand company-statistics--scores)
213 company-statistics--scores))
215 (defun company-statistics--log-revert (&optional index)
216 "Revert score updates for log entry. INDEX defaults to
217 `company-statistics--index'."
219 (aref company-statistics--log
220 (or index company-statistics--index))))
221 (when hist-entry ;ignore nil entry
222 (let* ((cand (car hist-entry))
223 (score-updates (cdr hist-entry))
225 (company-statistics--alist-update
226 (gethash cand company-statistics--scores)
230 (if new-scores ;sth left
231 (puthash cand new-scores company-statistics--scores)
232 (remhash cand company-statistics--scores))))))
234 (defun company-statistics--log-store (result score-updates)
235 "Insert/overwrite result and associated score updates."
236 (aset company-statistics--log company-statistics--index
237 (cons result score-updates))
238 (setq company-statistics--index
239 (mod (1+ company-statistics--index) company-statistics-size)))
241 ;; core functions: updater, actual sorting transformer, minor-mode
243 (defun company-statistics--finished (result)
244 "After completion, update scores and log."
245 (let* ((score-updates (funcall company-statistics-score-change result))
246 (result (substring-no-properties result)))
247 (company-statistics--scores-add result score-updates)
248 (company-statistics--log-revert)
249 (company-statistics--log-store result score-updates)))
251 (defun company-sort-by-statistics (candidates)
252 "Sort candidates by historical statistics. Stable sort, so order is only
253 changed for candidates distinguishable by score."
256 (lambda (cand1 cand2)
257 (> (funcall company-statistics-score-calc cand1)
258 (funcall company-statistics-score-calc cand2))))))
261 (define-minor-mode company-statistics-mode
262 "Statistical sorting for company-mode. Ranks completion candidates by
263 the frequency with which they have been chosen in recent (as given by
264 `company-statistics-size') history.
266 Turning this mode on and off preserves the statistics. They are also
267 preserved automatically between Emacs sessions in the default
268 configuration. You can customize this behavior with
269 `company-statistics-auto-save', `company-statistics-auto-restore' and
270 `company-statistics-file'."
273 (if company-statistics-mode
275 (unless (company-statistics--initialized-p)
276 (if (and company-statistics-auto-restore
277 (company-statistics--load))
278 ;; maybe of different size
279 (company-statistics--log-resize nil company-statistics-size)
280 (company-statistics--init)))
281 (add-to-list 'company-transformers
282 'company-sort-by-statistics 'append)
283 (add-hook 'company-completion-finished-hook
284 'company-statistics--finished))
285 (setq company-transformers
286 (delq 'company-sort-by-statistics company-transformers))
287 (remove-hook 'company-completion-finished-hook
288 'company-statistics--finished)))
290 (add-hook 'kill-emacs-hook 'company-statistics--maybe-save)
292 (provide 'company-statistics)
293 ;;; company-statistics.el ends here