| 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 | |
