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.

388 lines
16 KiB

пре 4 година
  1. ;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
  2. ;; Copyright (C) 2012 ~ 2019 Thierry Volpiatto <thierry.volpiatto@gmail.com>
  3. ;; This program is free software; you can redistribute it and/or modify
  4. ;; it under the terms of the GNU General Public License as published by
  5. ;; the Free Software Foundation, either version 3 of the License, or
  6. ;; (at your option) any later version.
  7. ;; This program is distributed in the hope that it will be useful,
  8. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  9. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  10. ;; GNU General Public License for more details.
  11. ;; You should have received a copy of the GNU General Public License
  12. ;; along with this program. If not, see <http://www.gnu.org/licenses/>.
  13. ;;; Code:
  14. (require 'helm)
  15. (require 'helm-lib)
  16. (require 'helm-help)
  17. (require 'helm-elisp) ; For show-completion.
  18. (defgroup helm-dabbrev nil
  19. "Dabbrev related Applications and libraries for Helm."
  20. :group 'helm)
  21. (defcustom helm-dabbrev-always-search-all t
  22. "Always search in all buffers when non--nil.
  23. Note that even if nil, a search in all buffers
  24. will occur if the length of candidates is <= than
  25. `helm-dabbrev-max-length-result'."
  26. :group 'helm-dabbrev
  27. :type 'boolean)
  28. (defcustom helm-dabbrev-candidates-number-limit 1000
  29. "Maximum number of candidates to collect.
  30. Higher this number is, slower the computation of candidates will be.
  31. You can use safely a higher value with emacs-26+.
  32. Note that this have nothing to do with `helm-candidate-number-limit'."
  33. :group 'helm-dabbrev
  34. :type 'integer)
  35. (defcustom helm-dabbrev-ignored-buffers-regexps
  36. '("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List")
  37. "List of regexps matching names of buffers that helm-dabbrev should not check."
  38. :group 'helm-dabbrev
  39. :type '(repeat regexp))
  40. (defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
  41. "A function that decide if a buffer to search in is related to `current-buffer'.
  42. This is actually determined by comparing `major-mode' of the buffer to search
  43. and the `current-buffer'.
  44. The function take one arg, the buffer which is current, look at
  45. `helm-dabbrev--same-major-mode-p' for example.
  46. When nil all buffers are considered related to `current-buffer'."
  47. :group 'helm-dabbrev
  48. :type 'function)
  49. (defcustom helm-dabbrev-major-mode-assoc nil
  50. "Major mode association alist.
  51. This allow helm-dabbrev searching in buffers with the associated `major-mode'.
  52. e.g \(emacs-lisp-mode . lisp-interaction-mode\)
  53. will allow searching in the lisp-interaction-mode buffer when `current-buffer'
  54. is an `emacs-lisp-mode' buffer and vice versa i.e
  55. no need to provide \(lisp-interaction-mode . emacs-lisp-mode\) association.
  56. When nil check is the searched buffer have same `major-mode'
  57. than the `current-buffer'.
  58. This have no effect when `helm-dabbrev-related-buffer-fn' is nil or of course
  59. bound to a function that doesn't handle this var."
  60. :type '(alist :key-type symbol :value-type symbol)
  61. :group 'helm-dabbrev)
  62. (defcustom helm-dabbrev-lineno-around 30
  63. "Search first in this number of lines before an after point."
  64. :group 'helm-dabbrev
  65. :type 'integer)
  66. (defcustom helm-dabbrev-cycle-threshold 5
  67. "Number of time helm-dabbrev cycle before displaying helm completion.
  68. When nil or 0 disable cycling."
  69. :group 'helm-dabbrev
  70. :type '(choice (const :tag "Cycling disabled" nil) integer))
  71. (defcustom helm-dabbrev-case-fold-search 'smart
  72. "Set `case-fold-search' in `helm-dabbrev'.
  73. Same as `helm-case-fold-search' but for `helm-dabbrev'.
  74. Note that this is not affecting searching in helm buffer,
  75. but the initial search for all candidates in buffer(s)."
  76. :group 'helm-dabbrev
  77. :type '(choice (const :tag "Ignore case" t)
  78. (const :tag "Respect case" nil)
  79. (other :tag "Smart" 'smart)))
  80. (defcustom helm-dabbrev-use-thread nil
  81. "[EXPERIMENTAL] Compute candidates asynchronously (partially) when non nil.
  82. The idea is to compute candidates while cycling the first ones, so
  83. this is available only if `helm-dabbrev-cycle-threshold' is not 0 or
  84. nil, also it is available only on emacs-26+ (needs threads).
  85. This is reasonably working when you don't have to complete a huge list
  86. of candidates, otherwise you will have a small delay after the first cycle
  87. because thread is released unexpectedly when helm-dabbrev exit after
  88. first insertion.
  89. IOW keep `helm-dabbrev-candidates-number-limit' to a reasonable
  90. value (I don't!) and give enough prefix before completing e.g. for
  91. completing \"helm-dabbrev\" use \"helm-d\" and not \"he\" if you want
  92. to use this."
  93. :group 'helm-dabbrev
  94. :type 'boolean)
  95. (defvaralias 'helm-dabbrev--regexp 'helm-dabbrev-separator-regexp)
  96. (make-obsolete-variable 'helm-dabbrev--regexp
  97. 'helm-dabbrev-separator-regexp "2.8.3")
  98. ;; Check for beginning of line should happen last (^\n\\|^).
  99. (defvar helm-dabbrev-separator-regexp
  100. "\\s-\\|\t\\|[(\\[\\{\"'`=<$;,@.#+]\\|\\s\\\\|^\n\\|^"
  101. "Regexp matching the start of a dabbrev candidate.")
  102. (defvar helm-dabbrev-map
  103. (let ((map (make-sparse-keymap)))
  104. (set-keymap-parent map helm-map)
  105. (define-key map (kbd "M-/") 'helm-next-line)
  106. (define-key map (kbd "M-:") 'helm-previous-line)
  107. map))
  108. ;; Internal
  109. (defvar helm-dabbrev--cache nil)
  110. (defvar helm-dabbrev--data nil)
  111. (cl-defstruct helm-dabbrev-info dabbrev limits iterator)
  112. (defvar helm-dabbrev--already-tried nil)
  113. (defvar helm-dabbrev--current-thread nil)
  114. (defun helm-dabbrev--buffer-list ()
  115. (cl-loop for buf in (buffer-list)
  116. unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps
  117. thereis (string-match r (buffer-name buf)))
  118. collect buf))
  119. (defun helm-dabbrev--same-major-mode-p (start-buffer)
  120. "Decide if current-buffer is related to START-BUFFER."
  121. (helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc))
  122. (defun helm-dabbrev--collect (str limit ignore-case all)
  123. (let* ((case-fold-search ignore-case)
  124. (buffer1 (current-buffer)) ; start buffer.
  125. (minibuf (minibufferp buffer1))
  126. result pos-before pos-after
  127. (search-and-store
  128. (lambda (pattern direction)
  129. (while (and (<= (length result) limit)
  130. (cl-case direction
  131. (1 (search-forward pattern nil t))
  132. (-1 (search-backward pattern nil t))
  133. (2 (let ((pos
  134. (save-excursion
  135. (forward-line
  136. helm-dabbrev-lineno-around)
  137. (point))))
  138. (setq pos-after pos)
  139. (search-forward pattern pos t)))
  140. (-2 (let ((pos
  141. (save-excursion
  142. (forward-line
  143. (- helm-dabbrev-lineno-around))
  144. (point))))
  145. (setq pos-before pos)
  146. (search-backward pattern pos t)))))
  147. (let* ((pbeg (match-beginning 0))
  148. (replace-regexp (concat "\\(" helm-dabbrev-separator-regexp
  149. "\\)\\'"))
  150. (match-word (helm-dabbrev--search
  151. pattern pbeg replace-regexp)))
  152. (when (and match-word (not (member match-word result)))
  153. (push match-word result)))))))
  154. (catch 'break
  155. (dolist (buf (if all (helm-dabbrev--buffer-list)
  156. (list (current-buffer))))
  157. (with-current-buffer buf
  158. (when (or minibuf ; check against all buffers when in minibuffer.
  159. (if helm-dabbrev-related-buffer-fn
  160. (funcall helm-dabbrev-related-buffer-fn buffer1)
  161. t))
  162. (save-excursion
  163. ;; Start searching before thing before point.
  164. (goto-char (- (point) (length str)))
  165. ;; Search the last 30 lines before point.
  166. (funcall search-and-store str -2)) ; store pos [1]
  167. (save-excursion
  168. ;; Search the next 30 lines after point.
  169. (funcall search-and-store str 2)) ; store pos [2]
  170. (save-excursion
  171. ;; Search all before point.
  172. ;; If limit is reached in previous call of
  173. ;; search-and-store pos-before is never set and
  174. ;; goto-char will fail, so check it.
  175. (when pos-before
  176. (goto-char pos-before) ; start from [1]
  177. (funcall search-and-store str -1)))
  178. (save-excursion
  179. ;; Search all after point.
  180. ;; Same comment as above for pos-after.
  181. (when pos-after
  182. (goto-char pos-after) ; start from [2]
  183. (funcall search-and-store str 1)))))
  184. (when (>= (length result) limit) (throw 'break nil))))
  185. (nreverse result)))
  186. (defun helm-dabbrev--search (pattern beg sep-regexp)
  187. "Search word or symbol at point matching PATTERN.
  188. Argument BEG is corresponding to the previous match-beginning search.
  189. The search starts at (1- BEG) with a regexp starting with
  190. `helm-dabbrev-separator-regexp' followed by PATTERN followed by a
  191. regexp matching syntactically any word or symbol.
  192. The possible false positives matching SEP-REGEXP at end are finally
  193. removed."
  194. (let ((eol (point-at-eol)))
  195. (save-excursion
  196. (goto-char (1- beg))
  197. (when (re-search-forward
  198. (concat "\\("
  199. helm-dabbrev-separator-regexp
  200. "\\)"
  201. "\\(?99:\\("
  202. (regexp-quote pattern)
  203. "\\(\\sw\\|\\s_\\)+\\)\\)")
  204. eol t)
  205. (replace-regexp-in-string
  206. sep-regexp ""
  207. (match-string-no-properties 99))))))
  208. (defun helm-dabbrev--get-candidates (dabbrev &optional limit)
  209. (cl-assert dabbrev nil "[No Match]")
  210. (helm-dabbrev--collect
  211. dabbrev (or limit helm-dabbrev-candidates-number-limit)
  212. (cl-case helm-dabbrev-case-fold-search
  213. (smart (helm-set-case-fold-search-1 dabbrev))
  214. (t helm-dabbrev-case-fold-search))
  215. helm-dabbrev-always-search-all))
  216. (defun helm-dabbrev-default-action (candidate)
  217. (with-helm-current-buffer
  218. (let* ((limits (helm-bounds-of-thing-before-point
  219. helm-dabbrev-separator-regexp))
  220. (beg (car limits))
  221. (end (point)))
  222. (run-with-timer
  223. 0.01 nil
  224. 'helm-insert-completion-at-point
  225. beg end candidate))))
  226. ;;;###autoload
  227. (cl-defun helm-dabbrev ()
  228. "Preconfigured helm for dynamic abbreviations."
  229. (interactive)
  230. (let ((dabbrev (helm-thing-before-point
  231. nil helm-dabbrev-separator-regexp))
  232. (limits (helm-bounds-of-thing-before-point
  233. helm-dabbrev-separator-regexp))
  234. (enable-recursive-minibuffers t)
  235. (cycling-disabled-p (or (null helm-dabbrev-cycle-threshold)
  236. (zerop helm-dabbrev-cycle-threshold)))
  237. (helm-execute-action-at-once-if-one t)
  238. (helm-quit-if-no-candidate
  239. (lambda ()
  240. (message "[Helm-dabbrev: No expansion found]"))))
  241. (cl-assert (and (stringp dabbrev) (not (string= dabbrev "")))
  242. nil "[Helm-dabbrev: Nothing found before point]")
  243. (when (and
  244. ;; have been called at least once.
  245. (helm-dabbrev-info-p helm-dabbrev--data)
  246. ;; But user have moved with some other command
  247. ;; in the meaning time.
  248. (not (eq last-command 'helm-dabbrev)))
  249. (setq helm-dabbrev--data nil))
  250. ;; When candidates are requested in helm directly without cycling,
  251. ;; we need them right now before running helm, so no need to use a
  252. ;; thread here.
  253. (when cycling-disabled-p
  254. (setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)))
  255. (unless (or cycling-disabled-p
  256. (helm-dabbrev-info-p helm-dabbrev--data))
  257. (setq helm-dabbrev--data
  258. (make-helm-dabbrev-info
  259. :dabbrev dabbrev
  260. :limits limits
  261. :iterator
  262. (helm-iter-list
  263. (cl-loop for i in (helm-dabbrev--get-candidates
  264. dabbrev helm-dabbrev-cycle-threshold)
  265. when (string-match-p
  266. (concat "^" (regexp-quote dabbrev)) i)
  267. collect i))))
  268. ;; Thread is released as soon as helm-dabbrev exits after first
  269. ;; insertion so this is unusable for now, keep it like this for
  270. ;; now hooping the situation with threads will be improved in
  271. ;; emacs. The idea is to compute whole list of candidates in
  272. ;; background while cycling with the first
  273. ;; helm-dabbrev-cycle-threshold ones.
  274. (when (and (fboundp 'make-thread) helm-dabbrev-use-thread)
  275. (setq helm-dabbrev--current-thread
  276. (make-thread
  277. (lambda ()
  278. (setq helm-dabbrev--cache
  279. (helm-dabbrev--get-candidates dabbrev)))))))
  280. (let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data)
  281. (helm-dabbrev-info-iterator helm-dabbrev--data)))
  282. deactivate-mark)
  283. ;; Cycle until iterator is consumed.
  284. (helm-aif (and iter (helm-iter-next iter))
  285. (progn
  286. (helm-insert-completion-at-point
  287. (car (helm-dabbrev-info-limits helm-dabbrev--data))
  288. ;; END is the end of the previous inserted string, not
  289. ;; the end (apart for first insertion) of the initial string.
  290. (cdr limits) it)
  291. ;; Move already tried candidates to end of list.
  292. (push it helm-dabbrev--already-tried))
  293. ;; Iterator is now empty, reset dabbrev to initial value
  294. ;; and start helm completion.
  295. (let* ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data)
  296. (helm-dabbrev-info-dabbrev helm-dabbrev--data)
  297. dabbrev))
  298. (only-one (null (cdr (all-completions
  299. old-dabbrev
  300. helm-dabbrev--already-tried)))))
  301. (unless helm-dabbrev-use-thread
  302. (message "Waiting for helm-dabbrev candidates...")
  303. (setq helm-dabbrev--cache
  304. (helm-dabbrev--get-candidates old-dabbrev)))
  305. ;; If the length of candidates is only one when computed
  306. ;; that's mean the unique matched item have already been
  307. ;; inserted by the iterator, so no need to reinsert the old dabbrev,
  308. ;; just let helm exiting with "No expansion found".
  309. (unless (or only-one cycling-disabled-p)
  310. (setq dabbrev old-dabbrev
  311. limits (helm-dabbrev-info-limits helm-dabbrev--data))
  312. (setq helm-dabbrev--data nil)
  313. (delete-region (car limits) (point))
  314. (insert dabbrev))
  315. ;; Cycling is finished, block until helm-dabbrev--cache have
  316. ;; finished to complete.
  317. (when (and (fboundp 'thread-join)
  318. helm-dabbrev-use-thread
  319. (thread-alive-p helm-dabbrev--current-thread))
  320. (thread-join helm-dabbrev--current-thread))
  321. (when (and (null cycling-disabled-p) only-one)
  322. (cl-return-from helm-dabbrev
  323. (message "[Helm-dabbrev: No expansion found]")))
  324. (with-helm-show-completion (car limits) (cdr limits)
  325. (unwind-protect
  326. (helm :sources
  327. (helm-build-in-buffer-source "Dabbrev Expand"
  328. :data
  329. (cl-loop for cand in helm-dabbrev--cache
  330. unless
  331. (member cand helm-dabbrev--already-tried)
  332. collect cand into lst
  333. finally return
  334. (append lst helm-dabbrev--already-tried))
  335. :persistent-action 'ignore
  336. :persistent-help "DoNothing"
  337. :keymap helm-dabbrev-map
  338. :action 'helm-dabbrev-default-action
  339. :group 'helm-dabbrev)
  340. :buffer "*helm dabbrev*"
  341. :input (concat "^" dabbrev " ")
  342. :resume 'noresume
  343. :allow-nest t)
  344. (setq helm-dabbrev--already-tried nil))))))))
  345. (provide 'helm-dabbrev)
  346. ;; Local Variables:
  347. ;; byte-compile-warnings: (not obsolete)
  348. ;; coding: utf-8
  349. ;; indent-tabs-mode: nil
  350. ;; End:
  351. ;;; helm-dabbrev.el ends here