;;; 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
;; Package-Version: 20260602.2314
;; Package-Revision: 629c894af633
;; URL: https://github.com/pythonnut/evil-easymotion
;; Package-Requires: ((emacs "24") (avy "0.3.0") (cl-lib "0.5") (evil "1.2.13"))

;;; 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)
(require 'ring)

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

(declare-function avy-action-copy "avy")
(declare-function avy-action-kill-move "avy")
(declare-function avy-action-kill-stay "avy")
(declare-function avy-action-mark "avy")
(declare-function avy-action-teleport "avy")
(declare-function avy-action-yank "avy")
(declare-function avy-action-yank-line "avy")
(declare-function evil-delete-whole-line "evil-commands")
(declare-function evil-expand "evil-common")
(declare-function evil-range-beginning "evil-common")
(declare-function evil-range-end "evil-common")
(declare-function evil-yank-line "evil-commands")
(defvar avy-ring)

(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))))

(defun evilem--line-range-at (pt)
  "Return the Evil line range containing PT."
  (save-excursion
    (goto-char pt)
    (evil-expand pt pt 'line)))

(defun evilem--avy-action-mark-line (pt)
  "Mark the line containing PT."
  (let ((range (evilem--line-range-at pt)))
    (goto-char (evil-range-beginning range))
    (set-mark (point))
    (goto-char (evil-range-end range))))

(defun evilem--avy-action-copy-line (pt)
  "Copy the line containing PT."
  (save-excursion
    (goto-char pt)
    (call-interactively #'evil-yank-line)
    (message "Copied: %s" (current-kill 0)))
  (let ((dat (ring-ref avy-ring 0)))
    (select-frame-set-input-focus
     (window-frame (cdr dat)))
    (select-window (cdr dat))
    (goto-char (car dat))))

(defun evilem--avy-action-yank-line (pt)
  "Yank the line containing PT at point."
  (evilem--avy-action-copy-line pt)
  (yank)
  t)

(defun evilem--avy-action-kill-move-line (pt)
  "Kill the line containing PT and move there."
  (goto-char pt)
  (call-interactively #'evil-delete-whole-line)
  (message "Killed: %s" (current-kill 0))
  (point))

(defun evilem--avy-action-kill-stay-line (pt)
  "Kill the line containing PT."
  (save-excursion
    (goto-char pt)
    (call-interactively #'evil-delete-whole-line))
  (message "Killed: %s" (current-kill 0))
  (select-window
   (cdr
    (ring-ref avy-ring 0)))
  t)

(defun evilem--avy-action-teleport-line (pt)
  "Kill the line containing PT and yank it at point."
  (evilem--avy-action-kill-stay-line pt)
  (select-window
   (cdr
    (ring-ref avy-ring 0)))
  (save-excursion
    (yank))
  t)

(defmacro evilem--make-line-motion (name motion visual)
  "Define NAME as a line motion using MOTION.
When VISUAL is non-nil, move by visual lines."
  `(evilem-make-motion
    ,name ,motion
    :pre-hook (setq evil-this-type 'line)
    :bind ((temporary-goal-column (current-column))
           (line-move-visual ,visual)
           ((symbol-function #'avy-action-mark)
            #'evilem--avy-action-mark-line)
           ((symbol-function #'avy-action-copy)
            #'evilem--avy-action-copy-line)
           ((symbol-function #'avy-action-yank)
            #'evilem--avy-action-yank-line)
           ((symbol-function #'avy-action-yank-line)
            #'evilem--avy-action-yank-line)
           ((symbol-function #'avy-action-kill-move)
            #'evilem--avy-action-kill-move-line)
           ((symbol-function #'avy-action-kill-stay)
            #'evilem--avy-action-kill-stay-line)
           ((symbol-function #'avy-action-teleport)
            #'evilem--avy-action-teleport-line))))

;;;###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)
                            (let ((old-point (point)))
                              (call-interactively func)
                              (unless include-invisible
                                (let ((skip-to (if (< (point) old-point)
                                                   #'overlay-start
                                                 #'overlay-end))
                                      (ov (car (overlays-at (point)))))
                                  (while (and ov (member
                                                  'invisible
                                                  (overlay-properties ov)))
                                    (goto-char (funcall skip-to 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 edge 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)
    (let ((func (evilem--unquote funcs)))
      (when (and (consp func)
                 (= (length func) 1))
        (setq func (evilem--unquote (car func))))
      (when (and (symbolp func)
                 (evil-has-command-properties-p func))
        `(setq evil-this-type
               ',(evil-get-command-property func :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
 :bind ((evil-state 'normal)))

;;;###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
 :bind ((evil-state 'normal)))

;;;###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-line-motion evilem-motion-next-line #'next-line nil)

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

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

;;;###autoload (autoload 'evilem-motion-previous-visual-line "evil-easymotion" nil t)
(evilem--make-line-motion evilem-motion-previous-visual-line #'previous-line 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
