2016-04-21 21:27:19 +00:00
|
|
|
|
;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-
|
|
|
|
|
|
|
|
|
|
|
|
;; Original Author: Tamas Patrovics
|
|
|
|
|
|
|
|
|
|
|
|
;; Copyright (C) 2007 Tamas Patrovics
|
|
|
|
|
|
;; Copyright (C) 2012 ~ 2016 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."
|
|
|
|
|
|
:type 'string
|
|
|
|
|
|
:group 'helm-adapt)
|
|
|
|
|
|
|
|
|
|
|
|
(defcustom helm-adaptive-history-length 50
|
|
|
|
|
|
"Maximum number of candidates stored for a source."
|
|
|
|
|
|
:type 'number
|
|
|
|
|
|
:group 'helm-adapt)
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
;; 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) ...) ...) ...)")
|
|
|
|
|
|
|
|
|
|
|
|
(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)))
|
2016-07-12 13:08:56 +00:00
|
|
|
|
(adapt-source (or (assoc-default 'filtered-candidate-transformer source)
|
2016-04-21 21:27:19 +00:00
|
|
|
|
(assoc-default 'candidate-transformer source))))
|
|
|
|
|
|
(if (listp adapt-source)
|
|
|
|
|
|
(and (member '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 (or (assoc-default 'type source)
|
|
|
|
|
|
(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))))
|
2016-06-29 07:21:54 +00:00
|
|
|
|
(selection (helm-get-selection nil t))
|
2016-04-21 21:27:19 +00:00
|
|
|
|
(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))))
|
|
|
|
|
|
|
|
|
|
|
|
;; increase usage count
|
|
|
|
|
|
(setcdr pattern-info (1+ (cdr pattern-info)))
|
|
|
|
|
|
|
|
|
|
|
|
;; 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 (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")
|
|
|
|
|
|
(with-temp-buffer
|
|
|
|
|
|
(insert
|
|
|
|
|
|
";; -*- mode: emacs-lisp -*-\n"
|
|
|
|
|
|
";; History entries used for helm adaptive display.\n")
|
|
|
|
|
|
(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 (or (assoc-default 'type source)
|
|
|
|
|
|
(assoc-default 'name source)))
|
|
|
|
|
|
(source-info (assoc source-name helm-adaptive-history)))
|
|
|
|
|
|
(if source-info
|
|
|
|
|
|
(let ((usage
|
2016-06-29 07:21:54 +00:00
|
|
|
|
;; Assemble a list containing the (CANDIDATE . USAGE-COUNT) pairs.
|
|
|
|
|
|
(cl-loop with count = 0
|
|
|
|
|
|
for (sn . infos) in (cdr source-info)
|
|
|
|
|
|
do (cl-loop for (pattern . score) in infos
|
|
|
|
|
|
if (not (equal pattern helm-pattern))
|
|
|
|
|
|
do (cl-incf count score)
|
|
|
|
|
|
else return
|
|
|
|
|
|
;; If current pattern is equal to the previously
|
|
|
|
|
|
;; used one then this candidate has priority
|
|
|
|
|
|
;; (that's why its count is boosted by 10000) and
|
|
|
|
|
|
;; it only has to compete with other candidates
|
|
|
|
|
|
;; which were also selected with the same pattern.
|
|
|
|
|
|
(setq count (+ 10000 score)))
|
|
|
|
|
|
and collect (cons sn count) 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 (info . _freq) in usage
|
|
|
|
|
|
for mlinfo = (and (assq 'multiline source)
|
|
|
|
|
|
(replace-regexp-in-string "\n\\'" "" info))
|
|
|
|
|
|
for member = (cl-member (or mlinfo info) candidates
|
|
|
|
|
|
:test 'helm-adaptive-compare)
|
|
|
|
|
|
when member collect (car member) into sorted
|
|
|
|
|
|
and do
|
|
|
|
|
|
(setq candidates (cl-remove (or mlinfo info) candidates
|
|
|
|
|
|
:test 'helm-adaptive-compare))
|
|
|
|
|
|
finally return (append sorted candidates))
|
|
|
|
|
|
(message "Your `%s' is maybe corrupted or too old, \
|
2016-04-21 21:27:19 +00:00
|
|
|
|
you should reinitialize it with `helm-reset-adaptive-history'"
|
2016-06-29 07:21:54 +00:00
|
|
|
|
helm-adaptive-history-file)
|
|
|
|
|
|
(sit-for 1)
|
|
|
|
|
|
candidates))
|
|
|
|
|
|
;; if there is no information stored for this source then do nothing
|
|
|
|
|
|
candidates)))
|
2016-04-21 21:27:19 +00:00
|
|
|
|
|
|
|
|
|
|
;;;###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 candidates X and Y taking into account that the
|
|
|
|
|
|
candidate can be in (DISPLAY . REAL) format."
|
|
|
|
|
|
(equal (if (listp x) (cdr x) x)
|
|
|
|
|
|
(if (listp y) (cdr y) y)))
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
|
(provide 'helm-adaptive)
|
|
|
|
|
|
|
|
|
|
|
|
;; Local Variables:
|
|
|
|
|
|
;; byte-compile-warnings: (not cl-functions obsolete)
|
|
|
|
|
|
;; coding: utf-8
|
|
|
|
|
|
;; indent-tabs-mode: nil
|
|
|
|
|
|
;; End:
|
|
|
|
|
|
|
|
|
|
|
|
;;; helm-adaptive.el ends here
|
