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