-
-
Notifications
You must be signed in to change notification settings - Fork 0
/
evil-motion-trainer.el
154 lines (127 loc) · 6.49 KB
/
evil-motion-trainer.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
;;; evil-motion-trainer.el --- Trains you to use better evil motions. -*- lexical-binding: t; -*-
;; Copyright (C) 2020 Martin Baillie
;; Author: Martin Baillie <martin@baillie.id>
;; Keywords: learning
;; Version: 0.1.0
;; Package-Requires: ((cl-lib "0.5"))
;;; License:
;; This file is NOT part of GNU Emacs.
;;
;; 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 2 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 <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Entering `evil-motion-trainer-mode' makes Emacs drop lazily repeated
;; "hjkl"-based evil motions after a configurable threshold, forcing you to think
;; about a more precise motion.
;;; Code:
;;; The following code learns a lot from the old "annoying-arrows" packages.
(require 'cl-lib)
(defgroup evil-motion-trainer nil "Evil motion trainer" :group 'evil)
(defvar evil-motion-trainer-mode nil
"Trains you to use better evil motions.")
(defvar evil-motion-trainer-threshold 8
"Number of permitted repeated key presses.")
(defvar evil-motion-trainer-super-annoying-mode nil
"Switches to and shows an annoying message in another buffer.")
(defvar evil-motion-trainer--current-count 2
"Defaults to two because first two keypresses are registered as one.")
;; Since evil-commands sometimes call themselves recursively (evil-forward-char
;; calls itself 2-3 times, for example) we need to ensure that the user actually
;; pressed the keys for those commands several times. We do this by ensuring
;; that the time between command calls is longer than some threshold. Without
;; this check, 3-4 calls of evil-forward char would be enough to trigger.
(defvar emt--old-time (float-time))
(defvar emt--old-temp nil)
(defun emt--check-enough-time-passed (new-time)
"Check to see if enough time has passed between NEW-TIME and last call."
(progn
(setq emt--old-temp emt--old-time)
(setq emt--old-time new-time)
(< 0.01 (- emt--old-time emt--old-temp))))
(defvar emt--commands nil)
(defun emt--commands-with-shortcuts (cmds)
"The subset of CMDS with shortcuts."
(cl-remove-if (lambda (cmd)
(and
(>= (length (substitute-command-keys (format "\\[%S]" cmd))) 3)
(string-equal
(substring (substitute-command-keys (format "\\[%S]" cmd)) 0 3)
"M-x"))) cmds))
(defun emt--maybe-block-motion (orig-fn &rest args)
"Advises whether the evil motion ORIG-FN called with ARGS should be dropped."
(let ((cmd this-command))
(when (and evil-motion-trainer-mode
(emt--check-enough-time-passed (float-time)))
(if (and (memq this-command emt--commands)
(or (eq this-command last-command)
(eq (get cmd 'alternative-cmd) last-command)))
(progn
(cl-incf evil-motion-trainer--current-count)
(when (> evil-motion-trainer--current-count evil-motion-trainer-threshold)
(let* ((alts (emt--commands-with-shortcuts (get cmd 'emt--alts)))
(alt (nth (random (length alts)) alts))
(key (substitute-command-keys (format "\\[%S]" alt)))
(msg (format "%s How about using %s (%s) instead?"
(propertize "Lazy motion!" 'face 'bold)
(propertize (format "%S" alt) 'face 'font-lock-type-face)
(propertize (format "%s" key) 'face 'font-lock-keyword-face))))
(if evil-motion-trainer-super-annoying-mode
(progn (switch-to-buffer (get-buffer-create "Evil motion trainer"))
(insert msg))
(message msg)))))
(setq evil-motion-trainer--current-count 2)))
(when (< evil-motion-trainer--current-count evil-motion-trainer-threshold)
(apply orig-fn args))))
(defmacro add-emt-advice (cmd alternatives &optional native-cmd)
"Add advice around the provided CMD motion using ALTERNATIVES for suggestions.
The optional NATIVE-CMD is also considered in motion counting."
`(progn
(add-to-list 'emt--commands (quote ,cmd))
(put (quote ,cmd) 'emt--alts ,alternatives)
(put (quote ,cmd) 'alternative-cmd (quote ,native-cmd))
(put (quote ,native-cmd) 'alternative-cmd (quote ,cmd))
(advice-add (quote ,cmd) :around #'emt--maybe-block-motion)))
;; Add some default evil motion training advice.
(add-emt-advice evil-next-line
'(evil-search-forward evil-jumper/backward evil-snipe-s)
next-line)
(add-emt-advice evil-next-visual-line
'(evil-search-forward evil-jumper/backward evil-snipe-s)
next-line)
(add-emt-advice evil-previous-line
'(evil-search-backward evil-snipe-S evil-jumper/backward evil-find-char-backward)
previous-line)
(add-emt-advice evil-previous-visual-line
'(evil-search-backward evil-snipe-S evil-jumper/backward evil-find-char-backward)
previous-line)
(add-emt-advice evil-forward-char
'(evil-search-forward evil-find-char evil-snipe-f evil-snipe-s))
(add-emt-advice evil-backward-char
'(evil-search-backward evil-find-char-backward evil-snipe-F evil-snipe-S))
;;;###autoload
(define-minor-mode evil-motion-trainer-mode "Evil motion trainer minor mode.")
;;;###autoload
(define-globalized-minor-mode
global-evil-motion-trainer-mode evil-motion-trainer-mode evil-motion-trainer-mode)
(defun emt-add-suggestion (cmd alternative)
"Add ALTERNATIVE as a suggestion for CMD."
(let ((old-alts (or (get cmd 'emt--alts)
())))
(unless (memq alternative old-alts)
(put cmd 'emt--alts (cons alternative old-alts)))))
(defun emt-add-suggestions (cmd alternatives)
"Add ALTERNATIVES as suggestions to CMD."
(let ((old-alts (or (get cmd 'emt--alts)
())))
(put cmd 'emt--alts (append (cl-remove-if
(lambda (cmd) (memq cmd old-alts)) alternatives) old-alts))))
(provide 'evil-motion-trainer)
;;; evil-motion-trainer.el ends here