-;;; company-statistics.el --- Sort candidates using completion history -*- lexical-binding:t -*-
+;;; company-statistics.el --- Sort candidates using completion history -*- lexical-binding: t -*-
;; Copyright (C) 2014-2015 Free Software Foundation, Inc.
;; Author: Ingo Lohmar <i.lohmar@gmail.com>
;; URL: https://github.com/company-mode/company-statistics
-;; Version: 0.1.1
+;; Version: 0.2.2
;; Keywords: abbrev, convenience, matching
;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
;;
;; Package installed from elpa.gnu.org:
;;
-;; (add-hook 'after-init-hook 'company-statistics-mode)
+;; (add-hook 'after-init-hook #'company-statistics-mode)
;;
;; Manually installed: make sure that this file is in load-path, and
;;
;;
;; 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.
+;; 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:
"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 (lambda (_option init-size) (setq company-statistics-size init-size))
+ :initialize #'custom-initialize-default
:set #'company-statistics--log-resize)
(defcustom company-statistics-file
not been used before."
:type 'boolean)
-(defcustom company-statistics-score-change #'company-statistics-score-change-default
+(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-default
+(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)."
(defun company-statistics--init ()
"Initialize company-statistics."
(setq company-statistics--scores
- (make-hash-table :test 'equal :size company-statistics-size))
+ (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)
+(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))
;; 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-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-default (cand)
- "Global score, and bonus for matching major mode and filename."
+(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)
- (or (cdr (when buffer-file-name ;to not get nil context
- (assoc buffer-file-name 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
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
- '+)
+ #'+)
company-statistics--scores))
(defun company-statistics--log-revert (&optional index)
(company-statistics--alist-update
(gethash cand company-statistics--scores)
score-updates
- '-
- 'zerop)))
+ #'-
+ #'zerop)))
(if new-scores ;sth left
(puthash cand new-scores company-statistics--scores)
(remhash cand company-statistics--scores))))))
;; 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))
(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)))