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                                  fundamental-mode
 235                                  Man-mode
 236                                  woman-mode
 237                                  mu4e-view-mode
 238                                  mu4e-headers-mode
 239                                  help-mode)))
 240     (unless (> (buffer-size) 100000)
 241       (if (fboundp 'font-lock-ensure)
 242           (font-lock-ensure)
 243         (with-no-warnings (font-lock-fontify-buffer))))))
 244
 245 (defvar swiper--format-spec ""
 246   "Store the current candidates format spec.")
 247
 248 (defvar swiper--width nil
 249   "Store the amount of digits needed for the longest line nubmer.")
 250
 251 (defvar swiper-use-visual-line nil
 252   "When non-nil, use `line-move' instead of `forward-line'.")
 253
 254 (defun swiper--candidates ()
 255   "Return a list of this buffer lines."
 256   (setq swiper-use-visual-line
 257         (and (not (eq major-mode 'org-mode))
 258              visual-line-mode
 259              (< (buffer-size) 20000)))
 260   (let ((n-lines (count-lines (point-min) (point-max))))
 261     (unless (zerop n-lines)
 262       (setq swiper--width (1+ (floor (log n-lines 10))))
 263       (setq swiper--format-spec
 264             (format "%%-%dd " swiper--width))
 265       (let ((line-number 0)
 266             (advancer (if swiper-use-visual-line
 267                           (lambda (arg) (line-move arg t))
 268                         #'forward-line))
 269             candidates)
 270         (save-excursion
 271           (goto-char (point-min))
 272           (swiper-font-lock-ensure)
 273           (while (< (point) (point-max))
 274             (let ((str (concat " " (buffer-substring
 275                                     (point)
 276                                     (if swiper-use-visual-line
 277                                         (save-excursion
 278                                           (end-of-visual-line)
 279                                           (point))
 280                                       (line-end-position))))))
 281               (put-text-property 0 1 'display
 282                                  (format swiper--format-spec
 283                                          (cl-incf line-number))
 284                                  str)
 285               (push str candidates))
 286             (funcall advancer 1))
 287           (nreverse candidates))))))
 288
 289 (defvar swiper--opoint 1
 290   "The point when `swiper' starts.")
 291
 292 ;;;###autoload
 293 (defun swiper (&optional initial-input)
 294   "`isearch' with an overview.
 295 When non-nil, INITIAL-INPUT is the initial search pattern."
 296   (interactive)
 297   (swiper--ivy initial-input))
 298
 299 (defvar swiper--anchor nil
 300   "A line number to which the search should be anchored.")
 301
 302 (defvar swiper--len 0
 303   "The last length of input for which an anchoring was made.")
 304
 305 (defun swiper--init ()
 306   "Perform initialization common to both completion methods."
 307   (setq swiper--opoint (point))
 308   (setq swiper--len 0)
 309   (setq swiper--anchor (line-number-at-pos)))
 310
 311 (defun swiper--re-builder (str)
 312   "Transform STR into a swiper regex.
 313 This is the regex used in the minibuffer, since the candidates
 314 there have line numbers. In the buffer, `ivy--regex' should be used."
 315   (cond
 316     ((equal str "")
 317      "")
 318     ((equal str "^")
 319      ".")
 320     ((string-match "^\\^" str)
 321      (setq ivy--old-re "")
 322      (let ((re (ivy--regex-plus (substring str 1))))
 323        (format "^[0-9][0-9 ]\\{%d\\}%s"
 324                swiper--width
 325                (if (zerop ivy--subexps)
 326                    (prog1 (format "\\(%s\\)" re)
 327                      (setq ivy--subexps 1))
 328                  re))))
 329     (t
 330      (ivy--regex-plus str))))
 331
 332 (defvar swiper-history nil
 333   "History for `swiper'.")
 334
 335 (defun swiper--ivy (&optional initial-input)
 336   "`isearch' with an overview using `ivy'.
 337 When non-nil, INITIAL-INPUT is the initial search pattern."
 338   (interactive)
 339   (swiper--init)
 340   (let ((candidates (swiper--candidates))
 341         (preselect (buffer-substring-no-properties
 342                     (line-beginning-position)
 343                     (line-end-position)))
 344         (minibuffer-allow-text-properties t))
 345     (unwind-protect
 346         (ivy-read
 347          "Swiper: "
 348          candidates
 349          :initial-input initial-input
 350          :keymap swiper-map
 351          :preselect preselect
 352          :require-match t
 353          :update-fn #'swiper--update-input-ivy
 354          :unwind #'swiper--cleanup
 355          :action #'swiper--action
 356          :re-builder #'swiper--re-builder
 357          :history 'swiper-history
 358          :caller 'swiper)
 359       (when (null ivy-exit)
 360         (goto-char swiper--opoint)))))
 361
 362 (defun swiper--ensure-visible ()
 363   "Remove overlays hiding point."
 364   (let ((overlays (overlays-at (point)))
 365         ov expose)
 366     (while (setq ov (pop overlays))
 367       (if (and (invisible-p (overlay-get ov 'invisible))
 368                (setq expose (overlay-get ov 'isearch-open-invisible)))
 369           (funcall expose ov)))))
 370
 371 (defvar swiper--overlays nil
 372   "Store overlays.")
 373
 374 (defun swiper--cleanup ()
 375   "Clean up the overlays."
 376   (while swiper--overlays
 377     (delete-overlay (pop swiper--overlays)))
 378   (save-excursion
 379     (goto-char (point-min))
 380     (isearch-clean-overlays)))
 381
 382 (defun swiper--update-input-ivy ()
 383   "Called when `ivy' input is updated."
 384   (with-ivy-window
 385     (swiper--cleanup)
 386     (when (> (length ivy--current) 0)
 387       (let* ((re (funcall ivy--regex-function ivy-text))
 388              (re (if (stringp re) re (caar re)))
 389              (str (get-text-property 0 'display ivy--current))
 390              (num (if (string-match "^[0-9]+" str)
 391                       (string-to-number (match-string 0 str))
 392                     0)))
 393         (goto-char (point-min))
 394         (when (cl-plusp num)
 395           (goto-char (point-min))
 396           (if swiper-use-visual-line
 397               (line-move (1- num))
 398             (forward-line (1- num)))
 399           (if (and (equal ivy-text "")
 400                    (>= swiper--opoint (line-beginning-position))
 401                    (<= swiper--opoint (line-end-position)))
 402               (goto-char swiper--opoint)
 403             (re-search-forward re (line-end-position) t))
 404           (isearch-range-invisible (line-beginning-position)
 405                                    (line-end-position))
 406           (unless (and (>= (point) (window-start))
 407                        (<= (point) (window-end (ivy-state-window ivy-last) t)))
 408             (recenter)))
 409         (swiper--add-overlays re)))))
 410
 411 (defun swiper--add-overlays (re &optional beg end)
 412   "Add overlays for RE regexp in visible part of the current buffer.
 413 BEG and END, when specified, are the point bounds."
 414   (let ((ov (if visual-line-mode
 415                 (make-overlay
 416                  (save-excursion
 417                    (beginning-of-visual-line)
 418                    (point))
 419                  (save-excursion
 420                    (end-of-visual-line)
 421                    (point)))
 422               (make-overlay
 423                (line-beginning-position)
 424                (1+ (line-end-position))))))
 425     (overlay-put ov 'face 'swiper-line-face)
 426     (overlay-put ov 'window (ivy-state-window ivy-last))
 427     (push ov swiper--overlays)
 428     (let* ((wh (window-height))
 429            (beg (or beg (save-excursion
 430                           (forward-line (- wh))
 431                           (point))))
 432            (end (or end (save-excursion
 433                           (forward-line wh)
 434                           (point)))))
 435       (when (>= (length re) swiper-min-highlight)
 436         (save-excursion
 437           (goto-char beg)
 438           ;; RE can become an invalid regexp
 439           (while (and (ignore-errors (re-search-forward re end t))
 440                       (> (- (match-end 0) (match-beginning 0)) 0))
 441             (let ((i 0))
 442               (while (<= i ivy--subexps)
 443                 (when (match-beginning i)
 444                   (let ((overlay (make-overlay (match-beginning i)
 445                                                (match-end i)))
 446                         (face
 447                          (cond ((zerop ivy--subexps)
 448                                 (cadr swiper-faces))
 449                                ((zerop i)
 450                                 (car swiper-faces))
 451                                (t
 452                                 (nth (1+ (mod (+ i 2) (1- (length swiper-faces))))
 453                                      swiper-faces)))))
 454                     (push overlay swiper--overlays)
 455                     (overlay-put overlay 'face face)
 456                     (overlay-put overlay 'window (ivy-state-window ivy-last))
 457                     (overlay-put overlay 'priority i)))
 458                 (cl-incf i)))))))))
 459
 460 (defun swiper--action (x)
 461   "Goto line X."
 462   (if (null x)
 463       (user-error "No candidates")
 464     (goto-char (point-min))
 465     (funcall (if swiper-use-visual-line
 466                  #'line-move
 467                #'forward-line)
 468              (1- (read (get-text-property 0 'display x))))
 469     (re-search-forward
 470      (ivy--regex ivy-text) (line-end-position) t)
 471     (swiper--ensure-visible)
 472     (when (/= (point) swiper--opoint)
 473       (unless (and transient-mark-mode mark-active)
 474         (push-mark swiper--opoint t)
 475         (message "Mark saved where search started")))))
 476
 477 ;; (define-key isearch-mode-map (kbd "C-o") 'swiper-from-isearch)
 478 (defun swiper-from-isearch ()
 479   "Invoke `swiper' from isearch."
 480   (interactive)
 481   (let ((query (if isearch-regexp
 482                    isearch-string
 483                  (regexp-quote isearch-string))))
 484     (isearch-exit)
 485     (swiper query)))
 486
 487 (defvar swiper-multi-buffers nil
 488   "Store the current list of buffers.")
 489
 490 (defvar swiper-multi-candidates nil
 491   "Store the list of candidates for `swiper-multi'.")
 492
 493 (defun swiper-multi-prompt ()
 494   (format "Buffers (%s): "
 495           (mapconcat #'identity swiper-multi-buffers ", ")))
 496
 497 (defun swiper-multi ()
 498   "Select one or more buffers.
 499 Run `swiper' for those buffers."
 500   (interactive)
 501   (setq swiper-multi-buffers nil)
 502   (setq swiper-multi-candidates nil)
 503   (ivy-read (swiper-multi-prompt)
 504             'internal-complete-buffer
 505             :action 'swiper-multi-action-1)
 506   (ivy-read "Swiper: " swiper-multi-candidates
 507             :action 'swiper-multi-action-2
 508             :unwind #'swiper--cleanup
 509             :caller 'swiper-multi))
 510
 511 (defun swiper-multi-action-1 (x)
 512   (if (member x swiper-multi-buffers)
 513       (progn
 514         (setq swiper-multi-buffers (delete x swiper-multi-buffers)))
 515     (unless (equal x "")
 516       (setq swiper-multi-buffers (append swiper-multi-buffers (list x)))))
 517   (let ((prompt (swiper-multi-prompt)))
 518     (setf (ivy-state-prompt ivy-last) prompt)
 519     (setq ivy--prompt (concat "%-4d " prompt)))
 520   (cond ((memq this-command '(ivy-done
 521                               ivy-alt-done
 522                               ivy-immediate-done))
 523          (let ((ww (window-width)))
 524            (dolist (buf swiper-multi-buffers)
 525              (with-current-buffer buf
 526                (setq swiper-multi-candidates
 527                      (append
 528                       (mapcar
 529                        (lambda (s)
 530                          (setq s (concat s " "))
 531                          (let ((len (length s)))
 532                            (put-text-property
 533                             (1- len) len 'display
 534                             (concat
 535                              (make-string
 536                               (max
 537                                (- ww
 538                                   (string-width s)
 539                                   (length (buffer-name))
 540                                   1)
 541                                0)
 542                               ?\ )
 543                              (buffer-name))
 544                             s)
 545                            s))
 546                        (swiper--candidates))
 547                       swiper-multi-candidates))))))
 548         ((eq this-command 'ivy-call)
 549          (delete-minibuffer-contents))))
 550
 551 (defun swiper-multi-action-2 (x)
 552   (let ((buf-space (get-text-property (1- (length x)) 'display x)))
 553     (with-ivy-window
 554       (when (string-match "\\` *\\([^ ]+\\)\\'" buf-space)
 555         (switch-to-buffer (match-string 1 buf-space))
 556         (goto-char (point-min))
 557         (forward-line (1- (read x)))
 558         (re-search-forward
 559          (ivy--regex ivy-text)
 560          (line-end-position) t)
 561         (unless (eq ivy-exit 'done)
 562           (swiper--cleanup)
 563           (swiper--add-overlays (ivy--regex ivy-text)))))))
 564
 565 (provide 'swiper)
 566
 567 ;;; swiper.el ends here