code.delx.au - gnu-emacs-elpa/blob - swiper.el

   1 ;;; swiper.el --- Isearch with a helm 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: ((helm "1.6.7") (emacs "24.1"))
   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 in a `helm' buffer.  The search regex can be split into
  30 ;; groups with a space.  Each group is highlighted with a different
  31 ;; face.
  32 ;;
  33 ;; It can double as a quick `regex-builder', although only single
  34 ;; lines will be matched.
  35
  36 ;;; Code:
  37 (require 'helm)
  38
  39 (defgroup swiper nil
  40   "Interactive `occur' using `helm'."
  41   :group 'matching
  42   :prefix "swiper-")
  43
  44 (defface swiper-match-face-1
  45   '((t (:background "#FEEA89")))
  46   "Face for `swiper' matches.")
  47
  48 (defface swiper-match-face-2
  49   '((t (:background "#F9A35A")))
  50   "Face for `swiper' matches.")
  51
  52 (defface swiper-match-face-3
  53   '((t (:background "#fb7905")))
  54   "Face for `swiper' matches.")
  55
  56 (defface swiper-match-face-4
  57   '((t (:background "#F15C79")))
  58   "Face for `swiper' matches.")
  59
  60 (defface swiper-line-face
  61   '((t (:background "#f3d3d3")))
  62   "Face for current `swiper' line.")
  63
  64 (defcustom swiper-faces '(swiper-match-face-1
  65                           swiper-match-face-2
  66                           swiper-match-face-3
  67                           swiper-match-face-4)
  68   "List of `swiper' faces for group matches.")
  69
  70 (defvar swiper--buffer nil
  71   "Store current buffer.")
  72
  73 (defalias 'swiper-font-lock-ensure
  74     (if (fboundp 'font-lock-ensure)
  75         'font-lock-ensure
  76       'font-lock-fontify-buffer))
  77
  78 (defun swiper--candidates ()
  79   "Return a list of this buffer lines."
  80   (let* ((line-width (1+ (floor (log (count-lines
  81                                       (point-min) (point-max))
  82                                      10))))
  83          (fspec (format "%%-%dd %%s" line-width))
  84          (line-number 0)
  85          candidates)
  86     (save-excursion
  87       (goto-char (point-min))
  88       (swiper-font-lock-ensure)
  89       (while (< (point) (point-max))
  90         (push (format fspec
  91                       (cl-incf line-number)
  92                       (buffer-substring
  93                        (line-beginning-position)
  94                        (line-end-position)))
  95               candidates)
  96         (zerop (forward-line 1)))
  97       (nreverse candidates))))
  98
  99 ;;;###autoload
 100 (defun swiper ()
 101   "Interactive `occur' using `helm'."
 102   (interactive)
 103   (deactivate-mark)
 104   (setq swiper--len 0)
 105   (setq swiper--anchor (line-number-at-pos))
 106   (unwind-protect
 107        (let ((helm-display-function
 108               (lambda (buf)
 109                 (when (one-window-p)
 110                   (split-window-vertically))
 111                 (other-window 1)
 112                 (switch-to-buffer buf)))
 113              helm-candidate-number-limit)
 114          (helm :sources
 115                `((name . ,(buffer-name))
 116                  (init . (lambda ()
 117                            (setq swiper--buffer (current-buffer))
 118                            (add-hook 'helm-move-selection-after-hook
 119                                      #'swiper--update-sel)
 120                            (add-hook 'helm-update-hook
 121                                      #'swiper--update-input)
 122                            (add-hook 'helm-after-update-hook
 123                                      #'swiper--reanchor)))
 124                  (match-strict . (lambda (x) (ignore-errors
 125                                           (string-match (swiper--regex) x))))
 126                  (candidates . ,(swiper--candidates))
 127                  (filtered-candidate-transformer
 128                   helm-fuzzy-highlight-matches)
 129                  (action . swiper--action))
 130                :preselect
 131                (format "^%d " swiper--anchor)
 132                :buffer "*swiper*"))
 133     ;; cleanup
 134     (remove-hook 'helm-move-selection-after-hook
 135                  #'swiper--update-sel)
 136     (remove-hook 'helm-update-hook
 137                  #'swiper--update-input)
 138     (remove-hook 'helm-after-update-hook
 139                  #'swiper--reanchor)
 140     (while swiper--overlays
 141       (delete-overlay (pop swiper--overlays)))))
 142
 143 (defvar swiper--overlays nil
 144   "Store overlays.")
 145
 146 (defvar swiper--anchor nil
 147   "A line number to which the search should be anchored.")
 148
 149 (defvar swiper--len 0
 150   "The last length of `helm-input' for which an anchoring was made.")
 151
 152 (defun swiper--update-input ()
 153   "Update selection."
 154   (with-current-buffer swiper--buffer
 155     (let ((re (swiper--regex))
 156           (we (window-end nil t)))
 157       (while swiper--overlays
 158         (delete-overlay (pop swiper--overlays)))
 159       (when (> (length helm-input) 1)
 160         (save-excursion
 161           (goto-char (window-start))
 162           (while (ignore-errors (re-search-forward re we t))
 163             (let ((i 0))
 164               (while (<= i swiper--subexps)
 165                 (when (match-beginning i)
 166                   (let ((overlay (make-overlay (match-beginning i)
 167                                                (match-end i)))
 168                         (face
 169                          (cond ((zerop swiper--subexps)
 170                                 (cl-caddr swiper-faces))
 171                                ((zerop i)
 172                                 (car swiper-faces))
 173                                (t
 174                                 (nth (1+ (mod (1- i) (1- (length swiper-faces))))
 175                                      swiper-faces)))))
 176                     (push overlay swiper--overlays)
 177                     (overlay-put overlay 'face face)
 178                     (overlay-put overlay 'priority i)
 179                     (cl-incf i))))))))))
 180   (when (/= (length helm-input) swiper--len)
 181     (setq swiper--len (length helm-input))
 182     (swiper--reanchor)))
 183
 184 (defun swiper--binary (beg end)
 185   "Find anchor between BEG and END."
 186   (if (<= (- end beg) 10)
 187       (let ((min 1000)
 188             n
 189             ln
 190             d)
 191         (goto-char (point-min))
 192         (forward-line (1- beg))
 193         (while (< beg end)
 194           (beginning-of-line)
 195           (setq n (read (current-buffer)))
 196           (when (< (setq d (abs (- n swiper--anchor))) min)
 197             (setq min d)
 198             (setq ln beg))
 199           (cl-incf beg)
 200           (forward-line 1))
 201         (goto-char (point-min))
 202         (when ln
 203           (forward-line (1- ln))))
 204     (let ((mid (+ beg (/ (- end beg) 2))))
 205       (goto-char (point-min))
 206       (forward-line mid)
 207       (beginning-of-line)
 208       (let ((n (read (current-buffer))))
 209         (if (> n swiper--anchor)
 210             (swiper--binary beg mid)
 211           (swiper--binary mid end))))))
 212
 213 (defun swiper--update-sel ()
 214   "Update selection."
 215   (let* ((re (swiper--regex))
 216          (str (buffer-substring-no-properties
 217                (line-beginning-position)
 218                (line-end-position)))
 219          (num (if (string-match "^[0-9]+" str)
 220                   (string-to-number (match-string 0 str))
 221                 0))
 222          pt)
 223     (when (> (length re) 0)
 224       (with-current-buffer swiper--buffer
 225         (goto-char (point-min))
 226         (forward-line (1- num))
 227         (when (re-search-forward re (point-max) t)
 228           (setq pt (match-beginning 0))))
 229       (when pt
 230         (with-selected-window
 231             (helm-persistent-action-display-window)
 232           (goto-char pt)
 233           (recenter)
 234           (swiper--update-input))))
 235     (with-current-buffer swiper--buffer
 236       (let ((ov (make-overlay
 237                  (line-beginning-position)
 238                  (1+ (line-end-position)))))
 239         (overlay-put ov 'face 'swiper-line-face)
 240         (push ov swiper--overlays)))))
 241
 242 (defun swiper--reanchor ()
 243   "Move to a valid match closest to `swiper--anchor'."
 244   (with-helm-window
 245     (goto-char (point-min))
 246     (if (re-search-forward (format "^%d " swiper--anchor) nil t)
 247         nil
 248       (forward-line 1)
 249       (swiper--binary 2 (1+ (count-lines (point) (point-max)))))
 250     (when (> (count-lines (point-min) (point-max)) 1)
 251       (forward-line -1)
 252       (helm-next-line 1))))
 253
 254 (defvar swiper--subexps 1
 255   "Number of groups in `(swiper--regex)'.")
 256
 257 (defvar swiper--regex-hash
 258   (make-hash-table :test 'equal)
 259   "Store pre-computed regex.")
 260
 261 (defun swiper--regex ()
 262   "Re-build regex in case it has a space."
 263   (let ((hashed (gethash helm-input swiper--regex-hash)))
 264     (if hashed
 265         (prog1 (cdr hashed)
 266           (setq swiper--subexps (car hashed)))
 267       (cdr (puthash helm-input
 268                     (let ((subs (split-string helm-input " +" t)))
 269                       (if (= (length subs) 1)
 270                           (cons
 271                            (setq swiper--subexps 0)
 272                            (car subs))
 273                         (cons
 274                          (setq swiper--subexps (length subs))
 275                          (mapconcat
 276                           (lambda (x) (format "\\(%s\\)" x))
 277                           subs
 278                           ".*"))))
 279                     swiper--regex-hash)))))
 280
 281 (defun swiper--action (x)
 282   "Goto line X."
 283   (goto-char (point-min))
 284   (forward-line (1- (read x)))
 285   (re-search-forward
 286    (swiper--regex) (line-end-position) t))
 287
 288 (provide 'swiper)
 289
 290 ;;; swiper.el ends here