code.delx.au - gnu-emacs-elpa/blob - packages/company-statistics/company-statistics.el

   1 ;;; company-statistics.el --- Sort candidates using completion history  -*- lexical-binding:t -*-
   2
   3 ;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
   4
   5 ;; Author: Ingo Lohmar <i.lohmar@gmail.com>
   6 ;; URL: https://github.com/company-mode/company-statistics
   7 ;; Version: 0.1.1
   8 ;; Keywords: abbrev, convenience, matching
   9 ;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
  10
  11 ;; This file is part of GNU Emacs.
  12
  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.
  17
  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.
  22
  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/>.
  25
  26 ;;; Commentary:
  27 ;;
  28 ;; Package installed from elpa.gnu.org:
  29 ;;
  30 ;;   (add-hook 'after-init-hook 'company-statistics-mode)
  31 ;;
  32 ;; Manually installed: make sure that this file is in load-path, and
  33 ;;
  34 ;;   (require 'company-statistics)
  35 ;;   (company-statistics-mode)
  36 ;;
  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.
  40 ;;
  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.
  47
  48 ;;; Code:
  49
  50 (require 'company)
  51
  52 (defgroup company-statistics nil
  53   "Completion candidates ranking by historical statistics."
  54   :group 'company)
  55
  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   :type 'integer
  60   :initialize (lambda (_option init-size) (setq company-statistics-size init-size))
  61   :set #'company-statistics--log-resize)
  62
  63 (defcustom company-statistics-file
  64   (concat user-emacs-directory "company-statistics-cache.el")
  65   "File to save company-statistics state."
  66   :type 'string)
  67
  68 (defcustom company-statistics-auto-save t
  69   "Whether to save the statistics when leaving emacs."
  70   :type 'boolean)
  71
  72 (defcustom company-statistics-auto-restore t
  73   "Whether to restore statistics when company-statistics is enabled and has
  74 not been used before."
  75   :type 'boolean)
  76
  77 (defcustom company-statistics-score-change #'company-statistics-score-change-default
  78   "Function called with completion choice.  Using arbitrary other info,
  79 it should produce an alist, each entry labeling a context and the
  80 associated score update: ((ctx-a . 1) (\"str\" . 0.5) (nil . 1)).  Nil is
  81 the global context."
  82   :type 'function)
  83
  84 (defcustom company-statistics-score-calc 'company-statistics-score-calc-default
  85   "Function called with completion candidate.  Using arbitrary other info,
  86 eg, on the current context, it should evaluate to the candidate's score (a
  87 number)."
  88   :type 'function)
  89
  90 ;; internal vars, persistence
  91
  92 (defvar company-statistics--scores nil
  93   "Store selection frequency of candidates in given contexts.")
  94
  95 (defvar company-statistics--log nil
  96   "Ring keeping a log of statistics updates.")
  97
  98 (defvar company-statistics--index nil
  99   "Index into the log.")
 100
 101 (defun company-statistics--init ()
 102   "Initialize company-statistics."
 103   (setq company-statistics--scores
 104         (make-hash-table :test 'equal :size company-statistics-size))
 105   (setq company-statistics--log (make-vector company-statistics-size nil)
 106         company-statistics--index 0))
 107
 108 (defun company-statistics--initialized-p ()
 109   (hash-table-p company-statistics--scores))
 110
 111 (defun company-statistics--log-resize (_option new-size)
 112   (when (company-statistics--initialized-p)
 113     ;; hash scoresheet auto-resizes, but log does not
 114     (let ((new-hist (make-vector new-size nil))
 115           ;; use actual length, to also work for freshly restored stats
 116           (company-statistics-size (length company-statistics--log)))
 117       ;; copy newest entries (possibly nil) to new-hist
 118       (dolist (i (number-sequence 0 (1- (min new-size company-statistics-size))))
 119         (let ((old-i (mod (+ (- company-statistics--index new-size) i)
 120                           company-statistics-size)))
 121           (aset new-hist i (aref company-statistics--log old-i))))
 122       ;; remove discarded log entry (when shrinking) from scores
 123       (when (< new-size company-statistics-size)
 124         (dolist (i (number-sequence
 125                     company-statistics--index
 126                     (+ company-statistics-size
 127                        company-statistics--index
 128                        (1- new-size))))
 129           (company-statistics--log-revert (mod i company-statistics-size))))
 130       (setq company-statistics--log new-hist)
 131       (setq company-statistics--index (if (<= new-size company-statistics-size)
 132                                           0
 133                                         company-statistics-size))))
 134   (setq company-statistics-size new-size))
 135
 136 (defun company-statistics--save ()
 137   "Save statistics."
 138   (with-temp-buffer
 139     (let (print-level print-length)
 140       (insert
 141        (format
 142         "%S"
 143         `(setq
 144           company-statistics--scores ,company-statistics--scores
 145           company-statistics--log ,company-statistics--log
 146           company-statistics--index ,company-statistics--index))))
 147     (write-file company-statistics-file)))
 148
 149 (defun company-statistics--maybe-save ()
 150   (when (and (company-statistics--initialized-p)
 151              company-statistics-auto-save)
 152     (company-statistics--save)))
 153
 154 (defun company-statistics--load ()
 155   "Restore statistics."
 156   (load company-statistics-file 'noerror nil 'nosuffix))
 157
 158 ;; score calculation for insert/retrieval --- can be changed on-the-fly
 159
 160 (defun company-statistics-score-change-default (_cand)
 161   "Count for global score, mode context, filename context."
 162   (nconc                                ;when's nil is removed
 163    (list (cons nil 1) (cons major-mode 1)) ;major-mode is never nil
 164    (when buffer-file-name
 165      (list (cons buffer-file-name 1)))))
 166
 167 (defun company-statistics-score-calc-default (cand)
 168   "Global score, and bonus for matching major mode and filename."
 169   (let ((scores (gethash cand company-statistics--scores)))
 170     (if scores
 171         ;; cand may be in scores and still have no global score left
 172         (+ (or (cdr (assoc nil scores)) 0)
 173            (or (cdr (assoc major-mode scores)) 0)
 174            (or (cdr (when buffer-file-name ;to not get nil context
 175                       (assoc buffer-file-name scores))) 0))
 176       0)))
 177
 178 ;; score manipulation in one place --- know about hash value alist structure
 179
 180 (defun company-statistics--alist-update (alist updates merger &optional filter)
 181   "Return new alist with conses from ALIST.  Their cdrs are updated
 182 to (merger cdr update-cdr) if the UPDATES alist contains an entry with an
 183 equal-matching car.  If FILTER called with the result is non-nil, remove
 184 the cons from the result.  If no matching cons exists in ALIST, add the new
 185 one.  ALIST structure and cdrs may be changed!"
 186   (let ((filter (or filter 'ignore))
 187         (updated alist)
 188         (new nil))
 189     (mapc
 190      (lambda (upd)
 191        (let ((found (assoc (car upd) alist)))
 192          (if found
 193              (let ((result (funcall merger (cdr found) (cdr upd))))
 194                (if (funcall filter result)
 195                    (setq updated (delete found updated))
 196                  (setcdr found result)))
 197            (push upd new))))
 198      updates)
 199     (nconc updated new)))
 200
 201 (defun company-statistics--scores-add (cand score-updates)
 202   (puthash cand
 203            (company-statistics--alist-update
 204             (gethash cand company-statistics--scores)
 205             score-updates
 206             '+)
 207            company-statistics--scores))
 208
 209 (defun company-statistics--log-revert (&optional index)
 210   "Revert score updates for log entry.  INDEX defaults to
 211 `company-statistics--index'."
 212   (let ((hist-entry
 213          (aref company-statistics--log
 214                (or index company-statistics--index))))
 215     (when hist-entry                    ;ignore nil entry
 216       (let* ((cand (car hist-entry))
 217              (score-updates (cdr hist-entry))
 218              (new-scores
 219               (company-statistics--alist-update
 220                (gethash cand company-statistics--scores)
 221                score-updates
 222                '-
 223                'zerop)))
 224         (if new-scores                    ;sth left
 225             (puthash cand new-scores company-statistics--scores)
 226           (remhash cand company-statistics--scores))))))
 227
 228 (defun company-statistics--log-store (result score-updates)
 229   "Insert/overwrite result and associated score updates."
 230   (aset company-statistics--log company-statistics--index
 231         (cons result score-updates))
 232   (setq company-statistics--index
 233         (mod (1+ company-statistics--index) company-statistics-size)))
 234
 235 ;; core functions: updater, actual sorting transformer, minor-mode
 236
 237 (defun company-statistics--finished (result)
 238   "After completion, update scores and log."
 239   (let* ((score-updates (funcall company-statistics-score-change result))
 240          (result (substring-no-properties result)))
 241     (company-statistics--scores-add result score-updates)
 242     (company-statistics--log-revert)
 243     (company-statistics--log-store result score-updates)))
 244
 245 (defun company-sort-by-statistics (candidates)
 246   "Sort candidates by historical statistics.  Stable sort, so order is only
 247 changed for candidates distinguishable by score."
 248   (setq candidates
 249         (sort candidates
 250               (lambda (cand1 cand2)
 251                 (>  (funcall company-statistics-score-calc cand1)
 252                     (funcall company-statistics-score-calc cand2))))))
 253
 254 ;;;###autoload
 255 (define-minor-mode company-statistics-mode
 256   "Statistical sorting for company-mode.  Ranks completion candidates by
 257 the frequency with which they have been chosen in recent (as given by
 258 `company-statistics-size') history.
 259
 260 Turning this mode on and off preserves the statistics.  They are also
 261 preserved automatically between Emacs sessions in the default
 262 configuration.  You can customize this behavior with
 263 `company-statistics-auto-save', `company-statistics-auto-restore' and
 264 `company-statistics-file'."
 265   nil nil nil
 266   :global t
 267   (if company-statistics-mode
 268       (progn
 269         (unless (company-statistics--initialized-p)
 270           (if (and company-statistics-auto-restore
 271                    (company-statistics--load))
 272               ;; maybe of different size
 273               (company-statistics--log-resize nil company-statistics-size)
 274             (company-statistics--init)))
 275         (add-to-list 'company-transformers
 276                      'company-sort-by-statistics 'append)
 277         (add-hook 'company-completion-finished-hook
 278                   'company-statistics--finished))
 279     (setq company-transformers
 280           (delq 'company-sort-by-statistics company-transformers))
 281     (remove-hook 'company-completion-finished-hook
 282                  'company-statistics--finished)))
 283
 284 (add-hook 'kill-emacs-hook 'company-statistics--maybe-save)
 285
 286 (provide 'company-statistics)
 287 ;;; company-statistics.el ends here