Klimi's new dotfiles with stow.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

278 lines
13 KiB

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