code.delx.au - gnu-emacs-elpa/blob - 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.5.1
   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 (defface swiper-minibuffer-match-face-1
  65   '((((class color) (background light))
  66      :background "#d3d3d3")
  67     (((class color) (background dark))
  68      :background "#555555"))
  69   "The background face for `swiper' minibuffer matches."
  70   :group 'function-args-faces)
  71
  72 (defface swiper-minibuffer-match-face-2
  73   '((((class color) (background light))
  74      :background "#e99ce8" :weight bold)
  75     (((class color) (background dark))
  76      :background "#777777" :weight bold))
  77   "Face for `swiper' minibuffer matches modulo 1.")
  78
  79 (defface swiper-minibuffer-match-face-3
  80   '((((class color) (background light))
  81      :background "#bbbbff" :weight bold)
  82     (((class color) (background dark))
  83      :background "#7777ff" :weight bold))
  84   "Face for `swiper' minibuffer matches modulo 2.")
  85
  86 (defface swiper-minibuffer-match-face-4
  87   '((((class color) (background light))
  88      :background "#ffbbff" :weight bold)
  89     (((class color) (background dark))
  90      :background "#8a498a" :weight bold))
  91   "Face for `swiper' minibuffer matches modulo 3.")
  92
  93 (defface swiper-line-face
  94   '((t (:inherit highlight)))
  95   "Face for current `swiper' line.")
  96
  97 (defcustom swiper-faces '(swiper-match-face-1
  98                           swiper-match-face-2
  99                           swiper-match-face-3
 100                           swiper-match-face-4)
 101   "List of `swiper' faces for group matches.")
 102
 103 (defcustom swiper-min-highlight 2
 104   "Only highlight matches for regexps at least this long."
 105   :type 'integer)
 106
 107 (defvar swiper-map
 108   (let ((map (make-sparse-keymap)))
 109     (define-key map (kbd "M-q") 'swiper-query-replace)
 110     (define-key map (kbd "C-l") 'swiper-recenter-top-bottom)
 111     (define-key map (kbd "C-'") 'swiper-avy)
 112     (define-key map (kbd "C-7") 'swiper-mc)
 113     map)
 114   "Keymap for swiper.")
 115
 116 (defun swiper-query-replace ()
 117   "Start `query-replace' with string to replace from last search string."
 118   (interactive)
 119   (if (null (window-minibuffer-p))
 120       (user-error "Should only be called in the minibuffer through `swiper-map'")
 121     (let* ((enable-recursive-minibuffers t)
 122            (from (ivy--regex ivy-text))
 123            (to (query-replace-read-to from "Query replace" t)))
 124       (delete-minibuffer-contents)
 125       (ivy-set-action (lambda (_)
 126                         (with-ivy-window
 127                           (move-beginning-of-line 1)
 128                           (perform-replace from to
 129                                            t t nil))))
 130       (swiper--cleanup)
 131       (exit-minibuffer))))
 132
 133 (defvar avy-background)
 134 (defvar avy-all-windows)
 135 (defvar avy-style)
 136 (defvar avy-keys)
 137 (declare-function avy--regex-candidates "ext:avy")
 138 (declare-function avy--process "ext:avy")
 139 (declare-function avy--overlay-post "ext:avy")
 140 (declare-function avy-action-goto "ext:avy")
 141 (declare-function avy--done "ext:avy")
 142 (declare-function avy--make-backgrounds "ext:avy")
 143 (declare-function avy-window-list "ext:avy")
 144 (declare-function avy-read "ext:avy")
 145 (declare-function avy-read-de-bruijn "ext:avy")
 146 (declare-function avy-tree "ext:avy")
 147 (declare-function avy-push-mark "ext:avy")
 148 (declare-function avy--remove-leading-chars "ext:avy")
 149
 150 ;;;###autoload
 151 (defun swiper-avy ()
 152   "Jump to one of the current swiper candidates."
 153   (interactive)
 154   (unless (string= ivy-text "")
 155     (let* ((avy-all-windows nil)
 156            (candidates (append
 157                         (with-ivy-window
 158                           (avy--regex-candidates
 159                            (ivy--regex ivy-text)))
 160                         (save-excursion
 161                           (save-restriction
 162                             (narrow-to-region (window-start) (window-end))
 163                             (goto-char (point-min))
 164                             (forward-line)
 165                             (let ((cands))
 166                               (while (< (point) (point-max))
 167                                 (push (cons (1+ (point))
 168                                             (selected-window))
 169                                       cands)
 170                                 (forward-line))
 171                               cands)))))
 172            (candidate (unwind-protect
 173                           (prog2
 174                               (avy--make-backgrounds
 175                                (append (avy-window-list)
 176                                        (list  (ivy-state-window ivy-last))))
 177                               (if (eq avy-style 'de-bruijn)
 178                                   (avy-read-de-bruijn
 179                                    candidates avy-keys)
 180                                 (avy-read (avy-tree candidates avy-keys)
 181                                           #'avy--overlay-post
 182                                           #'avy--remove-leading-chars))
 183                             (avy-push-mark))
 184                         (avy--done))))
 185       (if (window-minibuffer-p (cdr candidate))
 186           (progn
 187             (ivy-set-index (- (line-number-at-pos (car candidate)) 2))
 188             (ivy--exhibit)
 189             (ivy-done)
 190             (ivy-call))
 191         (ivy-quit-and-run
 192          (avy-action-goto (caar candidate)))))))
 193
 194 (declare-function mc/create-fake-cursor-at-point "ext:multiple-cursors-core")
 195 (declare-function mc/maybe-multiple-cursors-mode "ext:multiple-cursors-core")
 196
 197 ;;;###autoload
 198 (defun swiper-mc ()
 199   (interactive)
 200   (unless (require 'multiple-cursors nil t)
 201     (error "multiple-cursors isn't installed"))
 202   (let ((cands (nreverse ivy--old-cands)))
 203     (unless (string= ivy-text "")
 204       (ivy-set-action
 205        (lambda (_)
 206          (let (cand)
 207            (while (setq cand (pop cands))
 208              (swiper--action cand)
 209              (when cands
 210                (mc/create-fake-cursor-at-point))))
 211          (mc/maybe-multiple-cursors-mode)))
 212       (setq ivy-exit 'done)
 213       (exit-minibuffer))))
 214
 215 (defun swiper-recenter-top-bottom (&optional arg)
 216   "Call (`recenter-top-bottom' ARG)."
 217   (interactive "P")
 218   (with-ivy-window
 219     (recenter-top-bottom arg)))
 220
 221 (defun swiper-font-lock-ensure ()
 222   "Ensure the entired buffer is highlighted."
 223   (unless (or (derived-mode-p 'magit-mode)
 224               (bound-and-true-p magit-blame-mode)
 225               (memq major-mode '(package-menu-mode
 226                                  gnus-summary-mode
 227                                  gnus-article-mode
 228                                  gnus-group-mode
 229                                  emms-playlist-mode erc-mode
 230                                  org-agenda-mode
 231                                  dired-mode
 232                                  jabber-chat-mode
 233                                  elfeed-search-mode
 234                                  elfeed-show-mode
 235                                  fundamental-mode
 236                                  Man-mode
 237                                  woman-mode
 238                                  mu4e-view-mode
 239                                  mu4e-headers-mode
 240                                  help-mode
 241                                  w3m-mode)))
 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 (defun swiper--candidates ()
 257   "Return a list of this buffer lines."
 258   (setq swiper-use-visual-line
 259         (and (not (eq major-mode 'org-mode))
 260              visual-line-mode
 261              (< (buffer-size) 20000)))
 262   (let ((n-lines (count-lines (point-min) (point-max))))
 263     (unless (zerop n-lines)
 264       (setq swiper--width (1+ (floor (log n-lines 10))))
 265       (setq swiper--format-spec
 266             (format "%%-%dd " swiper--width))
 267       (let ((line-number 0)
 268             (advancer (if swiper-use-visual-line
 269                           (lambda (arg) (line-move arg t))
 270                         #'forward-line))
 271             candidates)
 272         (save-excursion
 273           (goto-char (point-min))
 274           (swiper-font-lock-ensure)
 275           (while (< (point) (point-max))
 276             (let ((str (concat " " (buffer-substring
 277                                     (point)
 278                                     (if swiper-use-visual-line
 279                                         (save-excursion
 280                                           (end-of-visual-line)
 281                                           (point))
 282                                       (line-end-position))))))
 283               (put-text-property 0 1 'display
 284                                  (format swiper--format-spec
 285                                          (cl-incf line-number))
 286                                  str)
 287               (push str candidates))
 288             (funcall advancer 1))
 289           (nreverse candidates))))))
 290
 291 (defvar swiper--opoint 1
 292   "The point when `swiper' starts.")
 293
 294 ;;;###autoload
 295 (defun swiper (&optional initial-input)
 296   "`isearch' with an overview.
 297 When non-nil, INITIAL-INPUT is the initial search pattern."
 298   (interactive)
 299   (swiper--ivy initial-input))
 300
 301 (defvar swiper--anchor nil
 302   "A line number to which the search should be anchored.")
 303
 304 (defvar swiper--len 0
 305   "The last length of input for which an anchoring was made.")
 306
 307 (defun swiper--init ()
 308   "Perform initialization common to both completion methods."
 309   (setq swiper--opoint (point))
 310   (setq swiper--len 0)
 311   (setq swiper--anchor (line-number-at-pos)))
 312
 313 (defun swiper--re-builder (str)
 314   "Transform STR into a swiper regex.
 315 This is the regex used in the minibuffer, since the candidates
 316 there have line numbers. In the buffer, `ivy--regex' should be used."
 317   (cond
 318     ((equal str "")
 319      "")
 320     ((equal str "^")
 321      (setq ivy--subexps 0)
 322      ".")
 323     ((string-match "^\\^" str)
 324      (setq ivy--old-re "")
 325      (let ((re (ivy--regex-plus (substring str 1))))
 326        (if (zerop ivy--subexps)
 327            (prog1 (format "^ ?\\(%s\\)" re)
 328              (setq ivy--subexps 1))
 329          (format "^ %s" re))))
 330     (t
 331      (ivy--regex-plus str))))
 332
 333 (defvar swiper-history nil
 334   "History for `swiper'.")
 335
 336 (defun swiper--ivy (&optional initial-input)
 337   "`isearch' with an overview using `ivy'.
 338 When non-nil, INITIAL-INPUT is the initial search pattern."
 339   (interactive)
 340   (swiper--init)
 341   (let ((candidates (swiper--candidates))
 342         (preselect (buffer-substring-no-properties
 343                     (line-beginning-position)
 344                     (line-end-position)))
 345         (minibuffer-allow-text-properties t))
 346     (unwind-protect
 347         (ivy-read
 348          "Swiper: "
 349          candidates
 350          :initial-input initial-input
 351          :keymap swiper-map
 352          :preselect preselect
 353          :require-match t
 354          :update-fn #'swiper--update-input-ivy
 355          :unwind #'swiper--cleanup
 356          :action #'swiper--action
 357          :re-builder #'swiper--re-builder
 358          :history 'swiper-history
 359          :caller 'swiper)
 360       (when (null ivy-exit)
 361         (goto-char swiper--opoint)))))
 362
 363 (defun swiper--ensure-visible ()
 364   "Remove overlays hiding point."
 365   (let ((overlays (overlays-at (point)))
 366         ov expose)
 367     (while (setq ov (pop overlays))
 368       (if (and (invisible-p (overlay-get ov 'invisible))
 369                (setq expose (overlay-get ov 'isearch-open-invisible)))
 370           (funcall expose ov)))))
 371
 372 (defvar swiper--overlays nil
 373   "Store overlays.")
 374
 375 (defun swiper--cleanup ()
 376   "Clean up the overlays."
 377   (while swiper--overlays
 378     (delete-overlay (pop swiper--overlays)))
 379   (save-excursion
 380     (goto-char (point-min))
 381     (isearch-clean-overlays)))
 382
 383 (defun swiper--update-input-ivy ()
 384   "Called when `ivy' input is updated."
 385   (with-ivy-window
 386     (swiper--cleanup)
 387     (when (> (length ivy--current) 0)
 388       (let* ((re (funcall ivy--regex-function ivy-text))
 389              (re (if (stringp re) re (caar re)))
 390              (str (get-text-property 0 'display ivy--current))
 391              (num (if (string-match "^[0-9]+" str)
 392                       (string-to-number (match-string 0 str))
 393                     0)))
 394         (goto-char (point-min))
 395         (when (cl-plusp num)
 396           (goto-char (point-min))
 397           (if swiper-use-visual-line
 398               (line-move (1- num))
 399             (forward-line (1- num)))
 400           (if (and (equal ivy-text "")
 401                    (>= swiper--opoint (line-beginning-position))
 402                    (<= swiper--opoint (line-end-position)))
 403               (goto-char swiper--opoint)
 404             (re-search-forward re (line-end-position) t))
 405           (isearch-range-invisible (line-beginning-position)
 406                                    (line-end-position))
 407           (unless (and (>= (point) (window-start))
 408                        (<= (point) (window-end (ivy-state-window ivy-last) t)))
 409             (recenter)))
 410         (swiper--add-overlays re)))))
 411
 412 (defun swiper--add-overlays (re &optional beg end)
 413   "Add overlays for RE regexp in visible part of the current buffer.
 414 BEG and END, when specified, are the point bounds."
 415   (let ((ov (if visual-line-mode
 416                 (make-overlay
 417                  (save-excursion
 418                    (beginning-of-visual-line)
 419                    (point))
 420                  (save-excursion
 421                    (end-of-visual-line)
 422                    (point)))
 423               (make-overlay
 424                (line-beginning-position)
 425                (1+ (line-end-position))))))
 426     (overlay-put ov 'face 'swiper-line-face)
 427     (overlay-put ov 'window (ivy-state-window ivy-last))
 428     (push ov swiper--overlays)
 429     (let* ((wh (window-height))
 430            (beg (or beg (save-excursion
 431                           (forward-line (- wh))
 432                           (point))))
 433            (end (or end (save-excursion
 434                           (forward-line wh)
 435                           (point)))))
 436       (when (>= (length re) swiper-min-highlight)
 437         (save-excursion
 438           (goto-char beg)
 439           ;; RE can become an invalid regexp
 440           (while (and (ignore-errors (re-search-forward re end t))
 441                       (> (- (match-end 0) (match-beginning 0)) 0))
 442             (let ((i 0))
 443               (while (<= i ivy--subexps)
 444                 (when (match-beginning i)
 445                   (let ((overlay (make-overlay (match-beginning i)
 446                                                (match-end i)))
 447                         (face
 448                          (cond ((zerop ivy--subexps)
 449                                 (cadr swiper-faces))
 450                                ((zerop i)
 451                                 (car swiper-faces))
 452                                (t
 453                                 (nth (1+ (mod (+ i 2) (1- (length swiper-faces))))
 454                                      swiper-faces)))))
 455                     (push overlay swiper--overlays)
 456                     (overlay-put overlay 'face face)
 457                     (overlay-put overlay 'window (ivy-state-window ivy-last))
 458                     (overlay-put overlay 'priority i)))
 459                 (cl-incf i)))))))))
 460
 461 (defun swiper--action (x)
 462   "Goto line X."
 463   (if (null x)
 464       (user-error "No candidates")
 465     (goto-char (point-min))
 466     (funcall (if swiper-use-visual-line
 467                  #'line-move
 468                #'forward-line)
 469              (1- (read (get-text-property 0 'display x))))
 470     (re-search-forward
 471      (ivy--regex ivy-text) (line-end-position) t)
 472     (swiper--ensure-visible)
 473     (when (/= (point) swiper--opoint)
 474       (unless (and transient-mark-mode mark-active)
 475         (push-mark swiper--opoint t)
 476         (message "Mark saved where search started")))))
 477
 478 ;; (define-key isearch-mode-map (kbd "C-o") 'swiper-from-isearch)
 479 (defun swiper-from-isearch ()
 480   "Invoke `swiper' from isearch."
 481   (interactive)
 482   (let ((query (if isearch-regexp
 483                    isearch-string
 484                  (regexp-quote isearch-string))))
 485     (isearch-exit)
 486     (swiper query)))
 487
 488 (defvar swiper-multi-buffers nil
 489   "Store the current list of buffers.")
 490
 491 (defvar swiper-multi-candidates nil
 492   "Store the list of candidates for `swiper-multi'.")
 493
 494 (defun swiper-multi-prompt ()
 495   (format "Buffers (%s): "
 496           (mapconcat #'identity swiper-multi-buffers ", ")))
 497
 498 (defun swiper-multi ()
 499   "Select one or more buffers.
 500 Run `swiper' for those buffers."
 501   (interactive)
 502   (setq swiper-multi-buffers nil)
 503   (setq swiper-multi-candidates nil)
 504   (ivy-read (swiper-multi-prompt)
 505             'internal-complete-buffer
 506             :action 'swiper-multi-action-1)
 507   (ivy-read "Swiper: " swiper-multi-candidates
 508             :action 'swiper-multi-action-2
 509             :unwind #'swiper--cleanup
 510             :caller 'swiper-multi))
 511
 512 (defun swiper-multi-action-1 (x)
 513   (if (member x swiper-multi-buffers)
 514       (progn
 515         (setq swiper-multi-buffers (delete x swiper-multi-buffers)))
 516     (unless (equal x "")
 517       (setq swiper-multi-buffers (append swiper-multi-buffers (list x)))))
 518   (let ((prompt (swiper-multi-prompt)))
 519     (setf (ivy-state-prompt ivy-last) prompt)
 520     (setq ivy--prompt (concat "%-4d " prompt)))
 521   (cond ((memq this-command '(ivy-done
 522                               ivy-alt-done
 523                               ivy-immediate-done))
 524          (let ((ww (window-width)))
 525            (dolist (buf swiper-multi-buffers)
 526              (with-current-buffer buf
 527                (setq swiper-multi-candidates
 528                      (append
 529                       (mapcar
 530                        (lambda (s)
 531                          (setq s (concat s " "))
 532                          (let ((len (length s)))
 533                            (put-text-property
 534                             (1- len) len 'display
 535                             (concat
 536                              (make-string
 537                               (max
 538                                (- ww
 539                                   (string-width s)
 540                                   (length (buffer-name))
 541                                   1)
 542                                0)
 543                               ?\ )
 544                              (buffer-name))
 545                             s)
 546                            s))
 547                        (swiper--candidates))
 548                       swiper-multi-candidates))))))
 549         ((eq this-command 'ivy-call)
 550          (delete-minibuffer-contents))))
 551
 552 (defun swiper-multi-action-2 (x)
 553   (let ((buf-space (get-text-property (1- (length x)) 'display x)))
 554     (with-ivy-window
 555       (when (string-match "\\` *\\([^ ]+\\)\\'" buf-space)
 556         (switch-to-buffer (match-string 1 buf-space))
 557         (goto-char (point-min))
 558         (forward-line (1- (read x)))
 559         (re-search-forward
 560          (ivy--regex ivy-text)
 561          (line-end-position) t)
 562         (unless (eq ivy-exit 'done)
 563           (swiper--cleanup)
 564           (swiper--add-overlays (ivy--regex ivy-text)))))))
 565
 566 (provide 'swiper)
 567
 568 ;;; swiper.el ends here