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.1.0
   8 ;; Package-Requires: ((emacs "24.1") (ivy "0.1.0"))
   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   "Face for `swiper' matches.")
  48
  49 (defface swiper-match-face-2
  50   '((t (:inherit isearch)))
  51   "Face for `swiper' matches.")
  52
  53 (defface swiper-match-face-3
  54   '((t (:inherit match)))
  55   "Face for `swiper' matches.")
  56
  57 (defface swiper-match-face-4
  58   '((t (:inherit isearch)))
  59   "Face for `swiper' matches.")
  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--window nil
  76   "Store the current window.")
  77
  78 (defun swiper-font-lock-ensure ()
  79   "Ensure the entired buffer is highlighted."
  80   (unless (or (derived-mode-p 'magit-mode)
  81               (memq major-mode '(package-menu-mode emms-playlist-mode)))
  82     (if (fboundp 'font-lock-ensure)
  83         (font-lock-ensure)
  84       (font-lock-fontify-buffer))))
  85
  86 (defvar swiper--format-spec ""
  87   "Store the current candidates format spec.")
  88
  89 (defun swiper--candidates ()
  90   "Return a list of this buffer lines."
  91   (let ((n-lines (count-lines (point-min) (point-max))))
  92     (unless (zerop n-lines)
  93       (setq swiper--format-spec
  94             (format "%%-%dd %%s" (1+ (floor (log n-lines 10)))))
  95       (let ((line-number 0)
  96             candidates)
  97         (save-excursion
  98           (goto-char (point-min))
  99           (swiper-font-lock-ensure)
 100           (while (< (point) (point-max))
 101             (push (format swiper--format-spec
 102                           (cl-incf line-number)
 103                           (buffer-substring
 104                            (line-beginning-position)
 105                            (line-end-position)))
 106                   candidates)
 107             (zerop (forward-line 1)))
 108           (nreverse candidates))))))
 109
 110 (defvar swiper--opoint 1
 111   "The point when `swiper' starts.")
 112
 113 ;;;###autoload
 114 (defun swiper (&optional initial-input)
 115   "`isearch' with an overview.
 116 When non-nil, INITIAL-INPUT is the initial search pattern."
 117   (interactive)
 118   (swiper--ivy initial-input))
 119
 120 (defun swiper--init ()
 121   "Perform initialization common to both completion methods."
 122   (deactivate-mark)
 123   (setq swiper--opoint (point))
 124   (setq swiper--len 0)
 125   (setq swiper--anchor (line-number-at-pos))
 126   (setq swiper--window (selected-window)))
 127
 128 (defun swiper--ivy (&optional initial-input)
 129   "`isearch' with an overview using `ivy'.
 130 When non-nil, INITIAL-INPUT is the initial search pattern."
 131   (interactive)
 132   (ido-mode -1)
 133   (swiper--init)
 134   (let ((candidates (swiper--candidates))
 135         (preselect (format
 136                     swiper--format-spec
 137                     (line-number-at-pos)
 138                     (regexp-quote
 139                      (buffer-substring-no-properties
 140                       (line-beginning-position)
 141                       (line-end-position)))))
 142         res)
 143     (unwind-protect
 144          (setq res (ivy-read
 145                     (replace-regexp-in-string
 146                      "%s" "pattern: " swiper--format-spec)
 147                     candidates
 148                     initial-input
 149                     #'swiper--update-input-ivy
 150                     preselect))
 151       (ido-mode 1)
 152       (swiper--cleanup)
 153       (if (null ivy-exit)
 154           (goto-char swiper--opoint)
 155         (swiper--action res ivy-text)))))
 156
 157 (defun swiper--ensure-visible ()
 158   "Remove overlays hiding point."
 159   (let ((overlays (overlays-at (point)))
 160         ov expose)
 161     (while (setq ov (pop overlays))
 162       (if (and (invisible-p (overlay-get ov 'invisible))
 163                (setq expose (overlay-get ov 'isearch-open-invisible)))
 164           (funcall expose ov)))))
 165
 166 (defun swiper--cleanup ()
 167   "Clean up the overlays."
 168   (while swiper--overlays
 169     (delete-overlay (pop swiper--overlays)))
 170   (save-excursion
 171     (goto-char (point-min))
 172     (isearch-clean-overlays)))
 173
 174 (defvar swiper--overlays nil
 175   "Store overlays.")
 176
 177 (defvar swiper--anchor nil
 178   "A line number to which the search should be anchored.")
 179
 180 (defvar swiper--len 0
 181   "The last length of input for which an anchoring was made.")
 182
 183 (defun swiper--update-input-ivy ()
 184   "Called when `ivy' input is updated."
 185   (swiper--cleanup)
 186   (let* ((re (ivy--regex ivy-text))
 187          (str ivy--current)
 188          (num (if (string-match "^[0-9]+" str)
 189                   (string-to-number (match-string 0 str))
 190                 0)))
 191     (with-selected-window swiper--window
 192       (goto-char (point-min))
 193       (when (cl-plusp num)
 194         (goto-char (point-min))
 195         (forward-line (1- num))
 196         (isearch-range-invisible (line-beginning-position)
 197                                  (line-end-position))
 198         (unless (and (> (point) (window-start))
 199                      (< (point) (window-end swiper--window t)))
 200           (recenter)))
 201       (let ((ov (make-overlay
 202                  (line-beginning-position)
 203                  (1+ (line-end-position)))))
 204         (overlay-put ov 'face 'swiper-line-face)
 205         (overlay-put ov 'window swiper--window)
 206         (push ov swiper--overlays))
 207       (swiper--add-overlays
 208        re
 209        (window-start swiper--window)
 210        (window-end swiper--window t)))))
 211
 212 (defun swiper--add-overlays (re beg end)
 213   "Add overlays for RE regexp in current buffer between BEG and END."
 214   (when (>= (length re) swiper-min-highlight)
 215     (save-excursion
 216       (goto-char beg)
 217       ;; RE can become an invalid regexp
 218       (while (and (ignore-errors (re-search-forward re end t))
 219                   (> (- (match-end 0) (match-beginning 0)) 0))
 220         (let ((i 0))
 221           (while (<= i ivy--subexps)
 222             (when (match-beginning i)
 223               (let ((overlay (make-overlay (match-beginning i)
 224                                            (match-end i)))
 225                     (face
 226                      (cond ((zerop ivy--subexps)
 227                             (cl-caddr swiper-faces))
 228                            ((zerop i)
 229                             (car swiper-faces))
 230                            (t
 231                             (nth (1+ (mod (1- i) (1- (length swiper-faces))))
 232                                  swiper-faces)))))
 233                 (push overlay swiper--overlays)
 234                 (overlay-put overlay 'face face)
 235                 (overlay-put overlay 'window swiper--window)
 236                 (overlay-put overlay 'priority i)))
 237             (cl-incf i)))))))
 238
 239 (defun swiper--action (x input)
 240   "Goto line X and search for INPUT."
 241   (if (null x)
 242       (user-error "No candidates")
 243     (goto-char (point-min))
 244     (forward-line (1- (read x)))
 245     (re-search-forward
 246      (ivy--regex input) (line-end-position) t)
 247     (swiper--ensure-visible)
 248     (when (/= (point) swiper--opoint)
 249       (unless (and transient-mark-mode mark-active)
 250         (push-mark swiper--opoint t)
 251         (message "Mark saved where search started")))))
 252
 253 (provide 'swiper)
 254
 255 ;;; swiper.el ends here