]> code.delx.au - gnu-emacs-elpa/blobdiff - packages/company-statistics/company-statistics.el
Merge commit '00920450d83ffe7a02bbe98997e266726819efc2'
[gnu-emacs-elpa] / packages / company-statistics / company-statistics.el
index 3346c96ba8e800b981046966a3e7c1e5df2bb899..b982c487bd03a6714ccdbb6e44a7b045c4d3a46f 100644 (file)
@@ -1,10 +1,10 @@
-;;; company-statistics.el --- Sort candidates using completion history
+;;; company-statistics.el --- Sort candidates using completion history  -*- lexical-binding: t -*-
 
 
-;; Copyright (C) 2014  Free Software Foundation, Inc.
+;; Copyright (C) 2014-2015  Free Software Foundation, Inc.
 
 ;; Author: Ingo Lohmar <i.lohmar@gmail.com>
 ;; URL: https://github.com/company-mode/company-statistics
 
 ;; Author: Ingo Lohmar <i.lohmar@gmail.com>
 ;; URL: https://github.com/company-mode/company-statistics
-;; Version: 0.1.1
+;; Version: 0.2.1
 ;; Keywords: abbrev, convenience, matching
 ;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
 
 ;; Keywords: abbrev, convenience, matching
 ;; Package-Requires: ((emacs "24.3") (company "0.8.5"))
 
@@ -27,7 +27,7 @@
 ;;
 ;; Package installed from elpa.gnu.org:
 ;;
 ;;
 ;; 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
 ;;
 ;;
 ;; 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
 ;;
 ;; 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:
 
 
 ;;; Code:
 
 (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."
 (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."
-  :group 'company-statistics
   :type 'integer
   :type 'integer
-  :initialize (lambda (option init-size) (setq company-statistics-size init-size))
-  :set 'company-statistics--log-resize)
+  :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."
 
 (defcustom company-statistics-file
   (concat user-emacs-directory "company-statistics-cache.el")
   "File to save company-statistics state."
-  :group 'company-statistics
   :type 'string)
 
 (defcustom company-statistics-auto-save t
   "Whether to save the statistics when leaving emacs."
   :type 'string)
 
 (defcustom company-statistics-auto-save t
   "Whether to save the statistics when leaving emacs."
-  :group 'company-statistics
   :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-auto-restore t
   "Whether to restore statistics when company-statistics is enabled and has
 not been used before."
-  :group 'company-statistics
   :type 'boolean)
 
   :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."
   "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."
-  :group 'company-statistics
   :type 'function)
 
   :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)."
   "Function called with completion candidate.  Using arbitrary other info,
 eg, on the current context, it should evaluate to the candidate's score (a
 number)."
-  :group 'company-statistics
   :type 'function)
 
 ;; internal vars, persistence
   :type 'function)
 
 ;; internal vars, persistence
@@ -107,7 +106,7 @@ number)."
 (defun company-statistics--init ()
   "Initialize company-statistics."
   (setq company-statistics--scores
 (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))
 
   (setq company-statistics--log (make-vector company-statistics-size nil)
         company-statistics--index 0))
 
@@ -163,22 +162,93 @@ number)."
 
 ;; score calculation for insert/retrieval --- can be changed on-the-fly
 
 
 ;; 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)))
   (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)
+                (< 1 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))      ;else eval to nil
+      (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)
     (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
       0)))
 
 ;; score manipulation in one place --- know about hash value alist structure
@@ -209,7 +279,7 @@ one.  ALIST structure and cdrs may be changed!"
            (company-statistics--alist-update
             (gethash cand company-statistics--scores)
             score-updates
            (company-statistics--alist-update
             (gethash cand company-statistics--scores)
             score-updates
-            '+)
+            #'+)
            company-statistics--scores))
 
 (defun company-statistics--log-revert (&optional index)
            company-statistics--scores))
 
 (defun company-statistics--log-revert (&optional index)
@@ -225,8 +295,8 @@ one.  ALIST structure and cdrs may be changed!"
               (company-statistics--alist-update
                (gethash cand company-statistics--scores)
                score-updates
               (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))))))
         (if new-scores                    ;sth left
             (puthash cand new-scores company-statistics--scores)
           (remhash cand company-statistics--scores))))))
@@ -240,6 +310,9 @@ one.  ALIST structure and cdrs may be changed!"
 
 ;; core functions: updater, actual sorting transformer, minor-mode
 
 
 ;; 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))
 (defun company-statistics--finished (result)
   "After completion, update scores and log."
   (let* ((score-updates (funcall company-statistics-score-change result))
@@ -280,10 +353,14 @@ configuration.  You can customize this behavior with
             (company-statistics--init)))
         (add-to-list 'company-transformers
                      'company-sort-by-statistics 'append)
             (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))
         (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)))
 
     (remove-hook 'company-completion-finished-hook
                  'company-statistics--finished)))