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

   1 ;;; company-statistics.el --- Sort candidates using completion history
   2
   3 ;; Copyright (C) 2014  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 not 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   :group 'company-statistics
  60   :type 'integer
  61   :initialize (lambda (option init-size) (setq company-statistics-size init-size))
  62   :set 'company-statistics--log-resize)
  63
  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
  68   :type 'string)
  69
  70 (defcustom company-statistics-auto-save t
  71   "Whether to save the statistics when leaving emacs."
  72   :group 'company-statistics
  73   :type 'boolean)
  74
  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
  79   :type 'boolean)
  80
  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
  85 the global context."
  86   :group 'company-statistics
  87   :type 'function)
  88
  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
  92 number)."
  93   :group 'company-statistics
  94   :type 'function)
  95
  96 ;; internal vars, persistence
  97
  98 (defvar company-statistics--scores nil
  99   "Store selection frequency of candidates in given contexts.")
 100
 101 (defvar company-statistics--log nil
 102   "Ring keeping a log of statistics updates.")
 103
 104 (defvar company-statistics--index nil
 105   "Index into the log.")
 106
 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))
 113
 114 (defun company-statistics--initialized-p ()
 115   (hash-table-p company-statistics--scores))
 116
 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
 134                        (1- new-size))))
 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)
 138                                           0
 139                                         company-statistics-size))))
 140   (setq company-statistics-size new-size))
 141
 142 (defun company-statistics--save ()
 143   "Save statistics."
 144   (with-temp-buffer
 145     (let (print-level print-length)
 146       (insert
 147        (format
 148         "%S"
 149         `(setq
 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)))
 154
 155 (defun company-statistics--maybe-save ()
 156   (when (and (company-statistics--initialized-p)
 157              company-statistics-auto-save)
 158     (company-statistics--save)))
 159
 160 (defun company-statistics--load ()
 161   "Restore statistics."
 162   (load company-statistics-file 'noerror nil 'nosuffix))
 163
 164 ;; score calculation for insert/retrieval --- can be changed on-the-fly
 165
 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)))))
 172
 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)))
 176     (if 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))
 182       0)))
 183
 184 ;; score manipulation in one place --- know about hash value alist structure
 185
 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))
 193         (updated alist)
 194         (new nil))
 195     (mapc
 196      (lambda (upd)
 197        (let ((found (assoc (car upd) alist)))
 198          (if found
 199              (let ((result (funcall merger (cdr found) (cdr upd))))
 200                (if (funcall filter result)
 201                    (setq updated (delete found updated))
 202                  (setcdr found result)))
 203            (push upd new))))
 204      updates)
 205     (nconc updated new)))
 206
 207 (defun company-statistics--scores-add (cand score-updates)
 208   (puthash cand
 209            (company-statistics--alist-update
 210             (gethash cand company-statistics--scores)
 211             score-updates
 212             '+)
 213            company-statistics--scores))
 214
 215 (defun company-statistics--log-revert (&optional index)
 216   "Revert score updates for log entry.  INDEX defaults to
 217 `company-statistics--index'."
 218   (let ((hist-entry
 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))
 224              (new-scores
 225               (company-statistics--alist-update
 226                (gethash cand company-statistics--scores)
 227                score-updates
 228                '-
 229                'zerop)))
 230         (if new-scores                    ;sth left
 231             (puthash cand new-scores company-statistics--scores)
 232           (remhash cand company-statistics--scores))))))
 233
 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)))
 240
 241 ;; core functions: updater, actual sorting transformer, minor-mode
 242
 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)))
 250
 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."
 254   (setq candidates
 255         (sort candidates
 256               (lambda (cand1 cand2)
 257                 (>  (funcall company-statistics-score-calc cand1)
 258                     (funcall company-statistics-score-calc cand2))))))
 259
 260 ;;;###autoload
 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.
 265
 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'."
 271   nil nil nil
 272   :global t
 273   (if company-statistics-mode
 274       (progn
 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)))
 289
 290 (add-hook 'kill-emacs-hook 'company-statistics--maybe-save)
 291
 292 (provide 'company-statistics)
 293 ;;; company-statistics.el ends here