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

Chizi123
2018-11-17 5cb5f70b1872a757e93ea333b0e2dca50c6c8957
commit | author | age
5cb5f7 1 ;;; helm-regexp.el --- In buffer regexp searching and replacement for helm. -*- 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 'cl-lib)
21 (require 'helm)
22 (require 'helm-help)
23 (require 'helm-utils)
24
25 (declare-function helm-mm-split-pattern "helm-multi-match")
26
27
28 (defgroup helm-regexp nil
29   "Regexp related Applications and libraries for Helm."
30   :group 'helm)
31
32 (defcustom helm-moccur-always-search-in-current nil
33   "Helm multi occur always search in current buffer when non--nil."
34   :group 'helm-regexp
35   :type 'boolean)
36
37 (defcustom helm-moccur-use-ioccur-style-keys t
38   "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur."
39   :group 'helm-regexp
40   :type 'boolean)
41
42 (defcustom helm-moccur-auto-update-on-resume nil
43   "Allow auto updating helm-(m)occur buffer when outdated.
44 noask => Always update without asking
45 nil   => Don't update but signal buffer needs update
46 never => Never update and do not signal buffer needs update
47 Any other non--nil value update after confirmation."
48   :group 'helm-regexp
49   :type '(radio :tag "Allow auto updating helm-(m)occur buffer when outdated."
50           (const :tag "Always update without asking" noask)
51           (const :tag "Never update and do not signal buffer needs update" never)
52           (const :tag "Don't update but signal buffer needs update" nil)
53           (const :tag "Update after confirmation" t)))
54
55 (defcustom helm-source-multi-occur-actions
56   '(("Go to Line" . helm-moccur-goto-line)
57     ("Goto line other window (C-u vertically)" . helm-moccur-goto-line-ow)
58     ("Goto line new frame" . helm-moccur-goto-line-of)
59     ("Save buffer" . helm-moccur-save-results))
60   "Actions for helm-occur and helm-moccur."
61   :group 'helm-regexp
62   :type '(alist :key-type string :value-type function))
63
64 (defcustom helm-moccur-truncate-lines t
65   "When nil the (m)occur line that appears will not be truncated."
66   :group 'helm-regexp
67   :type 'boolean)
68
69 (defcustom helm-moccur-show-buffer-fontification nil
70   "Show fontification of searched buffer in results when non nil.
71
72 This enable or disable fontification globally in results, but you can
73 override this default setting with `helm-moccur-buffer-substring-fn-for-modes'."
74   :group 'helm-regexp
75   :type '(radio :tag "Allow preserving fontification of searched buffer in results"
76                 (const :tag "Don't preserve buffer fontification" nil)
77                 (const :tag "Preserve buffer fontification" t)))
78
79 (defcustom helm-moccur-buffer-substring-fn-for-modes
80   '((mu4e-headers-mode . buffer-substring)
81     (package-menu-mode . buffer-substring-no-properties))
82   "Alist that allow configuring the function to use for storing a buffer.
83
84 Can be one of `buffer-substring' or `buffer-substring-no-properties'.
85 Allow overriding the global effect of `helm-moccur-show-buffer-fontification'
86 for a specific mode."
87   :group 'helm-regexp
88   :type '(alist :key-type (symbol :tag "Mode")
89                 :value-type (radio (const :tag "With text properties" buffer-substring)
90                                    (const :tag "Without text properties" buffer-substring-no-properties))))
91
92 (defcustom helm-occur-show-buffer-name nil
93   "Show buffer name in `helm-occur' results when non-nil.
94
95 Not that this doesn't affect `helm-moccur' results and
96 `helm-moccur-mode' buffers where buffer names are always shown."
97   :group 'helm-regexp
98   :type 'boolean)
99
100 (defface helm-moccur-buffer
101     '((t (:foreground "DarkTurquoise" :underline t)))
102   "Face used to highlight moccur buffer names."
103   :group 'helm-regexp)
104
105 (defface helm-resume-need-update
106     '((t (:background "red")))
107   "Face used to flash moccur buffer when it needs update."
108   :group 'helm-regexp)
109
110
111 (defvar helm-moccur-map
112   (let ((map (make-sparse-keymap)))
113     (set-keymap-parent map helm-map)
114     (define-key map (kbd "M-<down>") 'helm-goto-next-file)
115     (define-key map (kbd "M-<up>")   'helm-goto-precedent-file)
116     (define-key map (kbd "C-c o")    'helm-moccur-run-goto-line-ow)
117     (define-key map (kbd "C-c C-o")  'helm-moccur-run-goto-line-of)
118     (define-key map (kbd "C-x C-s")  'helm-moccur-run-save-buffer)
119     (when helm-moccur-use-ioccur-style-keys
120       (define-key map (kbd "<right>")  'helm-execute-persistent-action)
121       (define-key map (kbd "<left>")   'helm-moccur-run-default-action))
122     (delq nil map))
123   "Keymap used in Moccur source.")
124
125
126 ;; History vars
127 (defvar helm-build-regexp-history nil)
128 (defvar helm-occur-history nil)
129
130 (defun helm-query-replace-regexp (_candidate)
131   "Query replace regexp from `helm-regexp'.
132 With a prefix arg replace only matches surrounded by word boundaries,
133 i.e Don't replace inside a word, regexp is surrounded with \\bregexp\\b."
134   (let ((regexp helm-input))
135     (apply 'query-replace-regexp
136            (helm-query-replace-args regexp))))
137
138 (defun helm-kill-regexp-as-sexp (_candidate)
139   "Kill regexp in a format usable in lisp code."
140   (helm-regexp-kill-new
141    (prin1-to-string helm-input)))
142
143 (defun helm-kill-regexp (_candidate)
144   "Kill regexp as it is in `helm-pattern'."
145   (helm-regexp-kill-new helm-input))
146
147 (defun helm-query-replace-args (regexp)
148   "create arguments of `query-replace-regexp' action in `helm-regexp'."
149   (let ((region-only (helm-region-active-p)))
150     (list
151      regexp
152      (query-replace-read-to regexp
153                             (format "Query replace %sregexp %s"
154                                     (if helm-current-prefix-arg "word " "")
155                                     (if region-only "in region " ""))
156                             t)
157      helm-current-prefix-arg
158      (when region-only (region-beginning))
159      (when region-only (region-end)))))
160
161 (defvar helm-source-regexp
162   (helm-build-in-buffer-source "Regexp Builder"
163     :init (lambda ()
164             (helm-init-candidates-in-buffer
165                 'global (with-temp-buffer
166                           (insert-buffer-substring helm-current-buffer)
167                           (buffer-string))))
168     :get-line #'helm-regexp-get-line
169     :persistent-action #'helm-regexp-persistent-action
170     :persistent-help "Show this line"
171     :multiline t
172     :multimatch nil
173     :requires-pattern 2
174     :group 'helm-regexp
175     :mode-line "Press TAB to select action."
176     :action '(("Kill Regexp as sexp" . helm-kill-regexp-as-sexp)
177               ("Query Replace Regexp (C-u Not inside word.)"
178                . helm-query-replace-regexp)
179               ("Kill Regexp" . helm-kill-regexp))))
180
181 (defun helm-regexp-get-line (s e)
182   (let ((matches (match-data))
183         (line    (buffer-substring s e)))
184     (propertize
185      (cl-loop with ln = (format "%5d: %s" (1- (line-number-at-pos s)) line)
186            for i from 0 to (1- (/ (length matches) 2))
187            if (match-string i)
188            concat (format "\n%s%s'%s'"
189                           (make-string 10 ? ) (format "Group %d: " i) it)
190            into ln1
191            finally return (concat ln ln1))
192      'helm-realvalue s)))
193
194 (defun helm-regexp-persistent-action (pt)
195   (helm-goto-char pt)
196   (helm-highlight-current-line))
197
198 (defun helm-regexp-kill-new (input)
199   (kill-new (substring-no-properties input))
200   (message "Killed: %s" input))
201
202
203 ;;; Occur
204 ;;
205 ;;
206 (defvar helm-source-occur nil)
207 (defun helm-occur-init-source ()
208   (unless helm-source-occur
209     (setq helm-source-occur
210           (helm-make-source "Occur" 'helm-source-multi-occur))))
211
212
213 ;;; Multi occur
214 ;;
215 ;;
216
217 ;; Internal
218 (defvar helm-multi-occur-buffer-list nil)
219 (defvar helm-multi-occur-buffer-tick nil)
220 (defvar helm-occur--invisible nil
221   "[INTERNAL] Hide buffer name in results when non-nil.
222 Should be a local var to helm-buffer to allow resuming.")
223
224 (defun helm-moccur-init ()
225   "Create the initial helm multi occur buffer."
226   (helm-init-candidates-in-buffer
227       'global
228     (cl-loop with buffers = (helm-attr 'moccur-buffers)
229              with bsubstring = (if helm-moccur-show-buffer-fontification
230                                    #'buffer-substring #'buffer-substring-no-properties)
231              for buf in buffers
232              for bufstr = (with-current-buffer buf
233                             (helm-aif (assq major-mode
234                                             helm-moccur-buffer-substring-fn-for-modes)
235                                 (setq bsubstring (cdr it)))
236                             ;; A leading space is needed to allow helm
237                             ;; searching the first line of buffer
238                             ;; (#1725).
239                             (concat (if (memql (char-after (point-min))
240                                                '(? ?\t ?\n))
241                                         "" " ")
242                                     (funcall bsubstring (point-min) (point-max))))
243              do (add-text-properties
244                  0 (length bufstr)
245                  `(buffer-name ,(buffer-name (get-buffer buf)))
246                  bufstr)
247              concat bufstr)))
248
249 (defun helm-moccur--next-or-previous-char ()
250   (save-excursion
251     (or (re-search-forward "^." nil t)
252         (re-search-backward "^." nil t))))
253
254 (defun helm-moccur-get-line (beg end)
255   "Format line for `helm-source-moccur'."
256   (prog1
257       (format "%s:%d:%s"
258               (get-text-property (if (= beg end)
259                                      (helm-moccur--next-or-previous-char)
260                                      beg)
261                                  'buffer-name)
262               (save-restriction
263                 (narrow-to-region (or (previous-single-property-change
264                                        (point) 'buffer-name)
265                                       (point-at-bol 2))
266                                   (or (next-single-property-change
267                                        (if (= beg end)
268                                            (helm-moccur--next-or-previous-char)
269                                            (point))
270                                        'buffer-name)
271                                       (point-max)))
272                 (line-number-at-pos beg))
273               ;; When matching empty line, use empty string
274               ;; to allow saving and modifying with wgrep.
275               (if (= beg end) "" (buffer-substring beg end)))
276     ;; When matching empty line, forward char ("\n")
277     ;; to not be blocked forever here.
278     (when (= beg end) (forward-char 1))))
279
280 (cl-defun helm-moccur-action (candidate
281                               &optional (method (quote buffer)))
282   "Jump to CANDIDATE with METHOD.
283 arg METHOD can be one of buffer, buffer-other-window, buffer-other-frame."
284   (require 'helm-grep)
285   (let* ((split (helm-grep-split-line candidate))
286          (buf (car split))
287          (lineno (string-to-number (nth 1 split)))
288          (split-pat (helm-mm-split-pattern helm-input)))
289     (cl-case method
290       (buffer              (switch-to-buffer buf))
291       (buffer-other-window (helm-window-show-buffers (list buf) t))
292       (buffer-other-frame  (switch-to-buffer-other-frame buf)))
293     (with-current-buffer buf
294       (helm-goto-line lineno)
295       ;; Move point to the nearest matching regexp from bol.
296       (cl-loop for reg in split-pat
297                when (save-excursion
298                       (condition-case _err
299                           (if helm-migemo-mode
300                               (helm-mm-migemo-forward reg (point-at-eol) t)
301                               (re-search-forward reg (point-at-eol) t))
302                         (invalid-regexp nil)))
303                collect (match-beginning 0) into pos-ls
304                finally (when pos-ls (goto-char (apply #'min pos-ls)))))))
305
306 (defun helm-moccur-persistent-action (candidate)
307   (helm-moccur-goto-line candidate)
308   (helm-highlight-current-line))
309
310 (defun helm-moccur-goto-line (candidate)
311   "From multi occur, switch to buffer and go to nth 1 CANDIDATE line."
312   (helm-moccur-action
313    candidate 'buffer))
314
315 (defun helm-moccur-goto-line-ow (candidate)
316   "Go to CANDIDATE line in other window.
317 Same as `helm-moccur-goto-line' but go in other window."
318   (helm-moccur-action
319    candidate 'buffer-other-window))
320
321 (defun helm-moccur-goto-line-of (candidate)
322   "Go to CANDIDATE line in new frame.
323 Same as `helm-moccur-goto-line' but go in new frame."
324   (helm-moccur-action
325    candidate 'buffer-other-frame))
326
327 (defun helm-moccur-run-goto-line-ow ()
328   "Run goto line other window action from `helm-source-moccur'."
329   (interactive)
330   (with-helm-alive-p
331     (helm-exit-and-execute-action 'helm-moccur-goto-line-ow)))
332 (put 'helm-moccur-run-goto-line-ow 'helm-only t)
333
334 (defun helm-moccur-run-goto-line-of ()
335   "Run goto line new frame action from `helm-source-moccur'."
336   (interactive)
337   (with-helm-alive-p
338     (helm-exit-and-execute-action 'helm-moccur-goto-line-of)))
339 (put 'helm-moccur-run-goto-line-of 'helm-only t)
340
341 (defun helm-moccur-run-default-action ()
342   (interactive)
343   (with-helm-alive-p
344     (helm-exit-and-execute-action 'helm-moccur-goto-line)))
345 (put 'helm-moccur-run-default-action 'helm-only t)
346
347 (defvar helm-moccur-before-init-hook nil
348   "Hook that runs before initialization of the helm buffer.")
349
350 (defvar helm-moccur-after-init-hook nil
351   "Hook that runs after initialization of the helm buffer.")
352
353 (defvar helm-source-moccur nil)
354 (defclass helm-source-multi-occur (helm-source-in-buffer)
355   ((init :initform (lambda ()
356                      (require 'helm-grep)
357                      (helm-moccur-init)))
358    (filter-one-by-one :initform 'helm-moccur-filter-one-by-one)
359    (get-line :initform helm-moccur-get-line)
360    (nohighlight :initform t)
361    (nomark :initform t)
362    (migemo :initform t)
363    (action :initform 'helm-source-multi-occur-actions)
364    (persistent-action :initform 'helm-moccur-persistent-action)
365    (persistent-help :initform "Go to line")
366    (resume :initform 'helm-moccur-resume-fn)
367    (candidate-number-limit :initform 9999)
368    (help-message :initform 'helm-moccur-help-message)
369    (keymap :initform helm-moccur-map)
370    (history :initform 'helm-occur-history)
371    (requires-pattern :initform 2)
372    (before-init-hook :initform 'helm-moccur-before-init-hook)
373    (after-init-hook :initform 'helm-moccur-after-init-hook)
374    (group :initform 'helm-regexp)))
375
376 (defun helm-moccur-resume-fn ()
377   (with-helm-buffer
378     (let (new-tick-ls buffer-is-modified)
379       (set (make-local-variable 'helm-multi-occur-buffer-list)
380            (cl-loop for b in helm-multi-occur-buffer-list
381                     when (buffer-live-p (get-buffer b))
382                     collect b))
383       (setq buffer-is-modified (/= (length helm-multi-occur-buffer-list)
384                                    (length (helm-attr 'moccur-buffers))))
385       (helm-attrset 'moccur-buffers helm-multi-occur-buffer-list)
386       (setq new-tick-ls (cl-loop for b in helm-multi-occur-buffer-list
387                                  collect (buffer-chars-modified-tick (get-buffer b))))
388       (when buffer-is-modified
389         (setq helm-multi-occur-buffer-tick new-tick-ls))
390       (cl-assert (> (length helm-multi-occur-buffer-list) 0) nil
391                  "helm-resume error: helm-(m)occur buffer list is empty")
392       (unless (eq helm-moccur-auto-update-on-resume 'never)
393         (when (or buffer-is-modified
394                   (cl-loop for b in helm-multi-occur-buffer-list
395                            for new-tick = (buffer-chars-modified-tick (get-buffer b))
396                            for tick in helm-multi-occur-buffer-tick
397                            thereis (/= tick new-tick)))
398           (helm-aif helm-moccur-auto-update-on-resume
399               (when (or (eq it 'noask)
400                         (y-or-n-p "Helm (m)occur Buffer outdated, update? "))
401                 (run-with-idle-timer 0.1 nil (lambda ()
402                                                (with-helm-buffer
403                                                  (helm-force-update)
404                                                  (message "Helm (m)occur Buffer have been udated")
405                                                  (sit-for 1) (message nil))))
406                 (unless buffer-is-modified (setq helm-multi-occur-buffer-tick new-tick-ls)))
407             (run-with-idle-timer 0.1 nil (lambda ()
408                                            (with-helm-buffer
409                                              (let ((ov (make-overlay (save-excursion
410                                                                        (goto-char (point-min))
411                                                                        (forward-line 1)
412                                                                        (point))
413                                                                      (point-max))))
414                                                (overlay-put ov 'face 'helm-resume-need-update)
415                                                (sit-for 0.3) (delete-overlay ov)
416                                                (message "[Helm occur Buffer outdated (C-c C-u to update)]")))))
417             (unless buffer-is-modified
418               (with-helm-after-update-hook
419                 (setq helm-multi-occur-buffer-tick new-tick-ls)
420                 (message "Helm (m)occur Buffer have been udated")))))))))
421
422 (defun helm-moccur-filter-one-by-one (candidate &optional outside-helm)
423   "`filter-one-by-one' function for `helm-source-moccur'."
424   (require 'helm-grep)
425   (let* ((split  (helm-grep-split-line candidate))
426          (buf    (car split))
427          (lineno (nth 1 split))
428          (str    (nth 2 split)))
429     (cons (concat (propertize
430                    buf
431                    'invisible (and (null outside-helm)
432                                    (with-helm-buffer
433                                      helm-occur--invisible))
434                    'face 'helm-moccur-buffer
435                    'help-echo (buffer-file-name
436                                (get-buffer buf))
437                    'buffer-name buf)
438                   (propertize ":" 'invisible (and (null outside-helm)
439                                                   (with-helm-buffer
440                                                     helm-occur--invisible)))
441                   (propertize lineno 'face 'helm-grep-lineno)
442                   ":"
443                   (helm-grep-highlight-match str t))
444           candidate)))
445
446 (defun helm-multi-occur-1 (buffers &optional input)
447   "Main function to call `helm-source-moccur' with BUFFERS list."
448   (let ((bufs (if helm-moccur-always-search-in-current
449                   (cons
450                    ;; will become helm-current-buffer later.
451                    (buffer-name (current-buffer))
452                    (remove helm-current-buffer buffers))
453                   buffers)))
454     (unless helm-source-moccur
455       (setq helm-source-moccur
456             (helm-make-source "Moccur" 'helm-source-multi-occur)))
457     (helm-attrset 'moccur-buffers bufs helm-source-moccur)
458     (helm-set-local-variable 'helm-multi-occur-buffer-list bufs)
459     (helm-set-local-variable
460      'helm-multi-occur-buffer-tick
461      (cl-loop for b in bufs
462               collect (buffer-chars-modified-tick (get-buffer b)))))
463   (helm :sources 'helm-source-moccur
464         :buffer "*helm multi occur*"
465         :default (helm-aif (thing-at-point 'symbol) (regexp-quote it))
466         :history 'helm-occur-history
467         :keymap helm-moccur-map
468         :input input
469         :truncate-lines helm-moccur-truncate-lines))
470
471 (defun helm-moccur-run-save-buffer ()
472   "Run moccur save results action from `helm-moccur'."
473   (interactive)
474   (with-helm-alive-p
475     (helm-exit-and-execute-action 'helm-moccur-save-results)))
476 (put 'helm-moccur-run-save-buffer 'helm-only t)
477
478
479 ;;; helm-moccur-mode
480 ;;
481 ;;
482 (defvar helm-moccur-mode-map
483   (let ((map (make-sparse-keymap)))
484     (define-key map (kbd "RET")      'helm-moccur-mode-goto-line)
485     (define-key map (kbd "C-o")      'helm-moccur-mode-goto-line-ow)
486     (define-key map (kbd "<C-down>") 'helm-moccur-mode-goto-line-ow-forward)
487     (define-key map (kbd "<C-up>")   'helm-moccur-mode-goto-line-ow-backward)
488     (define-key map (kbd "<M-down>") 'helm-gm-next-file)
489     (define-key map (kbd "<M-up>")   'helm-gm-precedent-file)
490     (define-key map (kbd "M-n")      'helm-moccur-mode-goto-line-ow-forward)
491     (define-key map (kbd "M-p")      'helm-moccur-mode-goto-line-ow-backward)
492     (define-key map (kbd "M-N")      'helm-gm-next-file)
493     (define-key map (kbd "M-P")      'helm-gm-precedent-file)
494     map))
495
496 (defun helm-moccur-mode-goto-line ()
497   (interactive)
498   (helm-aif (get-text-property (point) 'helm-realvalue)
499     (progn (helm-moccur-goto-line it) (helm-match-line-cleanup-pulse))))
500
501 (defun helm-moccur-mode-goto-line-ow ()
502   (interactive)
503   (helm-aif (get-text-property (point) 'helm-realvalue)
504     (progn (helm-moccur-goto-line-ow it) (helm-match-line-cleanup-pulse))))
505
506 (defun helm-moccur-mode-goto-line-ow-forward-1 (arg)
507   (condition-case nil
508       (progn
509         (save-selected-window
510           (helm-moccur-mode-goto-line-ow)
511           (recenter))
512         (forward-line arg))
513     (error nil)))
514
515 (defun helm-moccur-mode-goto-line-ow-forward ()
516   (interactive)
517   (helm-moccur-mode-goto-line-ow-forward-1 1))
518
519 (defun helm-moccur-mode-goto-line-ow-backward ()
520   (interactive)
521   (helm-moccur-mode-goto-line-ow-forward-1 -1))
522
523 (defun helm-moccur-save-results (_candidate)
524   "Save helm moccur results in a `helm-moccur-mode' buffer."
525   (let ((buf "*hmoccur*")
526         new-buf)
527     (when (get-buffer buf)
528       (setq new-buf (helm-read-string "OccurBufferName: " buf))
529       (cl-loop for b in (helm-buffer-list)
530             when (and (string= new-buf b)
531                       (not (y-or-n-p
532                             (format "Buffer `%s' already exists overwrite? "
533                                     new-buf))))
534             do (setq new-buf (helm-read-string "OccurBufferName: " "*hmoccur ")))
535       (setq buf new-buf))
536     (with-current-buffer (get-buffer-create buf)
537       (setq buffer-read-only t)
538       (let ((inhibit-read-only t)
539             (map (make-sparse-keymap)))
540         (erase-buffer)
541         (insert "-*- mode: helm-moccur -*-\n\n"
542                 (format "Moccur Results for `%s':\n\n" helm-input))
543         (save-excursion
544           (insert (with-current-buffer helm-buffer
545                     (goto-char (point-min)) (forward-line 1)
546                     (buffer-substring (point) (point-max)))))
547         (save-excursion
548           (while (not (eobp))
549             (add-text-properties
550              (point-at-bol) (point-at-eol)
551              `(keymap ,map
552                help-echo ,(concat
553                            (buffer-file-name
554                             (get-buffer (get-text-property
555                                          (point) 'buffer-name)))
556                            "\nmouse-1: set point\nmouse-2: jump to selection")
557                mouse-face highlight
558                invisible nil))
559             (define-key map [mouse-1] 'mouse-set-point)
560             (define-key map [mouse-2] 'helm-moccur-mode-mouse-goto-line)
561             (define-key map [mouse-3] 'ignore)
562             (forward-line 1))))
563       (helm-moccur-mode))
564     (pop-to-buffer buf)
565     (message "Helm Moccur Results saved in `%s' buffer" buf)))
566
567 (defun helm-moccur-mode-mouse-goto-line (event)
568   (interactive "e")
569   (let* ((window (posn-window (event-end event)))
570          (pos    (posn-point (event-end event))))
571     (with-selected-window window
572       (when (eq major-mode 'helm-moccur-mode)
573         (goto-char pos)
574         (helm-moccur-mode-goto-line)))))
575 (put 'helm-moccur-mode-mouse-goto-line 'helm-only t)
576
577 ;;;###autoload
578 (define-derived-mode helm-moccur-mode
579     special-mode "helm-moccur"
580     "Major mode to provide actions in helm moccur saved buffer.
581
582 Special commands:
583 \\{helm-moccur-mode-map}"
584     (set (make-local-variable 'helm-multi-occur-buffer-list)
585          (with-helm-buffer helm-multi-occur-buffer-list))
586     (set (make-local-variable 'revert-buffer-function)
587          #'helm-moccur-mode--revert-buffer-function))
588 (put 'helm-moccur-mode 'helm-only t)
589
590 (defun helm-moccur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm)
591   (goto-char (point-min))
592   (let (pattern)
593     (when (re-search-forward "^Moccur Results for `\\(.*\\)'" nil t)
594       (setq pattern (match-string 1))
595       (forward-line 0)
596       (when (re-search-forward "^$" nil t)
597         (forward-line 1))
598       (let ((inhibit-read-only t)
599             (buffer (current-buffer))
600             (buflst helm-multi-occur-buffer-list)
601             (bsubstring (if helm-moccur-show-buffer-fontification
602                             #'buffer-substring #'buffer-substring-no-properties)))
603         (delete-region (point) (point-max))
604         (message "Reverting buffer...")
605         (save-excursion
606           (with-temp-buffer
607             (insert
608              "\n"
609              (cl-loop for buf in buflst
610                       for bufstr = (or (and (buffer-live-p (get-buffer buf))
611                                             (with-current-buffer buf
612                                               (funcall bsubstring
613                                                (point-min) (point-max))))
614                                        "")
615                       unless (string= bufstr "")
616                       do (add-text-properties
617                           0 (length bufstr)
618                           `(buffer-name ,(buffer-name (get-buffer buf)))
619                           bufstr)
620                       concat bufstr)
621              "\n")
622             (goto-char (point-min))
623             (cl-loop with helm-pattern = pattern
624                      while (helm-mm-search pattern)
625                      for line = (helm-moccur-get-line (point-at-bol) (point-at-eol))
626                      when line
627                      do (with-current-buffer buffer
628                           (insert
629                             (propertize
630                              (car (helm-moccur-filter-one-by-one line t))
631                              'helm-realvalue line)
632                            "\n")))))
633         (message "Reverting buffer done")))))
634
635
636 ;;; Predefined commands
637 ;;
638 ;;
639
640 ;;;###autoload
641 (defun helm-regexp ()
642   "Preconfigured helm to build regexps.
643 `query-replace-regexp' can be run from there against found regexp."
644   (interactive)
645   (save-restriction
646     (when (and (helm-region-active-p)
647                ;; Don't narrow to region if buffer is already narrowed.
648                (not (helm-current-buffer-narrowed-p (current-buffer))))
649       (narrow-to-region (region-beginning) (region-end)))
650     (helm :sources helm-source-regexp
651           :buffer "*helm regexp*"
652           :prompt "Regexp: "
653           :history 'helm-build-regexp-history)))
654
655 ;;;###autoload
656 (defun helm-occur ()
657   "Preconfigured helm for searching lines matching pattern in `current-buffer'.
658
659 When `helm-source-occur' is member of
660 `helm-sources-using-default-as-input' which is the default,
661 symbol at point is searched at startup.
662
663 When a region is marked search only in this region by narrowing.
664
665 To search in multiples buffers start from one of the commands listing
666 buffers (i.e. a helm command using `helm-source-buffers-list' like
667 `helm-mini') and use the multi occur buffers action.
668
669 This is the helm implementation that collect lines matching pattern
670 like vanilla emacs `occur' but have nothing to do with it, the search
671 engine beeing completely different."
672   (interactive)
673   (helm-occur-init-source)
674   (let ((bufs (list (buffer-name (current-buffer)))))
675     (helm-attrset 'moccur-buffers bufs helm-source-occur)
676     (helm-set-local-variable 'helm-multi-occur-buffer-list bufs)
677     (helm-set-local-variable
678      'helm-multi-occur-buffer-tick
679      (cl-loop for b in bufs
680               collect (buffer-chars-modified-tick (get-buffer b)))))
681   (helm-set-local-variable 'helm-occur--invisible
682                            (null helm-occur-show-buffer-name))
683   (save-restriction
684     (let (def pos)
685       (when (use-region-p)
686         ;; When user mark defun with `mark-defun' with intention of
687         ;; using helm-occur on this region, it is relevant to use the
688         ;; thing-at-point located at previous position which have been
689         ;; pushed to `mark-ring'.
690         (setq def (save-excursion
691                     (goto-char (setq pos (car mark-ring)))
692                     (helm-aif (thing-at-point 'symbol) (regexp-quote it))))
693         (narrow-to-region (region-beginning) (region-end)))
694       (unwind-protect
695            (helm :sources 'helm-source-occur
696                  :buffer "*helm occur*"
697                  :default (or def (helm-aif (thing-at-point 'symbol) (regexp-quote it)))
698                  :history 'helm-occur-history
699                  :preselect (and (memq 'helm-source-occur helm-sources-using-default-as-input)
700                                  (format "%s:%d:" (regexp-quote (buffer-name))
701                                          (line-number-at-pos (or pos (point)))))
702                  :truncate-lines helm-moccur-truncate-lines)
703         (deactivate-mark t)))))
704
705 ;;;###autoload
706 (defun helm-occur-from-isearch ()
707   "Invoke `helm-occur' from isearch."
708   (interactive)
709   (let ((input (if isearch-regexp
710                    isearch-string
711                  (regexp-quote isearch-string)))
712         (bufs (list (buffer-name (current-buffer)))))
713     (isearch-exit)
714     (helm-occur-init-source)
715     (helm-attrset 'moccur-buffers bufs helm-source-occur)
716     (helm-set-local-variable 'helm-multi-occur-buffer-list bufs)
717     (helm-set-local-variable
718      'helm-multi-occur-buffer-tick
719      (cl-loop for b in bufs
720               collect (buffer-chars-modified-tick (get-buffer b))))
721     (helm-set-local-variable 'helm-occur--invisible
722                              (null helm-occur-show-buffer-name))
723     (helm :sources 'helm-source-occur
724           :buffer "*helm occur*"
725           :history 'helm-occur-history
726           :input input
727           :truncate-lines helm-moccur-truncate-lines)))
728
729 ;;;###autoload
730 (defun helm-multi-occur-from-isearch (&optional _arg)
731   "Invoke `helm-multi-occur' from isearch.
732
733 With a prefix arg, reverse the behavior of
734 `helm-moccur-always-search-in-current'.
735 The prefix arg can be set before calling
736 `helm-multi-occur-from-isearch' or during the buffer selection."
737   (interactive "p")
738   (let (buf-list
739         helm-moccur-always-search-in-current
740         (input (if isearch-regexp
741                    isearch-string
742                  (regexp-quote isearch-string))))
743     (isearch-exit)
744     (setq buf-list (helm-comp-read "Buffers: "
745                                    (helm-buffer-list)
746                                    :name "Occur in buffer(s)"
747                                    :marked-candidates t))
748     (setq helm-moccur-always-search-in-current
749           (if (or current-prefix-arg
750                   helm-current-prefix-arg)
751               (not helm-moccur-always-search-in-current)
752             helm-moccur-always-search-in-current))
753     (helm-multi-occur-1 buf-list input)))
754
755
756 (provide 'helm-regexp)
757
758 ;; Local Variables:
759 ;; byte-compile-warnings: (not obsolete)
760 ;; coding: utf-8
761 ;; indent-tabs-mode: nil
762 ;; End:
763
764 ;;; helm-regexp.el ends here