mirror of https://github.com/Chizi123/.emacs.d.git

Chizi123
2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957
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
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
;;; helm-dabbrev.el --- Helm implementation of dabbrev. -*- lexical-binding: t -*-
 
;; Copyright (C) 2012 ~ 2018 Thierry Volpiatto <thierry.volpiatto@gmail.com>
 
;; 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-lib)
(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-candidates-number-limit 1000
  "Maximum number of candidates to collect.
 
Higher this number is, slower the computation of candidates will be.
You can use safely a higher value with emacs-26+.
Note that this have nothing to do with `helm-candidate-number-limit'."
  :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 nil 
  "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 5
  "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)))
 
(defcustom helm-dabbrev-use-thread nil
  "[EXPERIMENTAL] Compute candidates asynchronously (partially) when non nil.
 
The idea is to compute candidates while cycling the first ones, so
this is available only if `helm-dabbrev-cycle-threshold' is not 0 or
nil, also it is available only on emacs-26+ (needs threads).
 
This is reasonably working when you don't have to complete a huge list
of candidates, otherwise you will have a small delay after the first cycle
because thread is released unexpectedly when helm-dabbrev exit after
first insertion.
 
IOW keep `helm-dabbrev-candidates-number-limit' to a reasonable
value (I don't!) and give enough prefix before completing e.g. for
completing \"helm-dabbrev\" use \"helm-d\" and not \"he\" if you want
to use this."
  :group 'helm-dabbrev
  :type 'boolean)
 
(defvaralias 'helm-dabbrev--regexp 'helm-dabbrev-separator-regexp)
(make-obsolete-variable 'helm-dabbrev--regexp
                        'helm-dabbrev-separator-regexp "2.8.3")
;; Check for beginning of line should happen last (^\n\\|^). 
(defvar helm-dabbrev-separator-regexp
  "\\s-\\|\t\\|[(\\[\\{\"'`=<$;,@.#+]\\|\\s\\\\|^\n\\|^"
  "Regexp matching the start of a dabbrev candidate.")
 
 
(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--cache nil)
(defvar helm-dabbrev--data nil)
(cl-defstruct helm-dabbrev-info dabbrev limits iterator)
(defvar helm-dabbrev--already-tried nil)
(defvar helm-dabbrev--current-thread nil)
 
 
(defun helm-dabbrev--buffer-list ()
  (cl-loop for buf in (buffer-list)
           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)
  "Decide if current-buffer is related to START-BUFFER."
  (helm-same-major-mode-p start-buffer helm-dabbrev-major-mode-assoc))
 
(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 (and (<= (length result) limit)
                        (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* ((pbeg (match-beginning 0))
                     (replace-regexp (concat "\\(" helm-dabbrev-separator-regexp
                                             "\\)\\'"))
                     (match-word (helm-dabbrev--search
                                  pattern pbeg replace-regexp)))
                (when (and match-word (not (member match-word result)))
                  (push match-word result)))))))
    (catch 'break
      (dolist (buf (if all (helm-dabbrev--buffer-list)
                     (list (current-buffer))))
        (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.
              ;; If limit is reached in previous call of
              ;; search-and-store pos-before is never set and
              ;; goto-char will fail, so check it.
              (when pos-before
                (goto-char pos-before)  ; start from [1]
                (funcall search-and-store str -1)))
            (save-excursion
              ;; Search all after point.
              ;; Same comment as above for pos-after.
              (when pos-after
                (goto-char pos-after)   ; start from [2]
                (funcall search-and-store str 1)))))
        (when (>= (length result) limit) (throw 'break nil))))
    (nreverse result)))
 
(defun helm-dabbrev--search (pattern beg sep-regexp)
  "Search word or symbol at point matching PATTERN.
Argument BEG is corresponding to the previous match-beginning search.
The search starts at (1- BEG) with a regexp starting with
`helm-dabbrev-separator-regexp' followed by PATTERN followed by a
regexp matching syntactically any word or symbol.
The possible false positives matching SEP-REGEXP at end are finally
removed."
  (let ((eol (point-at-eol))) 
    (save-excursion
      (goto-char (1- beg))
      (when (re-search-forward
             (concat "\\("
                     helm-dabbrev-separator-regexp
                     "\\)"
                     "\\(?99:\\("
                     (regexp-quote pattern)
                     "\\(\\sw\\|\\s_\\)+\\)\\)")
             eol t)
        (replace-regexp-in-string
         sep-regexp ""
         (match-string-no-properties 99))))))
 
(defun helm-dabbrev--get-candidates (dabbrev &optional limit)
  (cl-assert dabbrev nil "[No Match]")
  (helm-dabbrev--collect
   dabbrev (or limit helm-dabbrev-candidates-number-limit)
   (cl-case helm-dabbrev-case-fold-search
     (smart (helm-set-case-fold-search-1 dabbrev))
     (t helm-dabbrev-case-fold-search))
   helm-dabbrev-always-search-all))
 
(defun helm-dabbrev-default-action (candidate)
  (with-helm-current-buffer
    (let* ((limits (helm-bounds-of-thing-before-point
                    helm-dabbrev-separator-regexp))
           (beg (car limits))
           (end (point)))
      (run-with-timer
       0.01 nil
       'helm-insert-completion-at-point
       beg end candidate))))
 
;;;###autoload
(cl-defun helm-dabbrev ()
  "Preconfigured helm for dynamic abbreviations."
  (interactive)
  (let ((dabbrev (helm-thing-before-point
                  nil helm-dabbrev-separator-regexp))
        (limits (helm-bounds-of-thing-before-point
                 helm-dabbrev-separator-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 candidates are requested in helm directly without cycling,
    ;; we need them right now before running helm, so no need to use a
    ;; thread here.
    (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--data
            (make-helm-dabbrev-info
             :dabbrev dabbrev
             :limits limits
             :iterator
             (helm-iter-list
              (cl-loop for i in (helm-dabbrev--get-candidates
                                 dabbrev helm-dabbrev-cycle-threshold)
                       when (string-match-p
                             (concat "^" (regexp-quote dabbrev)) i)
                       collect i))))
      ;; Thread is released as soon as helm-dabbrev exits after first
      ;; insertion so this is unusable for now, keep it like this for
      ;; now hooping the situation with threads will be improved in
      ;; emacs. The idea is to compute whole list of candidates in
      ;; background while cycling with the first
      ;; helm-dabbrev-cycle-threshold ones.
      (when (and (fboundp 'make-thread) helm-dabbrev-use-thread)
        (setq helm-dabbrev--current-thread
              (make-thread
               (lambda ()
                 (setq helm-dabbrev--cache
                       (helm-dabbrev--get-candidates dabbrev)))))))
    (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))
             ;; END is the end of the previous inserted string, not
             ;; the end (apart for first insertion) of the initial string.
             (cdr limits) it)
            ;; Move already tried candidates to end of list.
            (push it helm-dabbrev--already-tried))
        ;; Iterator is now empty, reset dabbrev to initial value
        ;; and start helm completion.
        (let* ((old-dabbrev (if (helm-dabbrev-info-p helm-dabbrev--data)
                                (helm-dabbrev-info-dabbrev helm-dabbrev--data)
                              dabbrev))
               (only-one (null (cdr (all-completions
                                     old-dabbrev
                                     helm-dabbrev--already-tried)))))
          (unless helm-dabbrev-use-thread
            (message "Waiting for helm-dabbrev candidates...")
            (setq helm-dabbrev--cache
                  (helm-dabbrev--get-candidates old-dabbrev)))
          ;; 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".
          (unless (or only-one 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))
          ;; Cycling is finished, block until helm-dabbrev--cache have
          ;; finished to complete.
          (when (and (fboundp 'thread-join)
                     helm-dabbrev-use-thread
                     (thread-alive-p helm-dabbrev--current-thread))
            (thread-join helm-dabbrev--current-thread))
          (when (and (null cycling-disabled-p) only-one)
            (cl-return-from helm-dabbrev 
              (message "[Helm-dabbrev: No expansion found]")))
          (with-helm-show-completion (car limits) (cdr limits)
            (unwind-protect
                 (helm :sources
                       (helm-build-in-buffer-source "Dabbrev Expand"
                         :data
                         (cl-loop for cand in helm-dabbrev--cache
                                  unless
                                  (member cand helm-dabbrev--already-tried)
                                  collect cand into lst
                                  finally return
                                  (append lst helm-dabbrev--already-tried))
                         :persistent-action 'ignore
                         :persistent-help "DoNothing"
                         :keymap helm-dabbrev-map
                         :action 'helm-dabbrev-default-action
                         :group 'helm-dabbrev)
                       :buffer "*helm dabbrev*"
                       :input (concat "^" dabbrev " ")
                       :resume 'noresume
                       :allow-nest t)
              (setq helm-dabbrev--already-tried nil))))))))
 
(provide 'helm-dabbrev)
 
;; Local Variables:
;; byte-compile-warnings: (not obsolete)
;; coding: utf-8
;; indent-tabs-mode: nil
;; End:
 
;;; helm-dabbrev.el ends here