Move lispy-occur to lispy-occur.el

Ensures that swiper and ivy only load on demand.

Fixes #616

Author: aaronjensen

lispy-occur.el

@@ -0,0 +1,216 @@
+;;; lispy-occur.el --- Select a line within the current top level sexp. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2021 Oleh Krehel
+
+;; This file is not part of GNU Emacs
+
+;; This file is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 3, or (at your option)
+;; any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; For a full copy of the GNU General Public License
+;; see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+
+;;; Code:
+(require 'swiper)
+
+(defcustom lispy-occur-backend 'ivy
+  "Method to navigate to a line with `lispy-occur'."
+  :type '(choice
+          (const :tag "Ivy" ivy)
+          (const :tag "Helm" helm)))
+
+(defvar lispy--occur-beg 1
+  "Start position of the top level sexp during `lispy-occur'.")
+
+(defvar lispy--occur-end 1
+  "End position of the top level sexp during `lispy-occur'.")
+
+(defun lispy--occur-candidates (&optional bnd)
+  "Return the candidates for `lispy-occur'."
+  (setq bnd (or bnd (save-excursion
+                      (unless (and (bolp)
+                                   (lispy-left-p))
+                        (beginning-of-defun))
+                      (lispy--bounds-dwim))))
+  (let ((line-number -1)
+        candidates)
+    (setq lispy--occur-beg (car bnd))
+    (setq lispy--occur-end (cdr bnd))
+    (save-excursion
+      (goto-char lispy--occur-beg)
+      (while (< (point) lispy--occur-end)
+        (push (format "%-3d %s"
+                      (cl-incf line-number)
+                      (buffer-substring
+                       (line-beginning-position)
+                       (line-end-position)))
+              candidates)
+        (forward-line 1)))
+    (nreverse candidates)))
+
+(defun lispy--occur-preselect ()
+  "Initial candidate regex for `lispy-occur'."
+  (format "^%d"
+          (-
+           (line-number-at-pos (point))
+           (line-number-at-pos lispy--occur-beg))))
+
+(defvar helm-input)
+(declare-function helm "ext:helm")
+
+(defun lispy-occur-action-goto-paren (x)
+  "Goto line X for `lispy-occur'."
+  (setq x (read x))
+  (goto-char lispy--occur-beg)
+  (let ((input (if (eq lispy-occur-backend 'helm)
+                   helm-input
+                 ivy-text))
+        str-or-comment)
+    (cond ((string= input "")
+           (forward-line x)
+           (back-to-indentation)
+           (when (re-search-forward lispy-left (line-end-position) t)
+             (goto-char (match-beginning 0))))
+
+          ((setq str-or-comment
+                 (progn
+                   (forward-line x)
+                   (re-search-forward (ivy--regex input)
+                                      (line-end-position) t)
+                   (lispy--in-string-or-comment-p)))
+           (goto-char str-or-comment))
+
+          ((re-search-backward lispy-left (line-beginning-position) t)
+           (goto-char (match-beginning 0)))
+
+          ((re-search-forward lispy-left (line-end-position) t)
+           (goto-char (match-beginning 0)))
+
+          (t
+           (back-to-indentation)))))
+
+(defun lispy-occur-action-goto-end (x)
+  "Goto line X for `lispy-occur'."
+  (setq x (read x))
+  (goto-char lispy--occur-beg)
+  (forward-line x)
+  (re-search-forward (ivy--regex ivy-text) (line-end-position) t))
+
+(defun lispy-occur-action-goto-beg (x)
+  "Goto line X for `lispy-occur'."
+  (when (lispy-occur-action-goto-end x)
+    (goto-char (match-beginning 0))))
+
+(defun lispy-occur-action-mc (_x)
+  "Make a fake cursor for each `lispy-occur' candidate."
+  (let ((cands (nreverse ivy--old-cands))
+        cand)
+    (while (setq cand (pop cands))
+      (goto-char lispy--occur-beg)
+      (forward-line (read cand))
+      (re-search-forward (ivy--regex ivy-text) (line-end-position) t)
+      (when cands
+        (mc/create-fake-cursor-at-point))))
+  (multiple-cursors-mode 1))
+
+(ivy-set-actions
+ 'lispy-occur
+ '(("m" lispy-occur-action-mc "multiple-cursors")
+   ("j" lispy-occur-action-goto-beg "goto start")
+   ("k" lispy-occur-action-goto-end "goto end")))
+
+(defvar ivy-last)
+(declare-function ivy-state-window "ext:ivy")
+
+;;;###autoload
+(defun lispy-occur ()
+  "Select a line within current top level sexp.
+See `lispy-occur-backend' for the selection back end."
+  (interactive)
+  (swiper--init)
+  (cond ((eq lispy-occur-backend 'helm)
+         (require 'helm)
+         (add-hook 'helm-move-selection-after-hook
+                   #'lispy--occur-update-input-helm)
+         (add-hook 'helm-update-hook
+                   #'lispy--occur-update-input-helm)
+         (unwind-protect
+              (helm :sources
+                    `((name . "this defun")
+                      (candidates . ,(lispy--occur-candidates))
+                      (action . lispy-occur-action-goto-paren)
+                      (match-strict .
+                                    (lambda (x)
+                                      (ignore-errors
+                                        (string-match
+                                         (ivy--regex helm-input) x)))))
+                    :preselect (lispy--occur-preselect)
+                    :buffer "*lispy-occur*")
+           (swiper--cleanup)
+           (remove-hook 'helm-move-selection-after-hook
+                        #'lispy--occur-update-input-helm)
+           (remove-hook 'helm-update-hook
+                        #'lispy--occur-update-input-helm)))
+        ((eq lispy-occur-backend 'ivy)
+         (unwind-protect
+              (ivy-read "pattern: "
+                        (lispy--occur-candidates)
+                        :preselect (lispy--occur-preselect)
+                        :require-match t
+                        :update-fn (lambda ()
+                                     (lispy--occur-update-input
+                                      ivy-text
+                                      (ivy-state-current ivy-last)))
+                        :action #'lispy-occur-action-goto-paren
+                        :caller 'lispy-occur)
+           (swiper--cleanup)
+           (when (null ivy-exit)
+             (goto-char swiper--opoint))))
+        (t
+         (error "Bad `lispy-occur-backend': %S" lispy-occur-backend))))
+
+(defun lispy--occur-update-input-helm ()
+  "Update selection for `lispy-occur' using `helm' back end."
+  (lispy--occur-update-input
+   helm-input
+   (buffer-substring-no-properties
+    (line-beginning-position)
+    (line-end-position))))
+
+(defun lispy--occur-update-input (input str)
+  "Update selection for `ivy-occur'.
+INPUT is the current input text.
+STR is the full current candidate."
+  (swiper--cleanup)
+  (let ((re (ivy--regex input))
+        (num (if (string-match "^[0-9]+" str)
+                 (string-to-number (match-string 0 str))
+               0)))
+    (with-selected-window (ivy-state-window ivy-last)
+      (goto-char lispy--occur-beg)
+      (when (cl-plusp num)
+        (forward-line num)
+        (unless (<= (point) lispy--occur-end)
+          (recenter)))
+      (let ((ov (make-overlay (line-beginning-position)
+                              (1+ (line-end-position)))))
+        (overlay-put ov 'face 'swiper-line-face)
+        (overlay-put ov 'window (ivy-state-window ivy-last))
+        (push ov swiper--overlays))
+      (re-search-forward re (line-end-position) t)
+      (swiper--add-overlays
+       re
+       lispy--occur-beg
+       lispy--occur-end))))
+
+;;; lispy-occur.el ends here