├── README.md └── annoying-arrows-mode.el /README.md: -------------------------------------------------------------------------------- 1 | # annoying-arrows-mode.el 2 | 3 | Entering annoying-arrows-mode makes emacs ring the bell in your face if you move 4 | long distances in the buffer one char at a time. 5 | 6 | ;; Annoying arrows mode 7 | (require 'annoying-arrows-mode) 8 | (global-annoying-arrows-mode) 9 | 10 | Set the `annoying-arrows-too-far-count' to adjust the length. 11 | 12 | ## Contributors 13 | 14 | * [Piers Cawley](https://github.com/pdcawley) added `aa-add-suggestion` for easier extension 15 | 16 | Thanks! 17 | -------------------------------------------------------------------------------- /annoying-arrows-mode.el: -------------------------------------------------------------------------------- 1 | ;;; annoying-arrows-mode.el --- Ring the bell if using arrows too much 2 | 3 | ;; Copyright (C) 2011 Magnar Sveen 4 | 5 | ;; Author: Magnar Sveen 6 | ;; Package-Requires: ((cl-lib "0.5")) 7 | ;; Version: 0.1.0 8 | 9 | ;; This program is free software; you can redistribute it and/or modify 10 | ;; it under the terms of the GNU General Public License as published by 11 | ;; the Free Software Foundation, either version 3 of the License, or 12 | ;; (at your option) any later version. 13 | 14 | ;; This program is distributed in the hope that it will be useful, 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 17 | ;; GNU General Public License for more details. 18 | 19 | ;; You should have received a copy of the GNU General Public License 20 | ;; along with this program. If not, see . 21 | 22 | ;;; Commentary: 23 | 24 | ;; Entering annoying-arrows-mode makes Emacs ring the bell in your 25 | ;; face if you use the arrow keys to move long distances. 26 | 27 | ;; Set the `annoying-arrows-too-far-count' to adjust the length. 28 | 29 | ;;; Code: 30 | 31 | (require 'cl-lib) 32 | 33 | (defvar annoying-arrows-too-far-count 10 34 | "Number of repeated arrow presses before Emacs gets annoyed.") 35 | 36 | (defvar annoying-arrows--commands '()) 37 | 38 | (defvar annoying-arrows--current-count 0) 39 | 40 | (defun annoying-arrows--commands-with-shortcuts (cmds) 41 | (cl-remove-if (lambda (cmd) 42 | (string-equal 43 | (substring (substitute-command-keys (format "\\[%S]" cmd)) 0 3) 44 | "M-x")) cmds)) 45 | 46 | (defun annoying-arrows--maybe-complain (cmd) 47 | (if (and (memq this-command annoying-arrows--commands) 48 | (eq this-command last-command)) 49 | (progn 50 | (cl-incf annoying-arrows--current-count) 51 | (when (> annoying-arrows--current-count annoying-arrows-too-far-count) 52 | (beep 1) 53 | (let* ((alts (annoying-arrows--commands-with-shortcuts (get cmd 'annoying-arrows--alts))) 54 | (alt (nth (random (length alts)) alts)) 55 | (key (substitute-command-keys (format "\\[%S]" alt)))) 56 | (message "Annoying! How about using %S (%s) instead?" alt key)))) 57 | (setq annoying-arrows--current-count 0))) 58 | 59 | ;;;###autoload 60 | (define-minor-mode annoying-arrows-mode 61 | "Annoying-Arrows emacs minor mode." 62 | nil "" nil) 63 | 64 | ;;;###autoload 65 | (define-globalized-minor-mode global-annoying-arrows-mode 66 | annoying-arrows-mode annoying-arrows-mode) 67 | 68 | 69 | (defmacro add-annoying-arrows-advice (cmd alternatives) 70 | `(progn 71 | (add-to-list 'annoying-arrows--commands (quote ,cmd)) 72 | (put (quote ,cmd) 'annoying-arrows--alts ,alternatives) 73 | (defadvice ,cmd (before annoying-arrows activate) 74 | (when annoying-arrows-mode 75 | (annoying-arrows--maybe-complain (quote ,cmd)))))) 76 | 77 | (add-annoying-arrows-advice previous-line '(ace-jump-mode backward-paragraph isearch-backward ido-imenu smart-up)) 78 | (add-annoying-arrows-advice next-line '(ace-jump-mode forward-paragraph isearch-forward ido-imenu smart-down)) 79 | (add-annoying-arrows-advice right-char '(jump-char-forward iy-go-to-char right-word smart-forward)) 80 | (add-annoying-arrows-advice left-char '(jump-char-backward iy-go-to-char-backward left-word smart-backward)) 81 | (add-annoying-arrows-advice forward-char '(jump-char-forward iy-go-to-char right-word smart-forward)) 82 | (add-annoying-arrows-advice backward-char '(jump-char-backward iy-go-to-char-backward left-word smart-backward)) 83 | 84 | (add-annoying-arrows-advice backward-delete-char-untabify '(backward-kill-word kill-region-or-backward-word subword-backward-kill)) 85 | (add-annoying-arrows-advice backward-delete-char '(backward-kill-word kill-region-or-backward-word subword-backward-kill)) 86 | ;;(add-annoying-arrows-advice delete-char '(subword-kill kill-line zap-to-char)) 87 | 88 | (defun aa-add-suggestion (cmd alternative) 89 | (let ((old-alts (or (get cmd 'annoying-arrows--alts) 90 | ()))) 91 | (unless (memq alternative old-alts) 92 | (put cmd 'annoying-arrows--alts (cons alternative old-alts))))) 93 | 94 | (defun aa-add-suggestions (cmd alternatives) 95 | (let ((old-alts (or (get cmd 'annoying-arrows--alts) 96 | ()))) 97 | (put cmd 'annoying-arrows--alts (append 98 | (cl-remove-if (lambda (cmd) 99 | (memq cmd old-alts)) alternatives) 100 | old-alts)))) 101 | 102 | (provide 'annoying-arrows-mode) 103 | ;;; annoying-arrows-mode.el ends here 104 | --------------------------------------------------------------------------------