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 Oleh Krehel
   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 not 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 can be either `helm' or `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 (defcustom swiper-completion-method 'ivy
  46   "Method to select a candidate from a list of strings."
  47   :type '(choice
  48           (const :tag "Helm" helm)
  49           (const :tag "Ivy" ivy)))
  50
  51 (defface swiper-match-face-1
  52   '((t (:inherit isearch-lazy-highlight-face)))
  53   "Face for `swiper' matches.")
  54
  55 (defface swiper-match-face-2
  56   '((t (:inherit isearch)))
  57   "Face for `swiper' matches.")
  58
  59 (defface swiper-match-face-3
  60   '((t (:inherit match)))
  61   "Face for `swiper' matches.")
  62
  63 (defface swiper-match-face-4
  64   '((t (:inherit isearch)))
  65   "Face for `swiper' matches.")
  66
  67 (defface swiper-line-face
  68   '((t (:inherit highlight)))
  69   "Face for current `swiper' line.")
  70
  71 (defcustom swiper-faces '(swiper-match-face-1
  72                           swiper-match-face-2
  73                           swiper-match-face-3
  74                           swiper-match-face-4)
  75   "List of `swiper' faces for group matches.")
  76
  77 (defvar swiper--window nil
  78   "Store the current window.")
  79
  80 (defalias 'swiper-font-lock-ensure
  81     (if (fboundp 'font-lock-ensure)
  82         'font-lock-ensure
  83       'font-lock-fontify-buffer))
  84
  85 (defun swiper--candidates ()
  86   "Return a list of this buffer lines."
  87   (let ((n-lines (count-lines (point-min) (point-max))))
  88     (unless (zerop n-lines)
  89       (let* ((line-width (1+ (floor (log n-lines 10))))
  90              (fspec (format "%%-%dd %%s" line-width))
  91              (line-number 0)
  92              candidates)
  93         (save-excursion
  94           (goto-char (point-min))
  95           (swiper-font-lock-ensure)
  96           (while (< (point) (point-max))
  97             (push (format fspec
  98                           (cl-incf line-number)
  99                           (buffer-substring
 100                            (line-beginning-position)
 101                            (line-end-position)))
 102                   candidates)
 103             (zerop (forward-line 1)))
 104           (nreverse candidates))))))
 105
 106 (defvar swiper-helm-keymap
 107   (let ((map (make-sparse-keymap)))
 108     (define-key map (kbd "C-s") 'helm-next-line)
 109     (define-key map (kbd "C-r") 'helm-previous-line)
 110     map)
 111   "Allows you to go to next and previous hit isearch-style.")
 112
 113 (defvar swiper--opoint
 114   "The point when `swiper' starts.")
 115
 116 ;;;###autoload
 117 (defun swiper (&optional initial-input)
 118   "`isearch' with an overview.
 119 When non-nil, INITIAL-INPUT is the initial search pattern."
 120   (interactive)
 121   (setq swiper--opoint (point))
 122   (if (and (eq swiper-completion-method 'helm)
 123            (featurep 'helm))
 124       (swiper--helm initial-input)
 125     (swiper--ivy initial-input)))
 126
 127 (defun swiper--init ()
 128   "Perform initialization common to both completion methods."
 129   (deactivate-mark)
 130   (setq swiper--len 0)
 131   (setq swiper--anchor (line-number-at-pos))
 132   (setq swiper--window (selected-window)))
 133
 134 (defun swiper--ivy (&optional initial-input)
 135   "`isearch' with an overview using `ivy'.
 136 When non-nil, INITIAL-INPUT is the initial search pattern."
 137   (interactive)
 138   (ido-mode -1)
 139   (swiper--init)
 140   (let (res)
 141     (unwind-protect
 142          (setq res (ivy-read "pattern: "
 143                              (swiper--candidates)
 144                              initial-input
 145                              #'swiper--update-input-ivy
 146                              (1- (line-number-at-pos))))
 147       (ido-mode 1)
 148       (swiper--cleanup)
 149       (if (null ivy-exit)
 150           (goto-char swiper--opoint)
 151         (swiper--action res ivy-text)))))
 152
 153 (defun swiper--helm (&optional initial-input)
 154   "`isearch' with an overview using `helm'.
 155 When non-nil, INITIAL-INPUT is the initial search pattern."
 156   (interactive)
 157   (require 'helm)
 158   (swiper--init)
 159   (unwind-protect
 160        (let ((helm-display-function
 161               (lambda (buf)
 162                 (when (one-window-p)
 163                   (split-window-vertically))
 164                 (other-window 1)
 165                 (switch-to-buffer buf)))
 166              helm-candidate-number-limit)
 167          (helm :sources
 168                `((name . ,(buffer-name))
 169                  (init . (lambda ()
 170                            (add-hook 'helm-move-selection-after-hook
 171                                      #'swiper--update-sel)
 172                            (add-hook 'helm-update-hook
 173                                      #'swiper--update-input-helm)
 174                            (add-hook 'helm-after-update-hook
 175                                      #'swiper--reanchor)))
 176                  (match-strict . (lambda (x)
 177                                    (ignore-errors
 178                                      (string-match (ivy--regex helm-input) x))))
 179                  (candidates . ,(swiper--candidates))
 180                  (filtered-candidate-transformer
 181                   helm-fuzzy-highlight-matches)
 182                  (action . swiper--action-helm))
 183                :keymap (make-composed-keymap
 184                         swiper-helm-keymap
 185                         helm-map)
 186                :input initial-input
 187                :preselect
 188                (format "^%d " swiper--anchor)
 189                :buffer "*swiper*"))
 190     ;; cleanup
 191     (remove-hook 'helm-move-selection-after-hook #'swiper--update-sel)
 192     (remove-hook 'helm-update-hook #'swiper--update-input-helm)
 193     (remove-hook 'helm-after-update-hook #'swiper--reanchor)
 194     (swiper--cleanup)))
 195
 196 (defun swiper--ensure-visible ()
 197   "Remove overlays hiding point."
 198   (let ((overlays (overlays-at (point)))
 199         ov expose)
 200     (while (setq ov (pop overlays))
 201       (if (and (invisible-p (overlay-get ov 'invisible))
 202                (setq expose (overlay-get ov 'isearch-open-invisible)))
 203           (funcall expose ov)))))
 204
 205 (defun swiper--cleanup ()
 206   "Clean up the overlays."
 207   (while swiper--overlays
 208     (delete-overlay (pop swiper--overlays)))
 209   (save-excursion
 210     (goto-char (point-min))
 211     (isearch-clean-overlays)))
 212
 213 (defvar swiper--overlays nil
 214   "Store overlays.")
 215
 216 (defvar swiper--anchor nil
 217   "A line number to which the search should be anchored.")
 218
 219 (defvar swiper--len 0
 220   "The last length of input for which an anchoring was made.")
 221
 222 (defun swiper--update-input-helm ()
 223   "Update selection."
 224   (swiper--cleanup)
 225   (with-selected-window swiper--window
 226     (swiper--add-overlays
 227      (ivy--regex helm-input)
 228      (window-start swiper--window)
 229      (window-end swiper--window t)))
 230   (when (/= (length helm-input) swiper--len)
 231     (setq swiper--len (length helm-input))
 232     (swiper--reanchor)))
 233
 234 (defun swiper--update-input-ivy ()
 235   "Called when `ivy' input is updated."
 236   (swiper--cleanup)
 237   (let* ((re (ivy--regex ivy-text))
 238          (str ivy--current)
 239          (num (if (string-match "^[0-9]+" str)
 240                   (string-to-number (match-string 0 str))
 241                 0)))
 242     (with-selected-window swiper--window
 243       (goto-char (point-min))
 244       (when (plusp num)
 245         (goto-char (point-min))
 246         (forward-line (1- num))
 247         (isearch-range-invisible (line-beginning-position)
 248                                  (line-end-position))
 249         (unless (and (> (point) (window-start))
 250                      (< (point) (window-end swiper--window t)))
 251           (recenter)))
 252       (let ((ov (make-overlay
 253                  (line-beginning-position)
 254                  (1+ (line-end-position)))))
 255         (overlay-put ov 'face 'swiper-line-face)
 256         (overlay-put ov 'window swiper--window)
 257         (push ov swiper--overlays))
 258       (swiper--add-overlays
 259        re
 260        (window-start swiper--window)
 261        (window-end swiper--window t)))))
 262
 263 (defun swiper--add-overlays (re beg end)
 264   "Add overlays for RE regexp in current buffer between BEG and END."
 265   (when (> (length re) 1)
 266     (save-excursion
 267       (goto-char beg)
 268       ;; RE can become an invalid regexp
 269       (while (and (ignore-errors (re-search-forward re end t))
 270                   (> (- (match-end 0) (match-beginning 0)) 0))
 271         (let ((i 0))
 272           (while (<= i ivy--subexps)
 273             (when (match-beginning i)
 274               (let ((overlay (make-overlay (match-beginning i)
 275                                            (match-end i)))
 276                     (face
 277                      (cond ((zerop ivy--subexps)
 278                             (cl-caddr swiper-faces))
 279                            ((zerop i)
 280                             (car swiper-faces))
 281                            (t
 282                             (nth (1+ (mod (1- i) (1- (length swiper-faces))))
 283                                  swiper-faces)))))
 284                 (push overlay swiper--overlays)
 285                 (overlay-put overlay 'face face)
 286                 (overlay-put overlay 'window swiper--window)
 287                 (overlay-put overlay 'priority i)))
 288             (cl-incf i)))))))
 289
 290 (defun swiper--binary (beg end)
 291   "Find anchor between BEG and END."
 292   (if (<= (- end beg) 10)
 293       (let ((min 1000)
 294             n
 295             ln
 296             d)
 297         (goto-char (point-min))
 298         (forward-line (1- beg))
 299         (while (< beg end)
 300           (beginning-of-line)
 301           (setq n (read (current-buffer)))
 302           (when (< (setq d (abs (- n swiper--anchor))) min)
 303             (setq min d)
 304             (setq ln beg))
 305           (cl-incf beg)
 306           (forward-line 1))
 307         (goto-char (point-min))
 308         (when ln
 309           (forward-line (1- ln))))
 310     (let ((mid (+ beg (/ (- end beg) 2))))
 311       (goto-char (point-min))
 312       (forward-line mid)
 313       (beginning-of-line)
 314       (let ((n (read (current-buffer))))
 315         (if (> n swiper--anchor)
 316             (swiper--binary beg mid)
 317           (swiper--binary mid end))))))
 318
 319 (defun swiper--update-sel ()
 320   "Update selection."
 321   (let* ((re (ivy--regex helm-input))
 322          (str (buffer-substring-no-properties
 323                (line-beginning-position)
 324                (line-end-position)))
 325          (num (if (string-match "^[0-9]+" str)
 326                   (string-to-number (match-string 0 str))
 327                 0))
 328          pt)
 329     (when (> (length re) 0)
 330       (with-selected-window swiper--window
 331         (goto-char (point-min))
 332         (forward-line (1- num))
 333         (when (re-search-forward re (point-max) t)
 334           (setq pt (match-beginning 0))))
 335       (when pt
 336         (with-selected-window
 337             (helm-persistent-action-display-window)
 338           (goto-char pt)
 339           (recenter)
 340           (swiper--update-input-helm))))
 341     (with-selected-window swiper--window
 342       (let ((ov (make-overlay
 343                  (line-beginning-position)
 344                  (1+ (line-end-position)))))
 345         (overlay-put ov 'face 'swiper-line-face)
 346         (push ov swiper--overlays)))))
 347
 348 (defun swiper--reanchor ()
 349   "Move to a valid match closest to `swiper--anchor'."
 350   (with-helm-window
 351     (goto-char (point-min))
 352     (if (re-search-forward (format "^%d " swiper--anchor) nil t)
 353         nil
 354       (forward-line 1)
 355       (swiper--binary 2 (1+ (count-lines (point) (point-max)))))
 356     (when (> (count-lines (point-min) (point-max)) 1)
 357       (forward-line -1)
 358       (helm-next-line 1))))
 359
 360 (defun swiper--action-helm (x)
 361   "Goto line X."
 362   (swiper--action x helm-input))
 363
 364 (defun swiper--action (x input)
 365   "Goto line X and search for input."
 366   (if (null x)
 367       (user-error "No candidates")
 368     (goto-char (point-min))
 369     (forward-line (1- (read x)))
 370     (re-search-forward
 371      (ivy--regex input) (line-end-position) t)
 372     (swiper--ensure-visible)
 373     (when (/= (point) swiper--opoint)
 374       (unless (and transient-mark-mode mark-active)
 375         (push-mark swiper--opoint t)
 376         (message "Mark saved where search started")))))
 377
 378 (provide 'swiper)
 379
 380 ;;; swiper.el ends here