]> code.delx.au - gnu-emacs-elpa/blob - swiper.el
Refactor swiper-font-lock-ensure
[gnu-emacs-elpa] / swiper.el
1 ;;; swiper.el --- Isearch with an overview. Oh, man! -*- lexical-binding: t -*-
2
3 ;; Copyright (C) 2015 Free Software Foundation, Inc.
4
5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
6 ;; URL: https://github.com/abo-abo/swiper
7 ;; Version: 0.7.0
8 ;; Package-Requires: ((emacs "24.1"))
9 ;; Keywords: matching
10
11 ;; This file is part of GNU Emacs.
12
13 ;; This file is free software; you can redistribute it and/or modify
14 ;; it under the terms of the GNU General Public License as published by
15 ;; the Free Software Foundation; either version 3, or (at your option)
16 ;; any later version.
17
18 ;; This program is distributed in the hope that it will be useful,
19 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21 ;; GNU General Public License for more details.
22
23 ;; For a full copy of the GNU General Public License
24 ;; see <http://www.gnu.org/licenses/>.
25
26 ;;; Commentary:
27 ;;
28 ;; This package gives an overview of the current regex search
29 ;; candidates. The search regex can be split into groups with a
30 ;; space. Each group is highlighted with a different face.
31 ;;
32 ;; It can double as a quick `regex-builder', although only single
33 ;; lines will be matched.
34 ;;
35 ;; It also provides `ivy-mode': a global minor mode that uses the
36 ;; matching back end of `swiper' for all matching on your system,
37 ;; including file matching. You can use it in place of `ido-mode'
38 ;; (can't have both on at once).
39
40 ;;; Code:
41 (require 'ivy)
42
43 (defgroup swiper nil
44 "`isearch' with an overview."
45 :group 'matching
46 :prefix "swiper-")
47
48 (defface swiper-match-face-1
49 '((t (:inherit isearch-lazy-highlight-face)))
50 "The background face for `swiper' matches.")
51
52 (defface swiper-match-face-2
53 '((t (:inherit isearch)))
54 "Face for `swiper' matches modulo 1.")
55
56 (defface swiper-match-face-3
57 '((t (:inherit match)))
58 "Face for `swiper' matches modulo 2.")
59
60 (defface swiper-match-face-4
61 '((t (:inherit isearch-fail)))
62 "Face for `swiper' matches modulo 3.")
63
64 (define-obsolete-face-alias 'swiper-minibuffer-match-face-1
65 'ivy-minibuffer-match-face-1 "0.6.0")
66
67 (define-obsolete-face-alias 'swiper-minibuffer-match-face-2
68 'ivy-minibuffer-match-face-2 "0.6.0")
69
70 (define-obsolete-face-alias 'swiper-minibuffer-match-face-3
71 'ivy-minibuffer-match-face-3 "0.6.0")
72
73 (define-obsolete-face-alias 'swiper-minibuffer-match-face-4
74 'ivy-minibuffer-match-face-4 "0.6.0")
75
76 (defface swiper-line-face
77 '((t (:inherit highlight)))
78 "Face for current `swiper' line.")
79
80 (defcustom swiper-faces '(swiper-match-face-1
81 swiper-match-face-2
82 swiper-match-face-3
83 swiper-match-face-4)
84 "List of `swiper' faces for group matches.")
85
86 (defcustom swiper-min-highlight 2
87 "Only highlight matches for regexps at least this long."
88 :type 'integer)
89
90 (defvar swiper-map
91 (let ((map (make-sparse-keymap)))
92 (define-key map (kbd "M-q") 'swiper-query-replace)
93 (define-key map (kbd "C-l") 'swiper-recenter-top-bottom)
94 (define-key map (kbd "C-'") 'swiper-avy)
95 (define-key map (kbd "C-7") 'swiper-mc)
96 (define-key map (kbd "C-c C-f") 'swiper-toggle-face-matching)
97 map)
98 "Keymap for swiper.")
99
100 (defun swiper-query-replace ()
101 "Start `query-replace' with string to replace from last search string."
102 (interactive)
103 (if (null (window-minibuffer-p))
104 (user-error "Should only be called in the minibuffer through `swiper-map'")
105 (let* ((enable-recursive-minibuffers t)
106 (from (ivy--regex ivy-text))
107 (to (query-replace-read-to from "Query replace" t)))
108 (swiper--cleanup)
109 (ivy-exit-with-action
110 (lambda (_)
111 (with-ivy-window
112 (move-beginning-of-line 1)
113 (perform-replace from to
114 t t nil)))))))
115
116 (defvar avy-background)
117 (defvar avy-all-windows)
118 (defvar avy-style)
119 (defvar avy-keys)
120 (declare-function avy--regex-candidates "ext:avy")
121 (declare-function avy--process "ext:avy")
122 (declare-function avy--overlay-post "ext:avy")
123 (declare-function avy-action-goto "ext:avy")
124 (declare-function avy--done "ext:avy")
125 (declare-function avy--make-backgrounds "ext:avy")
126 (declare-function avy-window-list "ext:avy")
127 (declare-function avy-read "ext:avy")
128 (declare-function avy-read-de-bruijn "ext:avy")
129 (declare-function avy-tree "ext:avy")
130 (declare-function avy-push-mark "ext:avy")
131 (declare-function avy--remove-leading-chars "ext:avy")
132
133 ;;;###autoload
134 (defun swiper-avy ()
135 "Jump to one of the current swiper candidates."
136 (interactive)
137 (unless (string= ivy-text "")
138 (let* ((avy-all-windows nil)
139 (candidates (append
140 (with-ivy-window
141 (avy--regex-candidates
142 (ivy--regex ivy-text)))
143 (save-excursion
144 (save-restriction
145 (narrow-to-region (window-start) (window-end))
146 (goto-char (point-min))
147 (forward-line)
148 (let ((cands))
149 (while (< (point) (point-max))
150 (push (cons (1+ (point))
151 (selected-window))
152 cands)
153 (forward-line))
154 cands)))))
155 (candidate (unwind-protect
156 (prog2
157 (avy--make-backgrounds
158 (append (avy-window-list)
159 (list (ivy-state-window ivy-last))))
160 (if (eq avy-style 'de-bruijn)
161 (avy-read-de-bruijn
162 candidates avy-keys)
163 (avy-read (avy-tree candidates avy-keys)
164 #'avy--overlay-post
165 #'avy--remove-leading-chars))
166 (avy-push-mark))
167 (avy--done))))
168 (if (window-minibuffer-p (cdr candidate))
169 (progn
170 (ivy-set-index (- (line-number-at-pos (car candidate)) 2))
171 (ivy--exhibit)
172 (ivy-done)
173 (ivy-call))
174 (ivy-quit-and-run
175 (avy-action-goto (caar candidate)))))))
176
177 (declare-function mc/create-fake-cursor-at-point "ext:multiple-cursors-core")
178 (declare-function multiple-cursors-mode "ext:multiple-cursors-core")
179
180 ;;;###autoload
181 (defun swiper-mc ()
182 (interactive)
183 (unless (require 'multiple-cursors nil t)
184 (error "multiple-cursors isn't installed"))
185 (let ((cands (nreverse ivy--old-cands)))
186 (unless (string= ivy-text "")
187 (ivy-exit-with-action
188 (lambda (_)
189 (let (cand)
190 (while (setq cand (pop cands))
191 (swiper--action cand)
192 (when cands
193 (mc/create-fake-cursor-at-point))))
194 (multiple-cursors-mode 1))))))
195
196 (defun swiper-recenter-top-bottom (&optional arg)
197 "Call (`recenter-top-bottom' ARG)."
198 (interactive "P")
199 (with-ivy-window
200 (recenter-top-bottom arg)))
201
202 (defvar swiper-font-lock-exclude
203 '(package-menu-mode
204 gnus-summary-mode
205 gnus-article-mode
206 gnus-group-mode
207 emms-playlist-mode
208 emms-stream-mode
209 erc-mode
210 org-agenda-mode
211 dired-mode
212 jabber-chat-mode
213 elfeed-search-mode
214 elfeed-show-mode
215 fundamental-mode
216 Man-mode
217 woman-mode
218 mu4e-view-mode
219 mu4e-headers-mode
220 help-mode
221 debbugs-gnu-mode
222 occur-mode
223 occur-edit-mode
224 bongo-mode
225 bongo-library-mode
226 bongo-playlist-mode
227 eww-mode
228 twittering-mode
229 vc-dir-mode
230 w3m-mode)
231 "List of major-modes that are incompatible with font-lock-ensure.")
232
233 (defun swiper-font-lock-ensure-p ()
234 "Return non-nil if we should font-lock-ensure."
235 (or (derived-mode-p 'magit-mode)
236 (bound-and-true-p magit-blame-mode)
237 (memq major-mode swiper-font-lock-exclude)))
238
239 (defun swiper-font-lock-ensure ()
240 "Ensure the entired buffer is highlighted."
241 (unless (swiper-font-lock-ensure-p)
242 (unless (> (buffer-size) 100000)
243 (if (fboundp 'font-lock-ensure)
244 (font-lock-ensure)
245 (with-no-warnings (font-lock-fontify-buffer))))))
246
247 (defvar swiper--format-spec ""
248 "Store the current candidates format spec.")
249
250 (defvar swiper--width nil
251 "Store the amount of digits needed for the longest line nubmer.")
252
253 (defvar swiper-use-visual-line nil
254 "When non-nil, use `line-move' instead of `forward-line'.")
255
256 (declare-function outline-show-all "outline")
257
258 (defun swiper--candidates (&optional numbers-width)
259 "Return a list of this buffer lines.
260
261 NUMBERS-WIDTH, when specified, is used for line numbers width
262 spec, instead of calculating it as the log of the buffer line
263 count."
264 (if (and visual-line-mode
265 ;; super-slow otherwise
266 (< (buffer-size) 20000))
267 (progn
268 (when (eq major-mode 'org-mode)
269 (require 'outline)
270 (if (fboundp 'outline-show-all)
271 (outline-show-all)
272 (with-no-warnings
273 (show-all))))
274 (setq swiper-use-visual-line t))
275 (setq swiper-use-visual-line nil))
276 (let ((n-lines (count-lines (point-min) (point-max))))
277 (unless (zerop n-lines)
278 (setq swiper--width (or numbers-width
279 (1+ (floor (log n-lines 10)))))
280 (setq swiper--format-spec
281 (format "%%-%dd " swiper--width))
282 (let ((line-number 0)
283 (advancer (if swiper-use-visual-line
284 (lambda (arg) (line-move arg t))
285 #'forward-line))
286 candidates)
287 (save-excursion
288 (goto-char (point-min))
289 (swiper-font-lock-ensure)
290 (while (< (point) (point-max))
291 (let ((str (concat
292 " "
293 (replace-regexp-in-string
294 "\t" " "
295 (if swiper-use-visual-line
296 (buffer-substring
297 (save-excursion
298 (beginning-of-visual-line)
299 (point))
300 (save-excursion
301 (end-of-visual-line)
302 (point)))
303 (buffer-substring
304 (point)
305 (line-end-position)))))))
306 (when (eq major-mode 'twittering-mode)
307 (remove-text-properties 0 (length str) '(field) str))
308 (put-text-property 0 1 'display
309 (format swiper--format-spec
310 (cl-incf line-number))
311 str)
312 (push str candidates))
313 (funcall advancer 1))
314 (nreverse candidates))))))
315
316 (defvar swiper--opoint 1
317 "The point when `swiper' starts.")
318
319 ;;;###autoload
320 (defun swiper (&optional initial-input)
321 "`isearch' with an overview.
322 When non-nil, INITIAL-INPUT is the initial search pattern."
323 (interactive)
324 (swiper--ivy initial-input))
325
326 (declare-function evil-jumper--set-jump "ext:evil-jumper")
327
328 (defvar swiper--current-line nil)
329 (defvar swiper--current-match-start nil)
330
331 (defun swiper--init ()
332 "Perform initialization common to both completion methods."
333 (setq swiper--current-line nil)
334 (setq swiper--current-match-start nil)
335 (setq swiper--opoint (point))
336 (when (bound-and-true-p evil-jumper-mode)
337 (evil-jumper--set-jump)))
338
339 (defun swiper--re-builder (str)
340 "Transform STR into a swiper regex.
341 This is the regex used in the minibuffer, since the candidates
342 there have line numbers. In the buffer, `ivy--regex' should be used."
343 (cond
344 ((equal str "")
345 "")
346 ((equal str "^")
347 (setq ivy--subexps 0)
348 ".")
349 ((string-match "^\\^" str)
350 (setq ivy--old-re "")
351 (let ((re (ivy--regex-plus (substring str 1))))
352 (if (zerop ivy--subexps)
353 (prog1 (format "^ ?\\(%s\\)" re)
354 (setq ivy--subexps 1))
355 (format "^ %s" re))))
356 (t
357 (ivy--regex-plus str))))
358
359 (defvar swiper-history nil
360 "History for `swiper'.")
361
362 (defvar swiper-invocation-face nil
363 "The face at the point of invocation of `swiper'.")
364
365 (defun swiper--ivy (&optional initial-input)
366 "`isearch' with an overview using `ivy'.
367 When non-nil, INITIAL-INPUT is the initial search pattern."
368 (interactive)
369 (swiper--init)
370 (setq swiper-invocation-face
371 (plist-get (text-properties-at (point)) 'face))
372 (let ((candidates (swiper--candidates))
373 (preselect
374 (if swiper-use-visual-line
375 (count-screen-lines
376 (point-min)
377 (save-excursion (beginning-of-visual-line) (point)))
378 (1- (line-number-at-pos))))
379 (minibuffer-allow-text-properties t)
380 res)
381 (unwind-protect
382 (setq res
383 (ivy-read
384 "Swiper: "
385 candidates
386 :initial-input initial-input
387 :keymap swiper-map
388 :preselect preselect
389 :require-match t
390 :update-fn #'swiper--update-input-ivy
391 :unwind #'swiper--cleanup
392 :action #'swiper--action
393 :re-builder #'swiper--re-builder
394 :history 'swiper-history
395 :caller 'swiper))
396 (unless res
397 (goto-char swiper--opoint)))))
398
399 (defun swiper-toggle-face-matching ()
400 "Toggle matching only the candidates with `swiper-invocation-face'."
401 (interactive)
402 (setf (ivy-state-matcher ivy-last)
403 (if (ivy-state-matcher ivy-last)
404 nil
405 #'swiper--face-matcher))
406 (setq ivy--old-re nil))
407
408 (defun swiper--face-matcher (regexp candidates)
409 "Return REGEXP-matching CANDIDATES.
410 Matched candidates should have `swiper-invocation-face'."
411 (cl-remove-if-not
412 (lambda (x)
413 (and
414 (string-match regexp x)
415 (let ((s (match-string 0 x))
416 (i 0))
417 (while (and (< i (length s))
418 (text-property-any
419 i (1+ i)
420 'face swiper-invocation-face
421 s))
422 (cl-incf i))
423 (eq i (length s)))))
424 candidates))
425
426 (defun swiper--ensure-visible ()
427 "Remove overlays hiding point."
428 (let ((overlays (overlays-at (point)))
429 ov expose)
430 (while (setq ov (pop overlays))
431 (if (and (invisible-p (overlay-get ov 'invisible))
432 (setq expose (overlay-get ov 'isearch-open-invisible)))
433 (funcall expose ov)))))
434
435 (defvar swiper--overlays nil
436 "Store overlays.")
437
438 (defun swiper--cleanup ()
439 "Clean up the overlays."
440 (while swiper--overlays
441 (delete-overlay (pop swiper--overlays)))
442 (save-excursion
443 (goto-char (point-min))
444 (isearch-clean-overlays)))
445
446 (defun swiper--update-input-ivy ()
447 "Called when `ivy' input is updated."
448 (with-ivy-window
449 (swiper--cleanup)
450 (when (> (length ivy--current) 0)
451 (let* ((re (funcall ivy--regex-function ivy-text))
452 (re (if (stringp re) re (caar re)))
453 (str (get-text-property 0 'display ivy--current))
454 (num (if (string-match "^[0-9]+" str)
455 (string-to-number (match-string 0 str))
456 0)))
457 (unless (eq this-command 'ivy-yank-word)
458 (when (cl-plusp num)
459 (unless (if swiper--current-line
460 (eq swiper--current-line num)
461 (eq (line-number-at-pos) num))
462 (goto-char (point-min))
463 (if swiper-use-visual-line
464 (line-move (1- num))
465 (forward-line (1- num))))
466 (if (and (equal ivy-text "")
467 (>= swiper--opoint (line-beginning-position))
468 (<= swiper--opoint (line-end-position)))
469 (goto-char swiper--opoint)
470 (if (eq swiper--current-line num)
471 (when swiper--current-match-start
472 (goto-char swiper--current-match-start))
473 (setq swiper--current-line num))
474 (re-search-forward re (line-end-position) t)
475 (setq swiper--current-match-start (match-beginning 0)))
476 (isearch-range-invisible (line-beginning-position)
477 (line-end-position))
478 (unless (and (>= (point) (window-start))
479 (<= (point) (window-end (ivy-state-window ivy-last) t)))
480 (recenter))))
481 (swiper--add-overlays re)))))
482
483 (defun swiper--add-overlays (re &optional beg end wnd)
484 "Add overlays for RE regexp in visible part of the current buffer.
485 BEG and END, when specified, are the point bounds.
486 WND, when specified is the window."
487 (setq wnd (or wnd (ivy-state-window ivy-last)))
488 (let ((ov (if visual-line-mode
489 (make-overlay
490 (save-excursion
491 (beginning-of-visual-line)
492 (point))
493 (save-excursion
494 (end-of-visual-line)
495 (point)))
496 (make-overlay
497 (line-beginning-position)
498 (1+ (line-end-position))))))
499 (overlay-put ov 'face 'swiper-line-face)
500 (overlay-put ov 'window wnd)
501 (push ov swiper--overlays)
502 (let* ((wh (window-height))
503 (beg (or beg (save-excursion
504 (forward-line (- wh))
505 (point))))
506 (end (or end (save-excursion
507 (forward-line wh)
508 (point)))))
509 (when (>= (length re) swiper-min-highlight)
510 (save-excursion
511 (goto-char beg)
512 ;; RE can become an invalid regexp
513 (while (and (ignore-errors (re-search-forward re end t))
514 (> (- (match-end 0) (match-beginning 0)) 0))
515 (let ((i 0))
516 (while (<= i ivy--subexps)
517 (when (match-beginning i)
518 (let ((overlay (make-overlay (match-beginning i)
519 (match-end i)))
520 (face
521 (cond ((zerop ivy--subexps)
522 (cadr swiper-faces))
523 ((zerop i)
524 (car swiper-faces))
525 (t
526 (nth (1+ (mod (+ i 2) (1- (length swiper-faces))))
527 swiper-faces)))))
528 (push overlay swiper--overlays)
529 (overlay-put overlay 'face face)
530 (overlay-put overlay 'window wnd)
531 (overlay-put overlay 'priority i)))
532 (cl-incf i)))))))))
533
534 (defun swiper--action (x)
535 "Goto line X."
536 (if (null x)
537 (user-error "No candidates")
538 (with-ivy-window
539 (unless (equal (current-buffer)
540 (ivy-state-buffer ivy-last))
541 (switch-to-buffer (ivy-state-buffer ivy-last)))
542 (goto-char (point-min))
543 (funcall (if swiper-use-visual-line
544 #'line-move
545 #'forward-line)
546 (1- (read (get-text-property 0 'display x))))
547 (re-search-forward
548 (ivy--regex ivy-text) (line-end-position) t)
549 (swiper--ensure-visible)
550 (when (/= (point) swiper--opoint)
551 (unless (and transient-mark-mode mark-active)
552 (when (eq ivy-exit 'done)
553 (push-mark swiper--opoint t)
554 (message "Mark saved where search started")))))))
555
556 ;; (define-key isearch-mode-map (kbd "C-o") 'swiper-from-isearch)
557 (defun swiper-from-isearch ()
558 "Invoke `swiper' from isearch."
559 (interactive)
560 (let ((query (if isearch-regexp
561 isearch-string
562 (regexp-quote isearch-string))))
563 (isearch-exit)
564 (swiper query)))
565
566 (defvar swiper-multi-buffers nil
567 "Store the current list of buffers.")
568
569 (defvar swiper-multi-candidates nil
570 "Store the list of candidates for `swiper-multi'.")
571
572 (defun swiper-multi-prompt ()
573 (format "Buffers (%s): "
574 (mapconcat #'identity swiper-multi-buffers ", ")))
575
576 (defun swiper-multi ()
577 "Select one or more buffers.
578 Run `swiper' for those buffers."
579 (interactive)
580 (setq swiper-multi-buffers nil)
581 (ivy-read (swiper-multi-prompt)
582 'internal-complete-buffer
583 :action 'swiper-multi-action-1)
584 (ivy-read "Swiper: " swiper-multi-candidates
585 :action 'swiper-multi-action-2
586 :unwind #'swiper--cleanup
587 :caller 'swiper-multi))
588
589 (defun swiper-all ()
590 "Run `swiper' for all opened buffers."
591 (interactive)
592 (ivy-read "Swiper: " (swiper--multi-candidates
593 (cl-remove-if-not
594 #'buffer-file-name
595 (buffer-list)))
596 :action 'swiper-multi-action-2
597 :unwind #'swiper--cleanup
598 :caller 'swiper-multi))
599
600 (defun swiper--multi-candidates (buffers)
601 (let* ((ww (window-width))
602 (res nil)
603 (column-2 (apply #'max
604 (mapcar
605 (lambda (b)
606 (length (buffer-name b)))
607 buffers)))
608 (column-1 (- ww 4 column-2 1)))
609 (dolist (buf buffers)
610 (with-current-buffer buf
611 (setq res
612 (append
613 (mapcar
614 (lambda (s)
615 (setq s (concat (ivy--truncate-string s column-1) " "))
616 (let ((len (length s)))
617 (put-text-property
618 (1- len) len 'display
619 (concat
620 (make-string
621 (- ww (string-width s) (length (buffer-name)) 3)
622 ?\ )
623 (buffer-name))
624 s)
625 s))
626 (swiper--candidates 4))
627 res))
628 nil))
629 res))
630
631 (defun swiper-multi-action-1 (x)
632 (if (member x swiper-multi-buffers)
633 (progn
634 (setq swiper-multi-buffers (delete x swiper-multi-buffers)))
635 (unless (equal x "")
636 (setq swiper-multi-buffers (append swiper-multi-buffers (list x)))))
637 (let ((prompt (swiper-multi-prompt)))
638 (setf (ivy-state-prompt ivy-last) prompt)
639 (setq ivy--prompt (concat "%-4d " prompt)))
640 (cond ((memq this-command '(ivy-done
641 ivy-alt-done
642 ivy-immediate-done))
643 (setq swiper-multi-candidates
644 (swiper--multi-candidates
645 (mapcar #'get-buffer swiper-multi-buffers))))
646 ((eq this-command 'ivy-call)
647 (delete-minibuffer-contents))))
648
649 (defun swiper-multi-action-2 (x)
650 (let ((buf-space (get-text-property (1- (length x)) 'display x)))
651 (with-ivy-window
652 (when (string-match "\\` *\\([^ ]+\\)\\'" buf-space)
653 (switch-to-buffer (match-string 1 buf-space))
654 (goto-char (point-min))
655 (forward-line (1- (read (get-text-property 0 'display x))))
656 (re-search-forward
657 (ivy--regex ivy-text)
658 (line-end-position) t)
659 (unless (eq ivy-exit 'done)
660 (swiper--cleanup)
661 (swiper--add-overlays (ivy--regex ivy-text)))))))
662
663 (provide 'swiper)
664
665 ;;; swiper.el ends here