evil-easymotion.el

;;; evil-easymotion.el --- A port of vim's easymotion to emacs

;; Copyright (C) 2014, 2015, 2016, 2018 PythonNut
;; Copyright (C) 2017 wouter bolsterlee

;; Author: PythonNut <pythonnut@pythonnut.com>
;; Keywords: convenience, evil
;; Version: 20160228
;; URL: https://github.com/pythonnut/evil-easymotion
;; Package-Requires: ((emacs "24") (avy "0.3.0") (cl-lib "0.5"))

;;; License:

;; This program 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 of the License, 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.

;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.

;;; Commentary:
;; This is a clone of the popular easymotion package for vim, which
;; describes itself in these terms:

;; > EasyMotion provides a much simpler way to use some motions in vim.
;; > It takes the <number> out of <number>w or <number>f{char} by
;; > highlighting all possible choices and allowing you to press one key
;; > to jump directly to the target.

;; If you're having trouble picturing this, please visit the github repo
;; for a screencast.

;; Usage/status
;; ============

;; evil-easymotion, rather unsurprisingly can use evil. However, you don't
;; _need_ evil to use it. evil-easymotion can happily define motions for
;; regular emacs commands. With that said, evil is recommended, not
;; least because it's awesome.

;; Currently most motions are supported, and it's easy to define your own easymotions.

;;   (evilem-define (kbd "SPC w") 'evil-forward-word-begin)

;; To define easymotions for all motions that evil defines by default, add

;;   (evilem-default-keybindings "SPC")

;; This binds all motions under the prefix `SPC` in `evil-motion-state-map`. This is not done by default for motions defined manually. You will need to supply the prefix.

;; More advanced use-cases are detailed in the github README.

;;; Code:
(require 'cl-lib)

(eval-when-compile
  (require 'avy)
  (require 'evil))

(defgroup evilem nil
  "Emulate vim-easymotion"
  :group 'convenience
  :prefix "evilem-")

(defcustom evilem-keys nil
  "Value of `avy-keys' to set during motions. Set to nil to leave unchanged."
  :type '(repeat :tag "Keys" character))

(defcustom evilem-style nil
  "Value of `avy-style' to set during motions. Set to nil to leave unchanged."
  :type '(choice
          (const :tag "Pre" pre)
          (const :tag "At" at)
          (const :tag "At Full" at-full)
          (const :tag "Post" post)
          (const :tag "De Bruijn" de-bruijn)
          (const :tag "Default" nil)))

(defvar evilem-map (make-sparse-keymap)
  "Keymap used for the default bindings")

;; macro helper, from evil source
(eval-and-compile
  (defun evilem--unquote (exp)
    "Return EXP unquoted."
    (while (member (car-safe exp) '(quote function))
      (setq exp (cadr exp)))
    exp)

  (defun evilem--make-name (func)
    (format "evilem--motion-%s"
            (if (functionp func)
                (symbol-name (evilem--unquote func))
              (mapconcat (lambda (f)
                           (symbol-name (evilem--unquote f)))
                         func
                         "-")))))

(defun evilem--jump (points)
  "avy-jump to the set of points generated by collector"
  (require 'avy)
  (let* ((avy-style (or evilem-style avy-style))
         (avy-keys (or evilem-keys avy-keys)))
    (avy--process points
                  (avy--style-fn avy-style))))

(defun evilem--default-collect-postprocess (points)
  (cl-stable-sort
   points
   #'<
   :key (lambda (pt)
          (if (equal (selected-window) (cdr pt))
              (abs (- (point) (car pt)))
            most-positive-fixnum))))

;;;###autoload
(defun evilem--collect (func &optional
                             scope
                             all-windows
                             initial-point
                             sort-key
                             collect-postprocess
                             include-invisible)
  "Repeatedly execute func, and collect the cursor positions into a list"
  (cl-letf ((points nil)
            (point nil)
            (avy-all-windows all-windows)
            ;; make sure the motion doesn't move the window
            (scroll-conservatively 101)
            (smooth-scrolling-mode nil)
            (scroll-margin 0))
    (if (functionp func)
        (avy-dowindows current-prefix-arg
          (save-excursion
            (save-restriction
              (when initial-point
                (goto-char (funcall initial-point)))
              (cl-destructuring-bind (beg . end)
                  (if scope
                      (bounds-of-thing-at-point scope)
                    (cons (point-min)
                          (point-max)))

                ;; trim trailing newline
                (when (= (char-before end) 10)
                  (cl-decf end))

                (narrow-to-region (max beg (window-start))
                                  (min end (window-end))))
              (while (and (ignore-errors
                            (setq this-command func
                                  last-command func)
                            (call-interactively func)
                            (unless include-invisible
                              (let ((ov (car (overlays-at (point)))))
                                (while (and ov (member
                                                'invisible
                                                (overlay-properties ov)))
                                  (goto-char (overlay-end ov))
                                  ;; This is a bit of a hack, since we
                                  ;; can't guarantee that we will end
                                  ;; up at the same point if we start
                                  ;; at the end of the invisible
                                  ;; region vs. looping through it.
                                  (call-interactively func)
                                  (setq ov (car (overlays-at (point)))))))
                            t)
                          (setq point (cons (point) (get-buffer-window)))
                          (not (member point points))
                          (push point points))))))
      (setq points (cl-remove-duplicates
                    (cl-mapcan (lambda (f)
                                 (evilem--collect f scope all-windows))
                               func))))
    (funcall (or collect-postprocess
                 #'evilem--default-collect-postprocess)
             points)))

(eval-and-compile
  (defun evilem--compute-inclusivity (funcs)
    (when (and (= (length funcs) 1)
               (evil-has-command-properties-p (car funcs)))
      `(setq evil-this-type
             ',(evil-get-command-property (car funcs) :type)))))

(cl-defmacro evilem-make-motion (name
                                 funcs
                                 &key
                                 pre-hook
                                 post-hook
                                 bind
                                 scope
                                 all-windows
                                 initial-point
                                 push-jump
                                 collect-postprocess
                                 include-invisible)
  "Automatically define an evil easymotion for `func', naming it `name'"
  `(,(if all-windows
         'evil-define-command
       'evil-define-motion)
    ,name (&optional _count)
    (require 'avy)
    (avy-with ,name
      (evil-without-repeat
        ,(evilem--compute-inclusivity funcs)
        (cl-letf* ,bind
          ,(when (or push-jump (not scope))
             '(evil--jumps-push))
          ,(when pre-hook `(funcall ,(if (functionp pre-hook)
                                         pre-hook
                                       `(lambda () ,pre-hook))))
          (evilem--jump (evilem--collect ,funcs
                                         ,scope
                                         ,all-windows
                                         ,initial-point
                                         ,collect-postprocess
                                         ,include-invisible))
          ,(when post-hook `(funcall ,(if (functionp post-hook)
                                          post-hook
                                        `(lambda () ,post-hook)))))))))

(cl-defmacro evilem-make-motion-plain (name
                                       funcs
                                       &key
                                       pre-hook
                                       post-hook
                                       bind
                                       scope
                                       all-windows
                                       initial-point
                                       collect-postprocess
                                       include-invisible)
  "Automatically define a plain easymotion for `func', naming it `name'"
  `(defun ,name ()
     (interactive)
     (require 'avy)
     (avy-with ,name
       (cl-letf* ,bind
         ,(when pre-hook `(funcall ,(if (functionp pre-hook)
                                        pre-hook
                                      `(lambda () ,pre-hook))))
         (evilem--jump (evilem--collect ,funcs
                                        ,scope
                                        ,all-windows
                                        ,initial-point
                                        ,collect-postprocess
                                        ,include-invisible))
         ,(when post-hook `(funcall ,(if (functionp post-hook)
                                         post-hook
                                       `(lambda () ,post-hook))))))))

(cl-defmacro evilem-create (motions
                            &key
                            name
                            pre-hook
                            post-hook
                            bind
                            scope
                            all-windows
                            initial-point
                            push-jump
                            collect-postprocess
                            include-invisible)
  `(evilem-make-motion
    ,(or (evilem--unquote name)
         (intern (evilem--make-name motions)))
    ,motions
    :pre-hook ,pre-hook
    :post-hook ,post-hook
    :bind ,bind
    :scope ,scope
    :all-windows ,all-windows
    :initial-point ,initial-point
    :push-jump ,push-jump
    :collect-postprocess ,collect-postprocess
    :include-invisible ,include-invisible))

(cl-defmacro evilem-create-plain (motions
                                  &key
                                  name
                                  pre-hook
                                  post-hook
                                  bind
                                  scope
                                  all-windows
                                  initial-point
                                  collect-postprocess
                                  include-invisible)
  `(evilem-make-motion-plain
    ,(or (evilem--unquote name)
         (intern (evilem--make-name motions)))
    ,motions
    :pre-hook ,pre-hook
    :post-hook ,post-hook
    :bind ,bind
    :scope ,scope
    :all-windows ,all-windows
    :initial-point ,initial-point
    :collect-postprocess ,collect-postprocess
    :include-invisible ,include-invisible))

(cl-defmacro evilem-define (key
                            motions
                            &key
                            name
                            pre-hook
                            post-hook
                            bind
                            scope
                            all-windows
                            initial-point
                            push-jump
                            collect-postprocess
                            include-invisible)
  "Automatically create and bind an evil motion"
  `(define-key ,(if all-windows
                    'evil-normal-state-map
                  'evil-motion-state-map)
     ,key
     (evilem-create ,motions
                    :name ,name
                    :pre-hook ,pre-hook
                    :post-hook ,post-hook
                    :bind ,bind
                    :scope ,scope
                    :all-windows ,all-windows
                    :initial-point ,initial-point
                    :push-jump ,push-jump
                    :collect-postprocess ,collect-postprocess
                    :include-invisible ,include-invisible)))

;;;###autoload (autoload 'evilem-motion-forward-word-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-word-begin #'evil-forward-word-begin
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-forward-WORD-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-WORD-begin #'evil-forward-WORD-begin
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-forward-word-end "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-word-end #'evil-forward-word-end
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-forward-WORD-end "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-WORD-end #'evil-forward-WORD-end
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-backward-word-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-word-begin #'evil-backward-word-begin
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-backward-WORD-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-WORD-begin #'evil-backward-WORD-begin
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-backward-word-end "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-word-end #'evil-backward-word-end
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-backward-WORD-end "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-WORD-end #'evil-backward-WORD-end
 :scope 'line)

;;;###autoload (autoload 'evilem-motion-next-line "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-next-line #'next-line
 :pre-hook (setq evil-this-type 'line)
 :bind ((temporary-goal-column (current-column))
        (line-move-visual nil)))

;;;###autoload (autoload 'evilem-motion-previous-line "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-previous-line #'previous-line
 :pre-hook (setq evil-this-type 'line)
 :bind ((temporary-goal-column (current-column))
        (line-move-visual nil)))

;;;###autoload (autoload 'evilem-motion-next-visual-line "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-next-visual-line #'next-line
 :pre-hook (setq evil-this-type 'line)
 :bind ((temporary-goal-column (current-column))
        (line-move-visual t)))

;;;###autoload (autoload 'evilem-motion-previous-visual-line "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-previous-visual-line #'previous-line
 :pre-hook (setq evil-this-type 'line)
 :bind ((temporary-goal-column (current-column))
        (line-move-visual t)))

;;;###autoload (autoload 'evilem-motion-find-char-to "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-find-char-to #'evil-repeat-find-char
 :pre-hook (save-excursion
             (setq evil-this-type 'inclusive)
             (call-interactively #'evil-find-char-to))
 :bind ((evil-cross-lines t)))

;;;###autoload (autoload 'evilem-motion-find-char-to-backward "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-find-char-to-backward #'evil-repeat-find-char
 :pre-hook (save-excursion
             (setq evil-this-type 'exclusive)
             (call-interactively #'evil-find-char-to-backward))
 :bind ((evil-cross-lines t)))

;;;###autoload (autoload 'evilem-motion-find-char "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-find-char #'evil-repeat-find-char
 :pre-hook (save-excursion
             (setq evil-this-type 'inclusive)
             (call-interactively #'evil-find-char))
 :bind ((evil-cross-lines t)))

;;;###autoload (autoload 'evilem-motion-find-char-backward "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-find-char-backward #'evil-repeat-find-char
 :pre-hook (save-excursion
             (setq evil-this-type 'exclusive)
             (call-interactively #'evil-find-char-backward))
 :bind ((evil-cross-lines t)))

;;;###autoload (autoload 'evilem-motion-backward-section-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-section-begin #'evil-backward-section-begin
 :pre-hook (setq evil-this-type 'line))

;;;###autoload (autoload 'evilem-motion-backward-section-end "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-section-end #'evil-backward-section-end
 :pre-hook (setq evil-this-type 'line))

;;;###autoload (autoload 'evilem-motion-forward-section-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-section-begin #'evil-forward-section-begin
 :pre-hook (setq evil-this-type 'line))

;;;###autoload (autoload 'evilem-motion-forward-section-end "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-section-end #'evil-forward-section-end
 :pre-hook (setq evil-this-type 'line))

;;;###autoload (autoload 'evilem-motion-backward-sentence-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-backward-sentence-begin #'evil-backward-sentence-begin)

;;;###autoload (autoload 'evilem-motion-forward-sentence-begin "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-forward-sentence-begin #'evil-forward-sentence-begin)

;;;###autoload (autoload 'evilem-motion-search-next "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-search-next #'evil-search-next
 :bind (((symbol-function #'isearch-lazy-highlight-update)
         #'ignore)
        (search-highlight nil)))

;;;###autoload (autoload 'evilem-motion-search-previous "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-search-previous #'evil-search-previous
 :bind (((symbol-function #'isearch-lazy-highlight-update)
         #'ignore)
        (search-highlight nil)))

;;;###autoload (autoload 'evilem-motion-search-word-forward "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-search-word-forward #'evil-search-word-forward
 :bind (((symbol-function #'isearch-lazy-highlight-update)
         #'ignore)
        (search-highlight nil)))

;;;###autoload (autoload 'evilem-motion-search-word-backward "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-search-word-backward #'evil-search-word-backward
 :bind (((symbol-function #'isearch-lazy-highlight-update)
         #'ignore)
        (search-highlight nil)))

;;;###autoload (autoload 'evilem-motion-previous-line-first-non-blank "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-previous-line-first-non-blank #'evil-previous-line-first-non-blank)

;;;###autoload (autoload 'evilem-motion-next-line-first-non-blank "evil-easymotion" nil t)
(evilem-make-motion
 evilem-motion-next-line-first-non-blank #'evil-next-line-first-non-blank)

;;;###autoload
(defun evilem-default-keybindings (prefix)
  "Define easymotions for all motions evil defines by default"
  (define-key evil-motion-state-map (kbd prefix) evilem-map))

(define-key evilem-map "w" #'evilem-motion-forward-word-begin)
(define-key evilem-map "W" #'evilem-motion-forward-WORD-begin)
(define-key evilem-map "e" #'evilem-motion-forward-word-end)
(define-key evilem-map "E" #'evilem-motion-forward-WORD-end)
(define-key evilem-map "b" #'evilem-motion-backward-word-begin)
(define-key evilem-map "B" #'evilem-motion-backward-WORD-begin)
(define-key evilem-map "ge" #'evilem-motion-backward-word-end)
(define-key evilem-map "gE" #'evilem-motion-backward-WORD-end)
(define-key evilem-map "j" #'evilem-motion-next-line)
(define-key evilem-map "k" #'evilem-motion-previous-line)
(define-key evilem-map "gj" #'evilem-motion-next-visual-line)
(define-key evilem-map "gk" #'evilem-motion-previous-visual-line)
(define-key evilem-map "t" #'evilem-motion-find-char-to)
(define-key evilem-map "T" #'evilem-motion-find-char-to-backward)
(define-key evilem-map "f" #'evilem-motion-find-char)
(define-key evilem-map "F" #'evilem-motion-find-char-backward)
(define-key evilem-map "[[" #'evilem-motion-backward-section-begin)
(define-key evilem-map "[]" #'evilem-motion-backward-section-end)
(define-key evilem-map "]]" #'evilem-motion-forward-section-begin)
(define-key evilem-map "][" #'evilem-motion-forward-section-end)
(define-key evilem-map "(" #'evilem-motion-backward-sentence-begin)
(define-key evilem-map ")" #'evilem-motion-forward-sentence-begin)
(define-key evilem-map "n" #'evilem-motion-search-next)
(define-key evilem-map "N" #'evilem-motion-search-previous)
(define-key evilem-map "*" #'evilem-motion-search-word-forward)
(define-key evilem-map "#" #'evilem-motion-search-word-backward)
(define-key evilem-map "-" #'evilem-motion-previous-line-first-non-blank)
(define-key evilem-map "+" #'evilem-motion-next-line-first-non-blank)

(provide 'evil-easymotion)
;;; evil-easymotion.el ends here