mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-19 a4b9172aefa91861b587831e06f55b1e19f3f3be
commit | author | age
5cb5f7 1 ;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-
C 2
3 ;; Original Author: Tamas Patrovics
4
5 ;; Copyright (C) 2007 Tamas Patrovics
6 ;; Copyright (C) 2012 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com>
7
8 ;; This program is free software; you can redistribute it and/or modify
9 ;; it under the terms of the GNU General Public License as published by
10 ;; the Free Software Foundation, either version 3 of the License, or
11 ;; (at your option) any later version.
12
13 ;; This program is distributed in the hope that it will be useful,
14 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
16 ;; GNU General Public License for more details.
17
18 ;; You should have received a copy of the GNU General Public License
19 ;; along with this program.  If not, see <http://www.gnu.org/licenses/>.
20
21 ;;; Code:
22
23 (require 'cl-lib)
24 (require 'helm)
25
26
27 (defgroup helm-adapt nil
28   "Adaptative sorting of candidates for Helm."
29   :group 'helm)
30
31 (defcustom helm-adaptive-history-file
32   "~/.emacs.d/helm-adaptive-history"
33   "Path of file where history information is stored.
34 When nil history is not saved nor restored after emacs restart unless
35 you save/restore `helm-adaptive-history' with something else like
36 psession or desktop."
37   :type 'string
38   :group 'helm-adapt)
39
40 (defcustom helm-adaptive-history-length 50
41   "Maximum number of candidates stored for a source."
42   :type 'number
43   :group 'helm-adapt)
44
45 (defcustom helm-adaptive-sort-by-frequent-recent-usage t
46   "Try to sort on an average of frequent and recent usage when non-nil.
47
48 When nil sort on frequency usage only.
49
50 Only frequency:
51 When candidate have low frequency, you have to hit on it many times to
52 make it going up on top.
53
54 Frequency+recent:
55 Even with a low frequency, candidate go up on top. If a candidate
56 have a high frequency but it is not used since some time, it goes
57 down slowly, but as soon you reuse it it go up on top quickly."
58   :group 'helm-adapt
59   :type 'boolean)
60
61 ;; Internal
62 (defvar helm-adaptive-done nil
63   "nil if history information is not yet stored for the current
64 selection.")
65
66 (defvar helm-adaptive-history nil
67   "Contains the stored history information.
68 Format: ((SOURCE-NAME (SELECTED-CANDIDATE (PATTERN . NUMBER-OF-USE) ...) ...) ...)")
69
70 (defconst helm-adaptive-freq-coefficient 5)
71 (defconst helm-adaptive-recent-coefficient 2)
72
73 (defun helm-adaptive-done-reset ()
74   (setq helm-adaptive-done nil))
75
76 ;;;###autoload
77 (define-minor-mode helm-adaptive-mode
78   "Toggle adaptive sorting in all sources."
79   :group 'helm-adapt
80   :require 'helm-adaptive
81   :global t
82   (if helm-adaptive-mode
83       (progn
84         (unless helm-adaptive-history
85           (helm-adaptive-maybe-load-history))
86         (add-hook 'kill-emacs-hook 'helm-adaptive-save-history)
87         ;; Should run at beginning of `helm-initial-setup'.
88         (add-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset)
89         ;; Should run at beginning of `helm-exit-minibuffer'.
90         (add-hook 'helm-before-action-hook 'helm-adaptive-store-selection)
91         ;; Should run at beginning of `helm-select-action'.
92         (add-hook 'helm-select-action-hook 'helm-adaptive-store-selection))
93     (helm-adaptive-save-history)
94     (setq helm-adaptive-history nil)
95     (remove-hook 'kill-emacs-hook 'helm-adaptive-save-history)
96     (remove-hook 'helm-before-initialize-hook 'helm-adaptive-done-reset)
97     (remove-hook 'helm-before-action-hook 'helm-adaptive-store-selection)
98     (remove-hook 'helm-select-action-hook 'helm-adaptive-store-selection)))
99
100 (defun helm-adapt-use-adaptive-p (&optional source-name)
101   "Return current source only if it use adaptive history, nil otherwise."
102   (when helm-adaptive-mode
103     (let* ((source (or source-name (helm-get-current-source)))
104            (adapt-source (or (assoc-default 'filtered-candidate-transformer source)
105                              (assoc-default 'candidate-transformer source))))
106       (if (listp adapt-source)
107           (and (memq 'helm-adaptive-sort adapt-source) source)
108         (and (eq adapt-source 'helm-adaptive-sort) source)))))
109
110 (defun helm-adaptive-store-selection ()
111   "Store history information for the selected candidate."
112   (unless helm-adaptive-done
113     (setq helm-adaptive-done t)
114     (let ((source (helm-adapt-use-adaptive-p)))
115       (when source
116         (let* ((source-name (assoc-default 'name source))
117                (source-info (or (assoc source-name helm-adaptive-history)
118                                 (progn
119                                   (push (list source-name) helm-adaptive-history)
120                                   (car helm-adaptive-history))))
121                (selection (helm-get-selection nil t))
122                (selection-info (progn
123                                  (setcdr source-info
124                                          (cons
125                                           (let ((found (assoc selection (cdr source-info))))
126                                             (if (not found)
127                                                 ;; new entry
128                                                 (list selection)
129                                               ;; move entry to the beginning of the
130                                               ;; list, so that it doesn't get
131                                               ;; trimmed when the history is
132                                               ;; truncated
133                                               (setcdr source-info
134                                                       (delete found (cdr source-info)))
135                                               found))
136                                           (cdr source-info)))
137                                  (cadr source-info)))
138                (pattern-info (progn
139                                (setcdr selection-info
140                                        (cons
141                                         (let ((found (assoc helm-pattern (cdr selection-info))))
142                                           (if (not found)
143                                               ;; new entry
144                                               (cons helm-pattern 0)
145                                             ;; move entry to the beginning of the
146                                             ;; list, so if two patterns used the
147                                             ;; same number of times then the one
148                                             ;; used last appears first in the list
149                                             (setcdr selection-info
150                                                     (delete found (cdr selection-info)))
151                                             found))
152                                         (cdr selection-info)))
153                                (cadr selection-info)))
154                (timestamp-info (helm-aif (assq 'timestamp (cdr selection-info))
155                                    it
156                                  (setcdr selection-info (cons (cons 'timestamp 0) (cdr selection-info)))
157                                  (cadr selection-info))))
158           ;; Increase usage count.
159           (setcdr pattern-info (1+ (cdr pattern-info)))
160           ;; Update timestamp.
161           (setcdr timestamp-info (float-time))
162           ;; Truncate history if needed.
163           (if (> (length (cdr selection-info)) helm-adaptive-history-length)
164               (setcdr selection-info
165                       (cl-subseq (cdr selection-info) 0 helm-adaptive-history-length))))))))
166
167 (defun helm-adaptive-maybe-load-history ()
168   "Load `helm-adaptive-history-file' which contain `helm-adaptive-history'.
169 Returns nil if `helm-adaptive-history-file' doesn't exist."
170   (when (and helm-adaptive-history-file
171              (file-readable-p helm-adaptive-history-file))
172     (load-file helm-adaptive-history-file)))
173
174 (defun helm-adaptive-save-history (&optional arg)
175   "Save history information to file given by `helm-adaptive-history-file'."
176   (interactive "p")
177   (when helm-adaptive-history-file
178     (with-temp-buffer
179       (insert
180        ";; -*- mode: emacs-lisp -*-\n"
181        ";; History entries used for helm adaptive display.\n")
182       (let (print-length print-level)
183         (prin1 `(setq helm-adaptive-history ',helm-adaptive-history)
184                (current-buffer)))
185       (insert ?\n)
186       (write-region (point-min) (point-max) helm-adaptive-history-file nil
187                     (unless arg 'quiet)))))
188
189 (defun helm-adaptive-sort (candidates source)
190   "Sort the CANDIDATES for SOURCE by usage frequency.
191 This is a filtered candidate transformer you can use with the
192 `filtered-candidate-transformer' attribute."
193   (let* ((source-name (assoc-default 'name source))
194          (source-info (assoc source-name helm-adaptive-history)))
195     (if source-info
196         (let ((usage
197                ;; Loop in the SOURCE entry of `helm-adaptive-history'
198                ;; and assemble a list containing the (CANDIDATE
199                ;; . USAGE-COUNT) pairs.
200                (cl-loop with cf = (if helm-adaptive-sort-by-frequent-recent-usage
201                                       helm-adaptive-freq-coefficient 1)
202                         with cr = helm-adaptive-recent-coefficient
203                         for (src-cand . infos) in (cdr source-info)
204                         for count-freq = 0
205                         for count-rec =
206                         (helm-aif (and helm-adaptive-sort-by-frequent-recent-usage
207                                        (assq 'timestamp infos))
208                             (* cr (+ (float-time) (cdr it)))
209                           0)
210                         do (cl-loop for (pattern . score) in
211                                     (remove (assq 'timestamp infos) infos)
212                                     ;; If current pattern is equal to
213                                     ;; the previously used one then
214                                     ;; this candidate has priority
215                                     ;; (that's why its count-freq is
216                                     ;; boosted by 10000) and it only
217                                     ;; has to compete with other
218                                     ;; candidates which were also
219                                     ;; selected with the same pattern.
220                                     if (equal pattern helm-pattern)
221                                     return (setq count-freq (+ 10000 score))
222                                     else do (cl-incf count-freq score))
223                         and collect (cons src-cand (+ (* count-freq cf) count-rec))
224                         into results
225                         ;; Sort the list in descending order, so
226                         ;; candidates with highest priority come
227                         ;; first.
228                         finally return
229                         (sort results (lambda (first second)
230                                         (> (cdr first) (cdr second)))))))
231           (if (consp usage)
232               ;; Put those candidates first which have the highest usage count.
233               (cl-loop for (cand . _freq) in usage
234                        for info = (or (and (assq 'multiline source)
235                                            (replace-regexp-in-string
236                                             "\n\\'" "" cand))
237                                       cand)
238                        when (cl-member info candidates
239                                        :test 'helm-adaptive-compare)
240                        collect (car it) into sorted
241                        and do (setq candidates
242                                     (cl-remove info candidates
243                                                :test 'helm-adaptive-compare))
244                        finally return (append sorted candidates))
245               (message "Your `%s' is maybe corrupted or too old, \
246 you should reinitialize it with `helm-reset-adaptive-history'"
247                        helm-adaptive-history-file)
248               (sit-for 1)
249               candidates))
250         ;; if there is no information stored for this source then do nothing
251         candidates)))
252
253 ;;;###autoload
254 (defun helm-reset-adaptive-history ()
255   "Delete all `helm-adaptive-history' and his file.
256 Useful when you have a old or corrupted `helm-adaptive-history-file'."
257   (interactive)
258   (when (y-or-n-p "Really delete all your `helm-adaptive-history'? ")
259     (setq helm-adaptive-history nil)
260     (delete-file helm-adaptive-history-file)))
261
262 (defun helm-adaptive-compare (x y)
263   "Compare display parts if some of candidates X and Y.
264
265 Arguments X and Y are cons cell in (DISPLAY . REAL) format or atoms."
266   (equal (if (listp x) (car x) x)
267          (if (listp y) (car y) y)))
268
269
270 (provide 'helm-adaptive)
271
272 ;; Local Variables:
273 ;; byte-compile-warnings: (not obsolete)
274 ;; coding: utf-8
275 ;; indent-tabs-mode: nil
276 ;; End:
277
278 ;;; helm-adaptive.el ends here