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.

701 line
29 KiB

4 年之前
  1. ;;; helm-occur.el --- Incremental Occur for Helm. -*- 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 'cl-lib)
  15. (require 'helm)
  16. (require 'helm-help)
  17. (require 'helm-utils)
  18. ;;; Internals
  19. ;;
  20. (defvar helm-source-occur nil)
  21. (defvar helm-source-moccur nil
  22. "This is just a flag to add to `helm-sources-using-default-as-input'.
  23. Don't set it to any value, it will have no effect.")
  24. (defvar helm-occur--buffer-list nil)
  25. (defvar helm-occur--buffer-tick nil)
  26. (defvar helm-occur-history nil)
  27. (defvar helm-occur--search-buffer-regexp "\\`\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)\\'"
  28. "The regexp matching candidates in helm-occur candidate buffer.")
  29. (defvar helm-occur-mode--last-pattern nil)
  30. (defvar helm-occur-map
  31. (let ((map (make-sparse-keymap)))
  32. (set-keymap-parent map helm-map)
  33. (define-key map (kbd "C-c o") 'helm-occur-run-goto-line-ow)
  34. (define-key map (kbd "C-c C-o") 'helm-occur-run-goto-line-of)
  35. (define-key map (kbd "C-x C-s") 'helm-occur-run-save-buffer)
  36. map)
  37. "Keymap used in occur source.")
  38. (defgroup helm-occur nil
  39. "Regexp related Applications and libraries for Helm."
  40. :group 'helm)
  41. (defcustom helm-occur-actions
  42. '(("Go to Line" . helm-occur-goto-line)
  43. ("Goto line other window (C-u vertically)" . helm-occur-goto-line-ow)
  44. ("Goto line new frame" . helm-occur-goto-line-of)
  45. ("Save buffer" . helm-occur-save-results)
  46. )
  47. "Actions for helm-occur."
  48. :group 'helm-occur
  49. :type '(alist :key-type string :value-type function))
  50. (defcustom helm-occur-use-ioccur-style-keys nil
  51. "Similar to `helm-grep-use-ioccur-style-keys' but for multi occur.
  52. Note that if you define this variable with `setq' your change will
  53. have no effect, use customize instead."
  54. :group 'helm-occur
  55. :type 'boolean
  56. :set (lambda (var val)
  57. (set var val)
  58. (if val
  59. (progn
  60. (define-key helm-occur-map (kbd "<right>") 'helm-occur-right)
  61. (define-key helm-occur-map (kbd "<left>") 'helm-occur-run-default-action))
  62. (define-key helm-occur-map (kbd "<right>") nil)
  63. (define-key helm-occur-map (kbd "<left>") nil))))
  64. (defcustom helm-occur-always-search-in-current nil
  65. "Helm multi occur always search in current buffer when non--nil."
  66. :group 'helm-occur
  67. :type 'boolean)
  68. (defcustom helm-occur-truncate-lines t
  69. "Truncate lines in occur buffer when non nil."
  70. :group 'helm-occur
  71. :type 'boolean)
  72. (defcustom helm-occur-auto-update-on-resume nil
  73. "Allow auto updating helm-occur buffer when outdated.
  74. noask => Always update without asking
  75. nil => Don't update but signal buffer needs update
  76. never => Never update and do not signal buffer needs update
  77. Any other non--nil value update after confirmation."
  78. :group 'helm-regexp
  79. :type '(radio :tag "Allow auto updating helm-occur buffer when outdated."
  80. (const :tag "Always update without asking" noask)
  81. (const :tag "Never update and do not signal buffer needs update" never)
  82. (const :tag "Don't update but signal buffer needs update" nil)
  83. (const :tag "Update after confirmation" t)))
  84. (defcustom helm-occur-candidate-number-limit 99999
  85. "Value of `helm-candidate-number-limit' for helm-occur."
  86. :group 'helm-occur
  87. :type 'integer)
  88. (defcustom helm-occur-buffer-substring-fn-for-modes
  89. '((mu4e-headers-mode . buffer-substring))
  90. "Function to use to display buffer contents for major-mode.
  91. Can be one of `buffer-substring' or `buffer-substring-no-properties'.
  92. Note that when using `buffer-substring' initialization will be slower."
  93. :group 'helm-regexp
  94. :type '(alist :key-type (symbol :tag "Mode")
  95. :value-type (radio (const :tag "With text properties" buffer-substring)
  96. (const :tag "Without text properties" buffer-substring-no-properties))))
  97. (defface helm-moccur-buffer
  98. '((t (:foreground "DarkTurquoise" :underline t)))
  99. "Face used to highlight occur buffer names."
  100. :group 'helm-occur)
  101. (defface helm-resume-need-update
  102. '((t (:background "red")))
  103. "Face used to flash occur buffer when it needs update."
  104. :group 'helm-occur)
  105. ;;;###autoload
  106. (defun helm-occur ()
  107. "Preconfigured helm for searching lines matching pattern in `current-buffer'.
  108. When `helm-source-occur' is member of
  109. `helm-sources-using-default-as-input' which is the default,
  110. symbol at point is searched at startup.
  111. When a region is marked search only in this region by narrowing.
  112. To search in multiples buffers start from one of the commands listing
  113. buffers (i.e. a helm command using `helm-source-buffers-list' like
  114. `helm-mini') and use the multi occur buffers action.
  115. This is the helm implementation that collect lines matching pattern
  116. like vanilla emacs `occur' but have nothing to do with it, the search
  117. engine beeing completely different and also much faster."
  118. (interactive)
  119. (setq helm-source-occur
  120. (car (helm-occur-build-sources (list (current-buffer)) "Helm occur")))
  121. (helm-set-local-variable 'helm-occur--buffer-list (list (current-buffer))
  122. 'helm-occur--buffer-tick
  123. (list (buffer-chars-modified-tick (current-buffer))))
  124. (save-restriction
  125. (let (def pos)
  126. (when (use-region-p)
  127. ;; When user mark defun with `mark-defun' with intention of
  128. ;; using helm-occur on this region, it is relevant to use the
  129. ;; thing-at-point located at previous position which have been
  130. ;; pushed to `mark-ring'.
  131. (setq def (save-excursion
  132. (goto-char (setq pos (car mark-ring)))
  133. (helm-aif (thing-at-point 'symbol) (regexp-quote it))))
  134. (narrow-to-region (region-beginning) (region-end)))
  135. (unwind-protect
  136. (helm :sources 'helm-source-occur
  137. :buffer "*helm occur*"
  138. :history 'helm-occur-history
  139. :default (or def (helm-aif (thing-at-point 'symbol)
  140. (regexp-quote it)))
  141. :preselect (and (memq 'helm-source-occur
  142. helm-sources-using-default-as-input)
  143. (format "^%d:" (line-number-at-pos
  144. (or pos (point)))))
  145. :truncate-lines helm-occur-truncate-lines)
  146. (deactivate-mark t)))))
  147. (defun helm-occur-transformer (candidates source)
  148. "Returns CANDIDATES prefixed with line number."
  149. (cl-loop with buf = (helm-attr 'buffer-name source)
  150. for c in candidates collect
  151. (when (string-match helm-occur--search-buffer-regexp c)
  152. (let ((linum (match-string 1 c))
  153. (disp (match-string 2 c)))
  154. (cons (format "%s:%s"
  155. (propertize
  156. linum 'face 'helm-grep-lineno
  157. 'help-echo (buffer-file-name
  158. (get-buffer buf)))
  159. disp)
  160. (string-to-number linum))))))
  161. (defclass helm-moccur-class (helm-source-in-buffer)
  162. ((buffer-name :initarg :buffer-name
  163. :initform nil)
  164. (moccur-buffers :initarg :moccur-buffers
  165. :initform nil)))
  166. (defun helm-occur-build-sources (buffers &optional source-name)
  167. "Build sources for helm-occur for each buffer in BUFFERS list."
  168. (cl-loop for buf in buffers
  169. collect
  170. (helm-make-source (or source-name
  171. (format "HO [%s]"
  172. (buffer-name buf)))
  173. 'helm-moccur-class
  174. :buffer-name (buffer-name buf)
  175. :match-part
  176. (lambda (candidate)
  177. ;; The regexp should match what is in candidate buffer,
  178. ;; not what is displayed in helm-buffer e.g. "12 foo"
  179. ;; and not "12:foo".
  180. (when (string-match helm-occur--search-buffer-regexp
  181. candidate)
  182. (match-string 2 candidate)))
  183. :search (lambda (pattern)
  184. (when (string-match "\\`\\^\\([^ ]*\\)" pattern)
  185. (setq pattern (concat "^[0-9]* \\{1\\}" (match-string 1 pattern))))
  186. (condition-case _err
  187. (re-search-forward pattern nil t)
  188. (invalid-regexp nil)))
  189. :init `(lambda ()
  190. (with-current-buffer ,buf
  191. (let* ((bsfn (or (cdr (assq
  192. major-mode
  193. helm-occur-buffer-substring-fn-for-modes))
  194. #'buffer-substring-no-properties))
  195. (contents (funcall bsfn (point-min) (point-max))))
  196. (helm-attrset 'get-line bsfn)
  197. (with-current-buffer (helm-candidate-buffer 'local)
  198. (insert contents)
  199. (goto-char (point-min))
  200. (let ((linum 1))
  201. (insert (format "%s " linum))
  202. (while (re-search-forward "\n" nil t)
  203. (cl-incf linum)
  204. (insert (format "%s " linum))))))))
  205. :filtered-candidate-transformer 'helm-occur-transformer
  206. :help-message 'helm-moccur-help-message
  207. :nomark t
  208. :migemo t
  209. ;; Needed for resume.
  210. :history 'helm-occur-history
  211. :candidate-number-limit helm-occur-candidate-number-limit
  212. :action 'helm-occur-actions
  213. :requires-pattern 2
  214. :follow 1
  215. :group 'helm-occur
  216. :keymap helm-occur-map
  217. :resume 'helm-occur-resume-fn
  218. :moccur-buffers buffers)))
  219. (defun helm-multi-occur-1 (buffers &optional input)
  220. "Runs helm-occur on a list of buffers.
  221. Each buffer's result is displayed in a separated source."
  222. (let* ((curbuf (current-buffer))
  223. (bufs (if helm-occur-always-search-in-current
  224. (cons curbuf (remove curbuf buffers))
  225. buffers))
  226. (sources (helm-occur-build-sources bufs))
  227. (helm--maybe-use-default-as-input
  228. (not (null (memq 'helm-source-moccur
  229. helm-sources-using-default-as-input)))))
  230. (helm-set-local-variable 'helm-occur--buffer-list bufs
  231. 'helm-occur--buffer-tick
  232. (cl-loop for b in bufs collect
  233. (buffer-chars-modified-tick
  234. (get-buffer b))))
  235. (helm :sources sources
  236. :buffer "*helm moccur*"
  237. :history 'helm-occur-history
  238. :default (helm-aif (thing-at-point 'symbol) (regexp-quote it))
  239. :input input
  240. :truncate-lines helm-occur-truncate-lines)))
  241. ;;; Actions
  242. ;;
  243. (cl-defun helm-occur-action (lineno
  244. &optional (method (quote buffer)))
  245. "Jump to line number LINENO with METHOD.
  246. arg METHOD can be one of buffer, buffer-other-window, buffer-other-frame."
  247. (require 'helm-grep)
  248. (let ((buf (if (eq major-mode 'helm-occur-mode)
  249. (get-text-property (point) 'buffer-name)
  250. (helm-attr 'buffer-name)))
  251. (split-pat (helm-mm-split-pattern helm-input)))
  252. (cl-case method
  253. (buffer (switch-to-buffer buf))
  254. (buffer-other-window (helm-window-show-buffers (list buf) t))
  255. (buffer-other-frame (switch-to-buffer-other-frame buf)))
  256. (with-current-buffer buf
  257. (helm-goto-line lineno)
  258. ;; Move point to the nearest matching regexp from bol.
  259. (cl-loop for reg in split-pat
  260. when (save-excursion
  261. (condition-case _err
  262. (if helm-migemo-mode
  263. (helm-mm-migemo-forward reg (point-at-eol) t)
  264. (re-search-forward reg (point-at-eol) t))
  265. (invalid-regexp nil)))
  266. collect (match-beginning 0) into pos-ls
  267. finally (when pos-ls (goto-char (apply #'min pos-ls)))))))
  268. (defun helm-occur-goto-line (candidate)
  269. "From multi occur, switch to buffer and CANDIDATE line."
  270. (helm-occur-action
  271. candidate 'buffer))
  272. (defun helm-occur-goto-line-ow (candidate)
  273. "Go to CANDIDATE line in other window.
  274. Same as `helm-occur-goto-line' but go in other window."
  275. (helm-occur-action
  276. candidate 'buffer-other-window))
  277. (defun helm-occur-goto-line-of (candidate)
  278. "Go to CANDIDATE line in new frame.
  279. Same as `helm-occur-goto-line' but go in new frame."
  280. (helm-occur-action
  281. candidate 'buffer-other-frame))
  282. (defun helm-occur-run-goto-line-ow ()
  283. "Run goto line other window action from `helm-occur'."
  284. (interactive)
  285. (with-helm-alive-p
  286. (helm-exit-and-execute-action 'helm-occur-goto-line-ow)))
  287. (put 'helm-occur-run-goto-line-ow 'helm-only t)
  288. (defun helm-occur-run-goto-line-of ()
  289. "Run goto line new frame action from `helm-occur'."
  290. (interactive)
  291. (with-helm-alive-p
  292. (helm-exit-and-execute-action 'helm-occur-goto-line-of)))
  293. (put 'helm-occur-run-goto-line-of 'helm-only t)
  294. (defun helm-occur-run-default-action ()
  295. (interactive)
  296. (with-helm-alive-p
  297. (helm-exit-and-execute-action 'helm-occur-goto-line)))
  298. (put 'helm-occur-run-default-action 'helm-only t)
  299. (defun helm-occur-run-save-buffer ()
  300. "Run moccur save results action from `helm-moccur'."
  301. (interactive)
  302. (with-helm-alive-p
  303. (helm-exit-and-execute-action 'helm-occur-save-results)))
  304. (put 'helm-moccur-run-save-buffer 'helm-only t)
  305. (defun helm-occur-right ()
  306. "helm-occur action for right arrow.
  307. This is used when `helm-occur-use-ioccur-style-keys' is enabled.
  308. If follow is enabled (default) go to next source, otherwise execute
  309. persistent action."
  310. (interactive)
  311. (if (helm-aand (helm-attr 'follow) (> it 0))
  312. (helm-next-source)
  313. (helm-execute-persistent-action)))
  314. (put 'helm-occur-right 'helm-only t)
  315. ;;; helm-occur-mode
  316. ;;
  317. ;;
  318. (defvar helm-occur-mode-map
  319. (let ((map (make-sparse-keymap)))
  320. (define-key map (kbd "RET") 'helm-occur-mode-goto-line)
  321. (define-key map (kbd "C-o") 'helm-occur-mode-goto-line-ow)
  322. (define-key map (kbd "<C-down>") 'helm-occur-mode-goto-line-ow-forward)
  323. (define-key map (kbd "<C-up>") 'helm-occur-mode-goto-line-ow-backward)
  324. (define-key map (kbd "<M-down>") 'helm-gm-next-file)
  325. (define-key map (kbd "<M-up>") 'helm-gm-precedent-file)
  326. (define-key map (kbd "M-n") 'helm-occur-mode-goto-line-ow-forward)
  327. (define-key map (kbd "M-p") 'helm-occur-mode-goto-line-ow-backward)
  328. (define-key map (kbd "M-N") 'helm-gm-next-file)
  329. (define-key map (kbd "M-P") 'helm-gm-precedent-file)
  330. (define-key map (kbd "C-c b") 'helm-occur-mode-resume-session)
  331. map))
  332. (defun helm-occur-mode-goto-line ()
  333. (interactive)
  334. (helm-aif (get-text-property (point) 'helm-realvalue)
  335. (progn (helm-occur-goto-line it) (helm-match-line-cleanup-pulse))))
  336. (defun helm-occur-mode-goto-line-ow ()
  337. (interactive)
  338. (helm-aif (get-text-property (point) 'helm-realvalue)
  339. (progn (helm-occur-goto-line-ow it) (helm-match-line-cleanup-pulse))))
  340. (defun helm-occur-mode-goto-line-ow-forward-1 (arg)
  341. (condition-case nil
  342. (progn
  343. (when (or (eq last-command 'helm-occur-mode-goto-line-ow-forward)
  344. (eq last-command 'helm-occur-mode-goto-line-ow-backward))
  345. (forward-line arg))
  346. (save-selected-window
  347. (helm-occur-mode-goto-line-ow)
  348. (recenter)))
  349. (error nil)))
  350. (defun helm-occur-mode-goto-line-ow-forward (arg)
  351. (interactive "p")
  352. (helm-occur-mode-goto-line-ow-forward-1 arg))
  353. (defun helm-occur-mode-goto-line-ow-backward (arg)
  354. (interactive "p")
  355. (helm-occur-mode-goto-line-ow-forward-1 (- arg)))
  356. (defun helm-occur-save-results (_candidate)
  357. "Save helm moccur results in a `helm-moccur-mode' buffer."
  358. (let ((buf "*hmoccur*")
  359. new-buf)
  360. (when (get-buffer buf)
  361. (setq new-buf (helm-read-string "OccurBufferName: " buf))
  362. (cl-loop for b in (helm-buffer-list)
  363. when (and (string= new-buf b)
  364. (not (y-or-n-p
  365. (format "Buffer `%s' already exists overwrite? "
  366. new-buf))))
  367. do (setq new-buf (helm-read-string
  368. "OccurBufferName: " "*hmoccur ")))
  369. (setq buf new-buf))
  370. (with-current-buffer (get-buffer-create buf)
  371. (kill-all-local-variables)
  372. (setq buffer-read-only t)
  373. (buffer-disable-undo)
  374. (let ((inhibit-read-only t)
  375. (map (make-sparse-keymap))
  376. buf-name)
  377. (erase-buffer)
  378. (insert "-*- mode: helm-occur -*-\n\n"
  379. (format "Occur Results for `%s':\n\n" helm-input))
  380. (save-excursion
  381. (insert (with-current-buffer helm-buffer
  382. (goto-char (point-min))
  383. (forward-line 1)
  384. (buffer-substring (point) (point-max)))))
  385. (save-excursion
  386. (forward-line -2)
  387. (while (not (eobp))
  388. (if (helm-pos-header-line-p)
  389. (let ((beg (point-at-bol))
  390. (end (point-at-eol)))
  391. (set-text-properties beg (1+ end) nil)
  392. (delete-region (1- beg) end))
  393. (helm-aif (setq buf-name (assoc-default
  394. 'buffer-name
  395. (get-text-property (point) 'helm-cur-source)))
  396. (progn
  397. (insert (propertize (concat it ":")
  398. 'face 'helm-moccur-buffer
  399. 'helm-realvalue (get-text-property (point) 'helm-realvalue)))
  400. (add-text-properties
  401. (point-at-bol) (point-at-eol)
  402. `(buffer-name ,buf-name))
  403. (add-text-properties
  404. (point-at-bol) (point-at-eol)
  405. `(keymap ,map
  406. help-echo ,(concat
  407. (buffer-file-name
  408. (get-buffer buf-name))
  409. "\nmouse-1: set point\nmouse-2: jump to selection")
  410. mouse-face highlight
  411. invisible nil))
  412. (define-key map [mouse-1] 'mouse-set-point)
  413. (define-key map [mouse-2] 'helm-occur-mode-mouse-goto-line)
  414. (define-key map [mouse-3] 'ignore))))
  415. (forward-line 1))))
  416. (buffer-enable-undo)
  417. (helm-occur-mode))
  418. (pop-to-buffer buf)
  419. (message "Helm occur Results saved in `%s' buffer" buf)))
  420. (defun helm-occur-mode-mouse-goto-line (event)
  421. (interactive "e")
  422. (let* ((window (posn-window (event-end event)))
  423. (pos (posn-point (event-end event))))
  424. (with-selected-window window
  425. (when (eq major-mode 'helm-occur-mode)
  426. (goto-char pos)
  427. (helm-occur-mode-goto-line)))))
  428. (put 'helm-moccur-mode-mouse-goto-line 'helm-only t)
  429. (defun helm-occur-mode-resume-session ()
  430. (interactive)
  431. (cl-assert (eq major-mode 'helm-occur-mode) nil "Helm command called in wrong context")
  432. (helm-multi-occur-1 helm-occur--buffer-list helm-occur-mode--last-pattern))
  433. (defun helm-occur-buffer-substring-with-linums ()
  434. "Returns current-buffer contents as a string with all lines
  435. numbered. The property 'buffer-name is added to the whole string."
  436. (let ((bufstr (buffer-substring-no-properties (point-min) (point-max)))
  437. (bufname (buffer-name)))
  438. (with-temp-buffer
  439. (save-excursion
  440. (insert bufstr))
  441. (let ((linum 1))
  442. (insert (format "%s " linum))
  443. (while (re-search-forward "\n" nil t)
  444. (cl-incf linum)
  445. (insert (format "%s " linum)))
  446. (add-text-properties (point-min) (point-max) `(buffer-name ,bufname)))
  447. (buffer-string))))
  448. (defun helm-occur-mode--revert-buffer-function (&optional _ignore-auto _noconfirm)
  449. "The `revert-buffer-function' for `helm-occur-mode'."
  450. (goto-char (point-min))
  451. (let (pattern)
  452. (when (re-search-forward "^Occur Results for `\\(.*\\)'" nil t)
  453. (setq pattern (match-string 1))
  454. (forward-line 0)
  455. (when (re-search-forward "^$" nil t)
  456. (forward-line 1))
  457. (let ((inhibit-read-only t)
  458. (buffer (current-buffer))
  459. (buflst helm-occur--buffer-list))
  460. (delete-region (point) (point-max))
  461. (message "Reverting buffer...")
  462. (save-excursion
  463. (with-temp-buffer
  464. (insert
  465. "\n"
  466. (cl-loop for buf in buflst
  467. for bufstr = (or (and (buffer-live-p (get-buffer buf))
  468. (with-current-buffer buf
  469. (helm-occur-buffer-substring-with-linums)))
  470. "")
  471. concat bufstr)
  472. "\n")
  473. (goto-char (point-min))
  474. (cl-loop with linum
  475. with mpart
  476. ;; Bind helm-pattern used by `helm-grep-split-line'.
  477. with helm-pattern = pattern
  478. while (helm-mm-search pattern) ; point is at eol.
  479. ;; Calculate line number (linum) and extract real
  480. ;; part of line (mpart).
  481. do (when (save-excursion
  482. ;; `helm-mm-search' puts point at eol.
  483. (forward-line 0)
  484. (re-search-forward "^\\([0-9]*\\)\\s-\\{1\\}\\(.*\\)$"
  485. (point-at-eol) t))
  486. (setq linum (string-to-number (match-string 1))
  487. mpart (match-string 2)))
  488. ;; Match part after line number.
  489. when (and mpart (string-match pattern mpart))
  490. for line = (format "%s:%d:%s"
  491. (get-text-property (point) 'buffer-name)
  492. linum
  493. mpart)
  494. when line
  495. do (with-current-buffer buffer
  496. (insert
  497. (propertize
  498. (car (helm-occur-filter-one-by-one line))
  499. 'helm-realvalue linum)
  500. "\n"))))
  501. (when (fboundp 'wgrep-cleanup-overlays)
  502. (wgrep-cleanup-overlays (point-min) (point-max)))
  503. (message "Reverting buffer done"))))))
  504. (defun helm-occur-filter-one-by-one (candidate)
  505. "`filter-one-by-one' function for `helm-source-moccur'."
  506. (require 'helm-grep)
  507. (let* ((split (helm-grep-split-line candidate))
  508. (buf (car split))
  509. (lineno (nth 1 split))
  510. (str (nth 2 split)))
  511. (cons (concat (propertize
  512. buf
  513. 'face 'helm-moccur-buffer
  514. 'help-echo (buffer-file-name
  515. (get-buffer buf))
  516. 'buffer-name buf)
  517. ":"
  518. (propertize lineno 'face 'helm-grep-lineno)
  519. ":"
  520. (helm-grep-highlight-match str t))
  521. candidate)))
  522. ;;;###autoload
  523. (define-derived-mode helm-occur-mode
  524. special-mode "helm-moccur"
  525. "Major mode to provide actions in helm moccur saved buffer.
  526. Special commands:
  527. \\{helm-occur-mode-map}"
  528. (set (make-local-variable 'helm-occur--buffer-list)
  529. (with-helm-buffer helm-occur--buffer-list))
  530. (set (make-local-variable 'revert-buffer-function)
  531. #'helm-occur-mode--revert-buffer-function)
  532. (set (make-local-variable 'helm-occur-mode--last-pattern)
  533. helm-input))
  534. (put 'helm-moccur-mode 'helm-only t)
  535. ;;; Resume
  536. ;;
  537. (defun helm-occur-resume-fn ()
  538. (with-helm-buffer
  539. (let (new-tick-ls buffer-is-modified)
  540. (set (make-local-variable 'helm-occur--buffer-list)
  541. (cl-loop for b in helm-occur--buffer-list
  542. when (buffer-live-p (get-buffer b))
  543. collect b))
  544. (setq buffer-is-modified (/= (length helm-occur--buffer-list)
  545. (length (helm-attr 'moccur-buffers))))
  546. (helm-attrset 'moccur-buffers helm-occur--buffer-list)
  547. (setq new-tick-ls (cl-loop for b in helm-occur--buffer-list
  548. collect (buffer-chars-modified-tick
  549. (get-buffer b))))
  550. (when buffer-is-modified
  551. (setq helm-occur--buffer-tick new-tick-ls))
  552. (cl-assert (> (length helm-occur--buffer-list) 0) nil
  553. "helm-resume error: helm-(m)occur buffer list is empty")
  554. (unless (eq helm-occur-auto-update-on-resume 'never)
  555. (when (or buffer-is-modified
  556. (cl-loop for b in helm-occur--buffer-list
  557. for new-tick = (buffer-chars-modified-tick
  558. (get-buffer b))
  559. for tick in helm-occur--buffer-tick
  560. thereis (/= tick new-tick)))
  561. (helm-aif helm-occur-auto-update-on-resume
  562. (when (or (eq it 'noask)
  563. (y-or-n-p "Helm (m)occur Buffer outdated, update? "))
  564. (run-with-idle-timer
  565. 0.1 nil (lambda ()
  566. (with-helm-buffer
  567. (helm-force-update)
  568. (message "Helm (m)occur Buffer have been udated")
  569. (sit-for 1) (message nil))))
  570. (unless buffer-is-modified (setq helm-occur--buffer-tick
  571. new-tick-ls)))
  572. (run-with-idle-timer
  573. 0.1 nil
  574. (lambda ()
  575. (with-helm-buffer
  576. (let ((ov (make-overlay (save-excursion
  577. (goto-char (point-min))
  578. (forward-line 1)
  579. (point))
  580. (point-max))))
  581. (overlay-put ov 'face 'helm-resume-need-update)
  582. (sit-for 0.3) (delete-overlay ov)
  583. (message "[Helm occur Buffer outdated (C-c C-u to update)]")))))
  584. (unless buffer-is-modified
  585. (with-helm-after-update-hook
  586. (setq helm-occur--buffer-tick new-tick-ls)
  587. (message "Helm (m)occur Buffer have been udated")))))))))
  588. ;;; Helm occur from isearch
  589. ;;
  590. ;;;###autoload
  591. (defun helm-occur-from-isearch ()
  592. "Invoke `helm-occur' from isearch.
  593. To use this bind it to a key in `isearch-mode-map'."
  594. (interactive)
  595. (let ((input (if isearch-regexp
  596. isearch-string
  597. (regexp-quote isearch-string)))
  598. (bufs (list (current-buffer))))
  599. (isearch-exit)
  600. (helm-multi-occur-1 bufs input)))
  601. ;;;###autoload
  602. (defun helm-multi-occur-from-isearch ()
  603. "Invoke `helm-multi-occur' from isearch.
  604. With a prefix arg, reverse the behavior of
  605. `helm-moccur-always-search-in-current'.
  606. The prefix arg can be set before calling
  607. `helm-multi-occur-from-isearch' or during the buffer selection.
  608. To use this bind it to a key in `isearch-mode-map'."
  609. (interactive)
  610. (let (buf-list
  611. helm-moccur-always-search-in-current
  612. (input (if isearch-regexp
  613. isearch-string
  614. (regexp-quote isearch-string))))
  615. (isearch-exit)
  616. (setq buf-list (mapcar 'get-buffer
  617. (helm-comp-read "Buffers: "
  618. (helm-buffer-list)
  619. :name "Occur in buffer(s)"
  620. :marked-candidates t)))
  621. (setq helm-moccur-always-search-in-current
  622. (if (or current-prefix-arg
  623. helm-current-prefix-arg)
  624. (not helm-moccur-always-search-in-current)
  625. helm-moccur-always-search-in-current))
  626. (helm-multi-occur-1 buf-list input)))
  627. (provide 'helm-occur)
  628. ;; Local Variables:
  629. ;; byte-compile-warnings: (not obsolete)
  630. ;; coding: utf-8
  631. ;; indent-tabs-mode: nil
  632. ;; End:
  633. ;;; helm-occur.el ends here