code.delx.au - gnu-emacs-elpa/blob - packages/swiper/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.3.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 ;; The overview back end is `ivy'.
  33 ;;
  34 ;; It can double as a quick `regex-builder', although only single
  35 ;; lines will be matched.
  36
  37 ;;; Code:
  38 (require 'ivy)
  39
  40 (defgroup swiper nil
  41   "`isearch' with an overview."
  42   :group 'matching
  43   :prefix "swiper-")
  44
  45 (defface swiper-match-face-1
  46   '((t (:inherit isearch-lazy-highlight-face)))
  47   "The background face for `swiper' matches.")
  48
  49 (defface swiper-match-face-2
  50   '((t (:inherit isearch)))
  51   "Face for `swiper' matches modulo 1.")
  52
  53 (defface swiper-match-face-3
  54   '((t (:inherit match)))
  55   "Face for `swiper' matches modulo 2.")
  56
  57 (defface swiper-match-face-4
  58   '((t (:inherit isearch-fail)))
  59   "Face for `swiper' matches modulo 3.")
  60
  61 (defface swiper-line-face
  62   '((t (:inherit highlight)))
  63   "Face for current `swiper' line.")
  64
  65 (defcustom swiper-faces '(swiper-match-face-1
  66                           swiper-match-face-2
  67                           swiper-match-face-3
  68                           swiper-match-face-4)
  69   "List of `swiper' faces for group matches.")
  70
  71 (defcustom swiper-min-highlight 2
  72   "Only highlight matches for regexps at least this long."
  73   :type 'integer)
  74
  75 (defvar swiper-map
  76   (let ((map (make-sparse-keymap)))
  77     (define-key map (kbd "M-q") 'swiper-query-replace)
  78     (define-key map (kbd "C-l") 'swiper-recenter-top-bottom)
  79     map)
  80   "Keymap for swiper.")
  81
  82 (defun swiper-query-replace ()
  83   "Start `query-replace' with string to replace from last search string."
  84   (interactive)
  85   (if (null (window-minibuffer-p))
  86       (user-error "Should only be called in the minibuffer through `swiper-map'")
  87     (let* ((enable-recursive-minibuffers t)
  88            (from (ivy--regex ivy-text))
  89            (to (query-replace-read-to from "Query replace" t)))
  90       (delete-minibuffer-contents)
  91       (setq ivy--action
  92             (lambda ()
  93               (with-selected-window swiper--window
  94                 (perform-replace from to
  95                                  t t nil))))
  96       (swiper--cleanup)
  97       (exit-minibuffer))))
  98
  99 (defvar swiper--window nil
 100   "Store the current window.")
 101
 102 (defun swiper-recenter-top-bottom (&optional arg)
 103   "Call (`recenter-top-bottom' ARG) in `swiper--window'."
 104   (interactive "P")
 105   (with-selected-window swiper--window
 106     (recenter-top-bottom arg)))
 107
 108 (defun swiper-font-lock-ensure ()
 109   "Ensure the entired buffer is highlighted."
 110   (unless (or (derived-mode-p 'magit-mode)
 111               (memq major-mode '(package-menu-mode
 112                                  gnus-summary-mode
 113                                  gnus-article-mode
 114                                  gnus-group-mode
 115                                  emms-playlist-mode erc-mode
 116                                  org-agenda-mode
 117                                  dired-mode
 118                                  jabber-chat-mode
 119                                  elfeed-search-mode)))
 120     (unless (> (buffer-size) 100000)
 121       (if (fboundp 'font-lock-ensure)
 122           (font-lock-ensure)
 123         (with-no-warnings (font-lock-fontify-buffer))))))
 124
 125 (defvar swiper--format-spec ""
 126   "Store the current candidates format spec.")
 127
 128 (defun swiper--candidates ()
 129   "Return a list of this buffer lines."
 130   (let ((n-lines (count-lines (point-min) (point-max))))
 131     (unless (zerop n-lines)
 132       (setq swiper--format-spec
 133             (format "%%-%dd %%s" (1+ (floor (log n-lines 10)))))
 134       (let ((line-number 0)
 135             candidates)
 136         (save-excursion
 137           (goto-char (point-min))
 138           (swiper-font-lock-ensure)
 139           (while (< (point) (point-max))
 140             (push (format swiper--format-spec
 141                           (cl-incf line-number)
 142                           (buffer-substring
 143                            (line-beginning-position)
 144                            (line-end-position)))
 145                   candidates)
 146             (forward-line 1))
 147           (nreverse candidates))))))
 148
 149 (defvar swiper--opoint 1
 150   "The point when `swiper' starts.")
 151
 152 ;;;###autoload
 153 (defun swiper (&optional initial-input)
 154   "`isearch' with an overview.
 155 When non-nil, INITIAL-INPUT is the initial search pattern."
 156   (interactive)
 157   (swiper--ivy initial-input))
 158
 159 (defvar swiper--anchor nil
 160   "A line number to which the search should be anchored.")
 161
 162 (defvar swiper--len 0
 163   "The last length of input for which an anchoring was made.")
 164
 165 (defun swiper--init ()
 166   "Perform initialization common to both completion methods."
 167   (deactivate-mark)
 168   (setq swiper--opoint (point))
 169   (setq swiper--len 0)
 170   (setq swiper--anchor (line-number-at-pos))
 171   (setq swiper--window (selected-window)))
 172
 173 (defun swiper--ivy (&optional initial-input)
 174   "`isearch' with an overview using `ivy'.
 175 When non-nil, INITIAL-INPUT is the initial search pattern."
 176   (interactive)
 177   (unless (eq (length (help-function-arglist 'ivy-read)) 4)
 178     (warn "You seem to be using the outdated stand-alone \"ivy\" package.
 179 Please remove it and update the \"swiper\" package."))
 180   (swiper--init)
 181   (let ((candidates (swiper--candidates))
 182         (preselect (format
 183                     swiper--format-spec
 184                     (line-number-at-pos)
 185                     (regexp-quote
 186                      (buffer-substring-no-properties
 187                       (line-beginning-position)
 188                       (line-end-position)))))
 189         res)
 190     (unwind-protect
 191          (setq res (ivy-read
 192                     (replace-regexp-in-string
 193                      "%s" "pattern: " swiper--format-spec)
 194                     candidates
 195                     :initial-input initial-input
 196                     :keymap swiper-map
 197                     :preselect preselect
 198                     :require-match t
 199                     :update-fn #'swiper--update-input-ivy))
 200       (swiper--cleanup)
 201       (if (null ivy-exit)
 202           (goto-char swiper--opoint)
 203         (swiper--action res ivy-text)))))
 204
 205 (defun swiper--ensure-visible ()
 206   "Remove overlays hiding point."
 207   (let ((overlays (overlays-at (point)))
 208         ov expose)
 209     (while (setq ov (pop overlays))
 210       (if (and (invisible-p (overlay-get ov 'invisible))
 211                (setq expose (overlay-get ov 'isearch-open-invisible)))
 212           (funcall expose ov)))))
 213
 214 (defvar swiper--overlays nil
 215   "Store overlays.")
 216
 217 (defun swiper--cleanup ()
 218   "Clean up the overlays."
 219   (while swiper--overlays
 220     (delete-overlay (pop swiper--overlays)))
 221   (save-excursion
 222     (goto-char (point-min))
 223     (isearch-clean-overlays)))
 224
 225 (defun swiper--update-input-ivy ()
 226   "Called when `ivy' input is updated."
 227   (swiper--cleanup)
 228   (let* ((re (ivy--regex ivy-text))
 229          (str ivy--current)
 230          (num (if (string-match "^[0-9]+" str)
 231                   (string-to-number (match-string 0 str))
 232                 0)))
 233     (with-selected-window swiper--window
 234       (goto-char (point-min))
 235       (when (cl-plusp num)
 236         (goto-char (point-min))
 237         (forward-line (1- num))
 238         (isearch-range-invisible (line-beginning-position)
 239                                  (line-end-position))
 240         (unless (and (>= (point) (window-start))
 241                      (<= (point) (window-end swiper--window t)))
 242           (recenter)))
 243       (swiper--add-overlays re))))
 244
 245 (defun swiper--add-overlays (re &optional beg end)
 246   "Add overlays for RE regexp in visible part of the current buffer.
 247 BEG and END, when specified, are the point bounds."
 248   (let ((ov (make-overlay
 249              (line-beginning-position)
 250              (1+ (line-end-position)))))
 251     (overlay-put ov 'face 'swiper-line-face)
 252     (overlay-put ov 'window swiper--window)
 253     (push ov swiper--overlays))
 254   (let* ((wh (window-height))
 255          (beg (or beg (save-excursion
 256                         (forward-line (- wh))
 257                         (point))))
 258          (end (or end (save-excursion
 259                         (forward-line wh)
 260                         (point)))))
 261     (when (>= (length re) swiper-min-highlight)
 262       (save-excursion
 263         (goto-char beg)
 264         ;; RE can become an invalid regexp
 265         (while (and (ignore-errors (re-search-forward re end t))
 266                     (> (- (match-end 0) (match-beginning 0)) 0))
 267           (let ((i 0))
 268             (while (<= i ivy--subexps)
 269               (when (match-beginning i)
 270                 (let ((overlay (make-overlay (match-beginning i)
 271                                              (match-end i)))
 272                       (face
 273                        (cond ((zerop ivy--subexps)
 274                               (cadr swiper-faces))
 275                              ((zerop i)
 276                               (car swiper-faces))
 277                              (t
 278                               (nth (1+ (mod (+ i 2) (1- (length swiper-faces))))
 279                                    swiper-faces)))))
 280                   (push overlay swiper--overlays)
 281                   (overlay-put overlay 'face face)
 282                   (overlay-put overlay 'window swiper--window)
 283                   (overlay-put overlay 'priority i)))
 284               (cl-incf i))))))))
 285
 286 (defun swiper--action (x input)
 287   "Goto line X and search for INPUT."
 288   (if (null x)
 289       (user-error "No candidates")
 290     (goto-char (point-min))
 291     (forward-line (1- (read x)))
 292     (re-search-forward
 293      (ivy--regex input) (line-end-position) t)
 294     (swiper--ensure-visible)
 295     (when (/= (point) swiper--opoint)
 296       (unless (and transient-mark-mode mark-active)
 297         (push-mark swiper--opoint t)
 298         (message "Mark saved where search started")))))
 299
 300 (provide 'swiper)
 301
 302 ;;; swiper.el ends here