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