forked from emacs-helm/helm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
helm-adaptive.el
244 lines (212 loc) · 10.9 KB
/
helm-adaptive.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
;;; helm-adaptive.el --- Adaptive Sorting of Candidates. -*- lexical-binding: t -*-
;; Original Author: Tamas Patrovics
;; Copyright (C) 2007 Tamas Patrovics
;; Copyright (C) 2012 ~ 2015 Thierry Volpiatto <[email protected]>
;; 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)))
(adapt-source (or (assoc-default 'filtered-candidate-transformer
(assoc (assoc-default 'type source)
helm-type-attributes))
(assoc-default 'candidate-transformer
(assoc (assoc-default 'type source)
helm-type-attributes))
(assoc-default 'filtered-candidate-transformer source)
(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))))
(selection (helm-get-selection))
(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
;; ... assemble a list containing the (CANIDATE . USAGE-COUNT)
;; pairs
(mapcar (lambda (candidate-info)
(let ((count 0))
(cl-dolist (pattern-info (cdr candidate-info))
(if (not (equal (car pattern-info)
helm-pattern))
(cl-incf count (cdr pattern-info))
;; 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 (cdr pattern-info)))
(cl-return)))
(cons (car candidate-info) count)))
(cdr source-info))))
(if (and usage (consp usage))
;; sort the list in descending order, so candidates with highest
;; priorty come first
(progn
(setq usage (sort usage (lambda (first second)
(> (cdr first) (cdr second)))))
;; put those candidates first which have the highest usage count
(cl-loop for (info . _freq) in usage
for member = (cl-member info candidates
:test 'helm-adaptive-compare)
when member collect (car member) 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 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