forked from emacs-helm/helm
-
Notifications
You must be signed in to change notification settings - Fork 0
/
helm-dabbrev.el
356 lines (325 loc) · 15.8 KB
/
helm-dabbrev.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
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
;; 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 'helm)
(require 'helm-help)
(require 'helm-elisp) ; For show-completion.
(defgroup helm-dabbrev nil
"Dabbrev related Applications and libraries for Helm."
:group 'helm)
(defcustom helm-dabbrev-always-search-all t
"Always search in all buffers when non--nil.
Note that even if nil, a search in all buffers
will occur if the length of candidates is <= than
`helm-dabbrev-max-length-result'."
:group 'helm-dabbrev
:type 'boolean)
(defcustom helm-dabbrev-max-length-result 20
"Max length of candidates before searching in all buffers.
If number of candidates found in current-buffer is <= to this,
search in all buffers.
Have no effect when `helm-dabbrev-always-search-all' is non--nil."
:group 'helm-dabbrev
:type 'integer)
(defcustom helm-dabbrev-ignored-buffers-regexps
'("\\*helm" "\\*Messages" "\\*Echo Area" "\\*Buffer List")
"List of regexps matching names of buffers that helm-dabbrev should not check."
:group 'helm-dabbrev
:type '(repeat regexp))
(defcustom helm-dabbrev-related-buffer-fn #'helm-dabbrev--same-major-mode-p
"A function that decide if a buffer to search in is related to `current-buffer'.
This is actually determined by comparing `major-mode' of the buffer to search
and the `current-buffer'.
The function take one arg, the buffer which is current, look at
`helm-dabbrev--same-major-mode-p' for example.
When nil all buffers are considered related to `current-buffer'."
:group 'helm-dabbrev
:type 'function)
(defcustom helm-dabbrev-major-mode-assoc
'((emacs-lisp-mode . lisp-interaction-mode))
"Major mode association alist.
This allow helm-dabbrev searching in buffers with the associated `major-mode'.
e.g \(emacs-lisp-mode . lisp-interaction-mode\)
will allow searching in the lisp-interaction-mode buffer when `current-buffer'
is an `emacs-lisp-mode' buffer and vice versa i.e
no need to provide \(lisp-interaction-mode . emacs-lisp-mode\) association.
When nil check is the searched buffer have same `major-mode'
than the `current-buffer'.
This have no effect when `helm-dabbrev-related-buffer-fn' is nil or of course
bound to a function that doesn't handle this var."
:type '(alist :key-type symbol :value-type symbol)
:group 'helm-dabbrev)
(defcustom helm-dabbrev-lineno-around 30
"Search first in this number of lines before an after point."
:group 'helm-dabbrev
:type 'integer)
(defcustom helm-dabbrev-cycle-threshold nil
"Number of time helm-dabbrev cycle before displaying helm completion.
When nil or 0 disable cycling."
:group 'helm-dabbrev
:type '(choice (const :tag "Cycling disabled" nil) integer))
(defcustom helm-dabbrev-case-fold-search 'smart
"Set `case-fold-search' in `helm-dabbrev'.
Same as `helm-case-fold-search' but for `helm-dabbrev'.
Note that this is not affecting searching in helm buffer,
but the initial search for all candidates in buffer(s)."
:group 'helm-dabbrev
:type '(choice (const :tag "Ignore case" t)
(const :tag "Respect case" nil)
(other :tag "Smart" 'smart)))
(defvar helm-dabbrev-map
(let ((map (make-sparse-keymap)))
(set-keymap-parent map helm-map)
(define-key map (kbd "M-/") 'helm-next-line)
(define-key map (kbd "M-:") 'helm-previous-line)
map))
;; Internal
(defvar helm-dabbrev--exclude-current-buffer-flag nil)
(defvar helm-dabbrev--cache nil)
(defvar helm-dabbrev--data nil)
(defvar helm-dabbrev--regexp "\\s-\\|\t\\|[(\[\{\"'`=<$;.]\\|\\s\\\\|^")
(cl-defstruct helm-dabbrev-info dabbrev limits iterator)
(defun helm-dabbrev--buffer-list ()
(cl-loop with lst = (buffer-list)
for buf in (if helm-dabbrev--exclude-current-buffer-flag
(cdr lst) lst)
unless (cl-loop for r in helm-dabbrev-ignored-buffers-regexps
thereis (string-match r (buffer-name buf)))
collect buf))
(defun helm-dabbrev--same-major-mode-p (start-buffer)
;; START-BUFFER is the current-buffer where we start searching.
;; Determine the major-mode of START-BUFFER as `cur-maj-mode'.
;; Each time the loop go in another buffer we try to find if its
;; `major-mode' is:
;; - same as the `cur-maj-mode'
;; - derived from `cur-maj-mode'
;; - have an assoc entry (major-mode . cur-maj-mode)
;; - have an rassoc entry (cur-maj-mode . major-mode)
;; - check if one of these entries inherit from another one in
;; `helm-dabbrev-major-mode-assoc'.
(let* ((cur-maj-mode (with-current-buffer start-buffer major-mode))
(c-assoc-mode (assq cur-maj-mode helm-dabbrev-major-mode-assoc))
(c-rassoc-mode (rassq cur-maj-mode helm-dabbrev-major-mode-assoc))
(o-assoc-mode (assq major-mode helm-dabbrev-major-mode-assoc))
(o-rassoc-mode (rassq major-mode helm-dabbrev-major-mode-assoc))
(cdr-c-assoc-mode (cdr c-assoc-mode))
(cdr-o-assoc-mode (cdr o-assoc-mode)))
(or (eq major-mode cur-maj-mode)
(derived-mode-p cur-maj-mode)
(or (eq cdr-c-assoc-mode major-mode)
(eq (car c-rassoc-mode) major-mode)
(eq (cdr (assq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc))
major-mode)
(eq (car (rassq cdr-c-assoc-mode helm-dabbrev-major-mode-assoc))
major-mode))
(or (eq cdr-o-assoc-mode cur-maj-mode)
(eq (car o-rassoc-mode) cur-maj-mode)
(eq (cdr (assq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc))
cur-maj-mode)
(eq (car (rassq cdr-o-assoc-mode helm-dabbrev-major-mode-assoc))
cur-maj-mode)))))
(defun helm-dabbrev--collect (str limit ignore-case all)
(let* ((case-fold-search ignore-case)
(buffer1 (current-buffer)) ; start buffer.
(minibuf (minibufferp buffer1))
result pos-before pos-after
(search-and-store
(lambda (pattern direction)
(while (cl-case direction
(1 (search-forward pattern nil t))
(-1 (search-backward pattern nil t))
(2 (let ((pos
(save-excursion
(forward-line
helm-dabbrev-lineno-around)
(point))))
(setq pos-after pos)
(search-forward pattern pos t)))
(-2 (let ((pos
(save-excursion
(forward-line
(- helm-dabbrev-lineno-around))
(point))))
(setq pos-before pos)
(search-backward pattern pos t))))
(let* ((replace-regexp (concat "\\(" helm-dabbrev--regexp "\\)\\'"))
(match-1 (helm-aif (thing-at-point 'symbol)
;; `thing-at-point' returns
;; the quote outside of e-lisp mode,
;; e.g in message mode,
;; `foo' => foo'
;; but in e-lisp like modes:
;; `foo' => foo
;; so remove it [1].
(replace-regexp-in-string
replace-regexp
"" (substring-no-properties it))))
(match-2 (helm-aif (thing-at-point 'filename)
;; Same as in [1].
(replace-regexp-in-string
replace-regexp
"" (substring-no-properties it))))
(lst (if (string= match-1 match-2)
(list match-1)
(list match-1 match-2))))
(cl-loop for match in lst
unless (or (string= str match)
(member match result))
do (push match result)))))))
(cl-loop for buf in (if all (helm-dabbrev--buffer-list)
(list (current-buffer)))
do (with-current-buffer buf
(when (or minibuf ; check against all buffers when in minibuffer.
(if helm-dabbrev-related-buffer-fn
(funcall helm-dabbrev-related-buffer-fn buffer1)
t))
(save-excursion
;; Start searching before thing before point.
(goto-char (- (point) (length str)))
;; Search the last 30 lines before point.
(funcall search-and-store str -2)) ; store pos [1]
(save-excursion
;; Search the next 30 lines after point.
(funcall search-and-store str 2)) ; store pos [2]
(save-excursion
;; Search all before point.
(goto-char pos-before) ; start from [1]
(funcall search-and-store str -1))
(save-excursion
;; Search all after point.
(goto-char pos-after) ; start from [2]
(funcall search-and-store str 1))))
when (> (length result) limit) return (nreverse result)
finally return (nreverse result))))
(defun helm-dabbrev--get-candidates (abbrev)
(cl-assert abbrev nil "[No Match]")
(with-current-buffer (current-buffer)
(let* ((dabbrev-get (lambda (str all-bufs)
(helm-dabbrev--collect
str helm-candidate-number-limit
(cl-case helm-dabbrev-case-fold-search
(smart (helm-set-case-fold-search-1 abbrev))
(t helm-dabbrev-case-fold-search))
all-bufs)))
(lst (funcall dabbrev-get abbrev helm-dabbrev-always-search-all)))
(if (and (not helm-dabbrev-always-search-all)
(<= (length lst) helm-dabbrev-max-length-result))
;; Search all but don't recompute current-buffer.
(let ((helm-dabbrev--exclude-current-buffer-flag t))
(append lst (funcall dabbrev-get abbrev 'all-bufs)))
lst))))
(defun helm-dabbrev-default-action (candidate)
(with-helm-current-buffer
(let* ((limits (helm-bounds-of-thing-before-point
helm-dabbrev--regexp))
(beg (car limits))
(end (point)))
(run-with-timer
0.01 nil
'helm-insert-completion-at-point
beg end candidate))))
;;;###autoload
(defun helm-dabbrev ()
"Preconfigured helm for dynamic abbreviations."
(interactive)
(let ((dabbrev (helm-thing-before-point nil helm-dabbrev--regexp))
(limits (helm-bounds-of-thing-before-point helm-dabbrev--regexp))
(enable-recursive-minibuffers t)
(cycling-disabled-p (or (null helm-dabbrev-cycle-threshold)
(zerop helm-dabbrev-cycle-threshold)))
(helm-execute-action-at-once-if-one t)
(helm-quit-if-no-candidate
(lambda ()
(message "[Helm-dabbrev: No expansion found]"))))
(cl-assert (and (stringp dabbrev) (not (string= dabbrev "")))
nil "[Helm-dabbrev: Nothing found before point]")
(when (and
;; have been called at least once.
(helm-dabbrev-info-p helm-dabbrev--data)
;; But user have moved with some other command
;; in the meaning time.
(not (eq last-command 'helm-dabbrev)))
(setq helm-dabbrev--data nil))
(when cycling-disabled-p
(setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev)))
(unless (or cycling-disabled-p
(helm-dabbrev-info-p helm-dabbrev--data))
(setq helm-dabbrev--cache (helm-dabbrev--get-candidates dabbrev))
(setq helm-dabbrev--data
(make-helm-dabbrev-info
:dabbrev dabbrev
:limits limits
:iterator
(helm-iter-list
(cl-loop for i in helm-dabbrev--cache when
(and i (string-match
(concat "^" (regexp-quote dabbrev)) i))
collect i into selection
when (and selection
(= (length selection)
helm-dabbrev-cycle-threshold))
;; When selection len reach
;; `helm-dabbrev-cycle-threshold'
;; return selection.
return selection
;; selection len never reach
;; `helm-dabbrev-cycle-threshold'
;; return selection.
finally return selection)))))
(let ((iter (and (helm-dabbrev-info-p helm-dabbrev--data)
(helm-dabbrev-info-iterator helm-dabbrev--data)))
deactivate-mark)
;; Cycle until iterator is consumed.
(helm-aif (and iter (helm-iter-next iter))
(progn
(helm-insert-completion-at-point
(car (helm-dabbrev-info-limits helm-dabbrev--data))
(cdr limits) it)
;; Move already tried candidates to end of list.
(setq helm-dabbrev--cache (append (remove it helm-dabbrev--cache)
(list it))))
;; If the length of candidates is only one when computed
;; that's mean the unique matched item have already been
;; inserted by the iterator, so no need to reinsert the old dabbrev,
;; just let helm exiting with "No expansion found".
(let ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data)
(helm-dabbrev-info-dabbrev helm-dabbrev--data)
dabbrev)))
(unless (cdr (all-completions old-dabbrev helm-dabbrev--cache))
(setq cycling-disabled-p t))
;; Iterator is now empty, reset dabbrev to initial value
;; and start helm completion.
(unless cycling-disabled-p
(setq dabbrev old-dabbrev
limits (helm-dabbrev-info-limits helm-dabbrev--data))
(setq helm-dabbrev--data nil)
(delete-region (car limits) (point))
(insert dabbrev))
(with-helm-show-completion (car limits) (cdr limits)
(helm :sources (helm-build-in-buffer-source "Dabbrev Expand"
:data helm-dabbrev--cache
:persistent-action 'ignore
:persistent-help "DoNothing"
:keymap helm-dabbrev-map
:action 'helm-dabbrev-default-action)
:buffer "*helm dabbrev*"
:input (concat "^" dabbrev " ")
:resume 'noresume
:allow-nest t)))))))
(provide 'helm-dabbrev)
;; Local Variables:
;; byte-compile-warnings: (not cl-functions obsolete)
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
;;; helm-dabbrev.el ends here