dotfiles/emacs/.emacs.d/elpa/helm-20191206.1855/helm-adaptive.el

;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-

;; Original Author: Tamas Patrovics

;; Copyright (C) 2007 Tamas Patrovics
;; Copyright (C) 2012 ~ 2019 Thierry Volpiatto <thierry.volpiatto@gmail.com>

;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

;;; Code:

(require 'cl-lib)
(require 'helm)


(defgroup helm-adapt nil
  "Adaptative sorting of candidates for Helm."
  :group 'helm)

(defcustom helm-adaptive-history-file
  "~/.emacs.d/helm-adaptive-history"
  "Path of file where history information is stored.
When nil history is not saved nor restored after emacs restart unless
you save/restore `helm-adaptive-history' with something else like
psession or desktop."
  :type 'string
  :group 'helm-adapt)

(defcustom helm-adaptive-history-length 50
  "Maximum number of candidates stored for a source."
  :type 'number
  :group 'helm-adapt)

(defcustom helm-adaptive-sort-by-frequent-recent-usage t
  "Try to sort on an average of frequent and recent usage when non-nil.

When nil sort on frequency usage only.

Only frequency:
When candidate have low frequency, you have to hit on it many times to
make it going up on top.

Frequency+recent:
Even with a low frequency, candidate go up on top. If a candidate
have a high frequency but it is not used since some time, it goes
down slowly, but as soon you reuse it it go up on top quickly."
  :group 'helm-adapt
  :type 'boolean)

;; Internal
(defvar helm-adaptive-done nil
  "nil if history information is not yet stored for the current
selection.")

(defvar helm-adaptive-history nil
  "Contains the stored history information.
Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")

(defconst helm-adaptive-freq-coefficient 5)
(defconst helm-adaptive-recent-coefficient 2)

(defun helm-adaptive-done-reset ()
  (setq helm-adaptive-done nil))

;;;###autoload
(define-minor-mode helm-adaptive-mode
  "Toggle adaptive sorting in all sources."
  :group 'helm-adapt
  :require 'helm-adaptive
  :global t
  (if helm-adaptive-mode
      (progn
        (unless helm-adaptive-history
          (helm-adaptive-maybe-load-history))
        (add-hook 'kill-emacs-hook 'helm-adaptive-save-history)
        ;; Should run at beginning of `helm-initial-setup'.
        (add-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset)
        ;; Should run at beginning of `helm-exit-minibuffer'.
        (add-hook 'helm-before-action-hook 'helm-adaptive-store-selection)
        ;; Should run at beginning of `helm-select-action'.
        (add-hook 'helm-select-action-hook 'helm-adaptive-store-selection))
    (helm-adaptive-save-history)
    (setq helm-adaptive-history nil)
    (remove-hook 'kill-emacs-hook 'helm-adaptive-save-history)
    (remove-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset)
    (remove-hook 'helm-before-action-hook 'helm-adaptive-store-selection)
    (remove-hook 'helm-select-action-hook 'helm-adaptive-store-selection)))

(defun helm-adapt-use-adaptive-p (&optional source-name)
  "Return current source only if it use adaptive history, nil otherwise."
  (when helm-adaptive-mode
    (let* ((source (or source-name (helm-get-current-source)))
           (adapt-source (or (assoc-default 'filtered-candidate-transformer source)
                             (assoc-default 'candidate-transformer source))))
      (if (listp adapt-source)
          (and (memq 'helm-adaptive-sort adapt-source) source)
        (and (eq adapt-source 'helm-adaptive-sort) source)))))

(defun helm-adaptive-store-selection ()
  "Store history information for the selected candidate."
  (unless helm-adaptive-done
    (setq helm-adaptive-done t)
    (let ((source (helm-adapt-use-adaptive-p)))
      (when source
        (let* ((source-name (assoc-default 'name source))
               (source-info (or (assoc source-name helm-adaptive-history)
                                (progn
                                  (push (list source-name) helm-adaptive-history)
                                  (car helm-adaptive-history))))
               (selection (helm-get-selection nil t))
               (selection-info (progn
                                 (setcdr source-info
                                         (cons
                                          (let ((found (assoc selection (cdr source-info))))
                                            (if (not found)
                                                ;; new entry
                                                (list selection)
                                              ;; move entry to the beginning of the
                                              ;; list, so that it doesn't get
                                              ;; trimmed when the history is
                                              ;; truncated
                                              (setcdr source-info
                                                      (delete found (cdr source-info)))
                                              found))
                                          (cdr source-info)))
                                 (cadr source-info)))
               (pattern-info (progn
                               (setcdr selection-info
                                       (cons
                                        (let ((found (assoc helm-pattern (cdr selection-info))))
                                          (if (not found)
                                              ;; new entry
                                              (cons helm-pattern 0)
                                            ;; move entry to the beginning of the
                                            ;; list, so if two patterns used the
                                            ;; same number of times then the one
                                            ;; used last appears first in the list
                                            (setcdr selection-info
                                                    (delete found (cdr selection-info)))
                                            found))
                                        (cdr selection-info)))
                               (cadr selection-info)))
               (timestamp-info (helm-aif (assq 'timestamp (cdr selection-info))
                                   it
                                 (setcdr selection-info (cons (cons 'timestamp 0) (cdr selection-info)))
                                 (cadr selection-info))))
          ;; Increase usage count.
          (setcdr pattern-info (1+ (cdr pattern-info)))
          ;; Update timestamp.
          (setcdr timestamp-info (float-time))
          ;; Truncate history if needed.
          (if (> (length (cdr selection-info)) helm-adaptive-history-length)
              (setcdr selection-info
                      (cl-subseq (cdr selection-info) 0 helm-adaptive-history-length))))))))

(defun helm-adaptive-maybe-load-history ()
  "Load `helm-adaptive-history-file' which contain `helm-adaptive-history'.
Returns nil if `helm-adaptive-history-file' doesn't exist."
  (when (and helm-adaptive-history-file
             (file-readable-p helm-adaptive-history-file))
    (load-file helm-adaptive-history-file)))

(defun helm-adaptive-save-history (&optional arg)
  "Save history information to file given by `helm-adaptive-history-file'."
  (interactive "p")
  (when helm-adaptive-history-file
    (with-temp-buffer
      (insert
       ";; -*- mode: emacs-lisp -*-\n"
       ";; History entries used for helm adaptive display.\n")
      (let (print-length print-level)
        (prin1 `(setq helm-adaptive-history ',helm-adaptive-history)
               (current-buffer)))
      (insert ?\n)
      (write-region (point-min) (point-max) helm-adaptive-history-file nil
                    (unless arg 'quiet)))))

(defun helm-adaptive-sort (candidates source)
  "Sort the CANDIDATES for SOURCE by usage frequency.
This is a filtered candidate transformer you can use with the
`filtered-candidate-transformer' attribute."
  (let* ((source-name (assoc-default 'name source))
         (source-info (assoc source-name helm-adaptive-history)))
    (if source-info
        (let ((usage
               ;; Loop in the SOURCE entry of `helm-adaptive-history'
               ;; and assemble a list containing the (CANDIDATE
               ;; . USAGE-COUNT) pairs.
               (cl-loop with cf = (if helm-adaptive-sort-by-frequent-recent-usage
                                      helm-adaptive-freq-coefficient 1)
                        with cr = helm-adaptive-recent-coefficient
                        for (src-cand . infos) in (cdr source-info)
                        for count-freq = 0
                        for count-rec =
                        (helm-aif (and helm-adaptive-sort-by-frequent-recent-usage
                                       (assq 'timestamp infos))
                            (* cr (+ (float-time) (cdr it)))
                          0)
                        do (cl-loop for (pattern . score) in
                                    (remove (assq 'timestamp infos) infos)
                                    ;; If current pattern is equal to
                                    ;; the previously used one then
                                    ;; this candidate has priority
                                    ;; (that's why its count-freq is
                                    ;; boosted by 10000) and it only
                                    ;; has to compete with other
                                    ;; candidates which were also
                                    ;; selected with the same pattern.
                                    if (equal pattern helm-pattern)
                                    return (setq count-freq (+ 10000 score))
                                    else do (cl-incf count-freq score))
                        and collect (cons src-cand (+ (* count-freq cf) count-rec))
                        into results
                        ;; Sort the list in descending order, so
                        ;; candidates with highest priority come
                        ;; first.
                        finally return
                        (sort results (lambda (first second)
                                        (> (cdr first) (cdr second)))))))
          (if (consp usage)
              ;; Put those candidates first which have the highest usage count.
              (cl-loop for (cand . _freq) in usage
                       for info = (or (and (assq 'multiline source)
                                           (replace-regexp-in-string
                                            "\n\\'" "" cand))
                                      cand)
                       when (cl-member info candidates
                                       :test 'helm-adaptive-compare)
                       collect (car it) into sorted
                       and do (setq candidates
                                    (cl-remove info candidates
                                               :test 'helm-adaptive-compare))
                       finally return (append sorted candidates))
              (message "Your `%s' is maybe corrupted or too old, \
you should reinitialize it with `helm-reset-adaptive-history'"
                       helm-adaptive-history-file)
              (sit-for 1)
              candidates))
        ;; if there is no information stored for this source then do nothing
        candidates)))

;;;###autoload
(defun helm-reset-adaptive-history ()
  "Delete all `helm-adaptive-history' and his file.
Useful when you have a old or corrupted `helm-adaptive-history-file'."
  (interactive)
  (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ")
    (setq helm-adaptive-history nil)
    (delete-file helm-adaptive-history-file)))

(defun helm-adaptive-compare (x y)
  "Compare display parts if some of candidates X and Y.

Arguments X and Y are cons cell in (DISPLAY . REAL) format or atoms."
  (equal (if (listp x) (car x) x)
         (if (listp y) (car y) y)))


(provide 'helm-adaptive)

;; Local Variables:
;; byte-compile-warnings: (not obsolete)
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:

;;; helm-adaptive.el ends here