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        (if (zerop ivy--subexps)
 324            (prog1 (format "^ ?\\(%s\\)" re)
 325              (setq ivy--subexps 1))
 326          (format "^ %s" re))))
 327     (t
 328      (ivy--regex-plus str))))
 329
 330 (defvar swiper-history nil
 331   "History for `swiper'.")
 332
 333 (defun swiper--ivy (&optional initial-input)
 334   "`isearch' with an overview using `ivy'.
 335 When non-nil, INITIAL-INPUT is the initial search pattern."
 336   (interactive)
 337   (swiper--init)
 338   (let ((candidates (swiper--candidates))
 339         (preselect (buffer-substring-no-properties
 340                     (line-beginning-position)
 341                     (line-end-position)))
 342         (minibuffer-allow-text-properties t))
 343     (unwind-protect
 344         (ivy-read
 345          "Swiper: "
 346          candidates
 347          :initial-input initial-input
 348          :keymap swiper-map
 349          :preselect preselect
 350          :require-match t
 351          :update-fn #'swiper--update-input-ivy
 352          :unwind #'swiper--cleanup
 353          :action #'swiper--action
 354          :re-builder #'swiper--re-builder
 355          :history 'swiper-history
 356          :caller 'swiper)
 357       (when (null ivy-exit)
 358         (goto-char swiper--opoint)))))
 359
 360 (defun swiper--ensure-visible ()
 361   "Remove overlays hiding point."
 362   (let ((overlays (overlays-at (point)))
 363         ov expose)
 364     (while (setq ov (pop overlays))
 365       (if (and (invisible-p (overlay-get ov 'invisible))
 366                (setq expose (overlay-get ov 'isearch-open-invisible)))
 367           (funcall expose ov)))))
 368
 369 (defvar swiper--overlays nil
 370   "Store overlays.")
 371
 372 (defun swiper--cleanup ()
 373   "Clean up the overlays."
 374   (while swiper--overlays
 375     (delete-overlay (pop swiper--overlays)))
 376   (save-excursion
 377     (goto-char (point-min))
 378     (isearch-clean-overlays)))
 379
 380 (defun swiper--update-input-ivy ()
 381   "Called when `ivy' input is updated."
 382   (with-ivy-window
 383     (swiper--cleanup)
 384     (when (> (length ivy--current) 0)
 385       (let* ((re (funcall ivy--regex-function ivy-text))
 386              (re (if (stringp re) re (caar re)))
 387              (str (get-text-property 0 'display ivy--current))
 388              (num (if (string-match "^[0-9]+" str)
 389                       (string-to-number (match-string 0 str))
 390                     0)))
 391         (goto-char (point-min))
 392         (when (cl-plusp num)
 393           (goto-char (point-min))
 394           (if swiper-use-visual-line
 395               (line-move (1- num))
 396             (forward-line (1- num)))
 397           (if (and (equal ivy-text "")
 398                    (>= swiper--opoint (line-beginning-position))
 399                    (<= swiper--opoint (line-end-position)))
 400               (goto-char swiper--opoint)
 401             (re-search-forward re (line-end-position) t))
 402           (isearch-range-invisible (line-beginning-position)
 403                                    (line-end-position))
 404           (unless (and (>= (point) (window-start))
 405                        (<= (point) (window-end (ivy-state-window ivy-last) t)))
 406             (recenter)))
 407         (swiper--add-overlays re)))))
 408
 409 (defun swiper--add-overlays (re &optional beg end)
 410   "Add overlays for RE regexp in visible part of the current buffer.
 411 BEG and END, when specified, are the point bounds."
 412   (let ((ov (if visual-line-mode
 413                 (make-overlay
 414                  (save-excursion
 415                    (beginning-of-visual-line)
 416                    (point))
 417                  (save-excursion
 418                    (end-of-visual-line)
 419                    (point)))
 420               (make-overlay
 421                (line-beginning-position)
 422                (1+ (line-end-position))))))
 423     (overlay-put ov 'face 'swiper-line-face)
 424     (overlay-put ov 'window (ivy-state-window ivy-last))
 425     (push ov swiper--overlays)
 426     (let* ((wh (window-height))
 427            (beg (or beg (save-excursion
 428                           (forward-line (- wh))
 429                           (point))))
 430            (end (or end (save-excursion
 431                           (forward-line wh)
 432                           (point)))))
 433       (when (>= (length re) swiper-min-highlight)
 434         (save-excursion
 435           (goto-char beg)
 436           ;; RE can become an invalid regexp
 437           (while (and (ignore-errors (re-search-forward re end t))
 438                       (> (- (match-end 0) (match-beginning 0)) 0))
 439             (let ((i 0))
 440               (while (<= i ivy--subexps)
 441                 (when (match-beginning i)
 442                   (let ((overlay (make-overlay (match-beginning i)
 443                                                (match-end i)))
 444                         (face
 445                          (cond ((zerop ivy--subexps)
 446                                 (cadr swiper-faces))
 447                                ((zerop i)
 448                                 (car swiper-faces))
 449                                (t
 450                                 (nth (1+ (mod (+ i 2) (1- (length swiper-faces))))
 451                                      swiper-faces)))))
 452                     (push overlay swiper--overlays)
 453                     (overlay-put overlay 'face face)
 454                     (overlay-put overlay 'window (ivy-state-window ivy-last))
 455                     (overlay-put overlay 'priority i)))
 456                 (cl-incf i)))))))))
 457
 458 (defun swiper--action (x)
 459   "Goto line X."
 460   (if (null x)
 461       (user-error "No candidates")
 462     (goto-char (point-min))
 463     (funcall (if swiper-use-visual-line
 464                  #'line-move
 465                #'forward-line)
 466              (1- (read (get-text-property 0 'display x))))
 467     (re-search-forward
 468      (ivy--regex ivy-text) (line-end-position) t)
 469     (swiper--ensure-visible)
 470     (when (/= (point) swiper--opoint)
 471       (unless (and transient-mark-mode mark-active)
 472         (push-mark swiper--opoint t)
 473         (message "Mark saved where search started")))))
 474
 475 ;; (define-key isearch-mode-map (kbd "C-o") 'swiper-from-isearch)
 476 (defun swiper-from-isearch ()
 477   "Invoke `swiper' from isearch."
 478   (interactive)
 479   (let ((query (if isearch-regexp
 480                    isearch-string
 481                  (regexp-quote isearch-string))))
 482     (isearch-exit)
 483     (swiper query)))
 484
 485 (defvar swiper-multi-buffers nil
 486   "Store the current list of buffers.")
 487
 488 (defvar swiper-multi-candidates nil
 489   "Store the list of candidates for `swiper-multi'.")
 490
 491 (defun swiper-multi-prompt ()
 492   (format "Buffers (%s): "
 493           (mapconcat #'identity swiper-multi-buffers ", ")))
 494
 495 (defun swiper-multi ()
 496   "Select one or more buffers.
 497 Run `swiper' for those buffers."
 498   (interactive)
 499   (setq swiper-multi-buffers nil)
 500   (setq swiper-multi-candidates nil)
 501   (ivy-read (swiper-multi-prompt)
 502             'internal-complete-buffer
 503             :action 'swiper-multi-action-1)
 504   (ivy-read "Swiper: " swiper-multi-candidates
 505             :action 'swiper-multi-action-2
 506             :unwind #'swiper--cleanup
 507             :caller 'swiper-multi))
 508
 509 (defun swiper-multi-action-1 (x)
 510   (if (member x swiper-multi-buffers)
 511       (progn
 512         (setq swiper-multi-buffers (delete x swiper-multi-buffers)))
 513     (unless (equal x "")
 514       (setq swiper-multi-buffers (append swiper-multi-buffers (list x)))))
 515   (let ((prompt (swiper-multi-prompt)))
 516     (setf (ivy-state-prompt ivy-last) prompt)
 517     (setq ivy--prompt (concat "%-4d " prompt)))
 518   (cond ((memq this-command '(ivy-done
 519                               ivy-alt-done
 520                               ivy-immediate-done))
 521          (let ((ww (window-width)))
 522            (dolist (buf swiper-multi-buffers)
 523              (with-current-buffer buf
 524                (setq swiper-multi-candidates
 525                      (append
 526                       (mapcar
 527                        (lambda (s)
 528                          (setq s (concat s " "))
 529                          (let ((len (length s)))
 530                            (put-text-property
 531                             (1- len) len 'display
 532                             (concat
 533                              (make-string
 534                               (max
 535                                (- ww
 536                                   (string-width s)
 537                                   (length (buffer-name))
 538                                   1)
 539                                0)
 540                               ?\ )
 541                              (buffer-name))
 542                             s)
 543                            s))
 544                        (swiper--candidates))
 545                       swiper-multi-candidates))))))
 546         ((eq this-command 'ivy-call)
 547          (delete-minibuffer-contents))))
 548
 549 (defun swiper-multi-action-2 (x)
 550   (let ((buf-space (get-text-property (1- (length x)) 'display x)))
 551     (with-ivy-window
 552       (when (string-match "\\` *\\([^ ]+\\)\\'" buf-space)
 553         (switch-to-buffer (match-string 1 buf-space))
 554         (goto-char (point-min))
 555         (forward-line (1- (read x)))
 556         (re-search-forward
 557          (ivy--regex ivy-text)
 558          (line-end-position) t)
 559         (unless (eq ivy-exit 'done)
 560           (swiper--cleanup)
 561           (swiper--add-overlays (ivy--regex ivy-text)))))))
 562
 563 (provide 'swiper)
 564
 565 ;;; swiper.el ends here