msyds/evil-leap
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

init

Browse Source
This commit is contained in:
Madeleine Sydney
2024-11-19 18:53:18 -07:00
commit 0dbf837cbf
3 changed files with 295 additions and 0 deletions
Download Patch File Download Diff File Expand all files Collapse all files

4
README.org Normal file
View File

@@ -0,0 +1,4 @@
#+title: evil-leap
#+author: Madeleine Sydney
Evil's answer to Neovim's answer to the mouse

114
evil-leap.el Normal file
View File

@@ -0,0 +1,114 @@
;;; evil-leap.el --- Evil's answer to Neovim's answer to the mouse -*- lexical-binding: t; -*-
;;
;; Copyright (C) 2024 Madeleine Sydney
;;
;; Author: Madeleine Sydney <lomiskiam@gmail.com>
;; Maintainer: Madeleine Sydney <lomiskiam@gmail.com>
;; Created: October 06, 2024
;; Modified: October 06, 2024
;; Version: 0.0.1
;; Keywords: evil movement
;; Homepage: https://github.com/crumbtoo/leap.el
;; Package-Requires: ((emacs "24.3"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;;
;;
;;; Code:
(defcustom evil-leap-safe-labels
(string-to-list "sfnut/SFNLHMUGTZ?")
"TODO A list of characters that you will never use immediately after an evil-leap
jump."
:group 'evil-leap
:type "List of characters")
(defcustom evil-leap-labels
(string-to-list "sfnjklhodweimbuyvrgtaqpcxz/SFNJKLHODWEIMBUYVRGTAQPCXZ?")
;; (append evil-leap-safe-labels
;; (string-to-list "jklhodweimbyvrgaqpcxzJKODWEIBYVRAQPCX"))
"TODO A list of characters to use as labels."
:group 'evil-leap
:type "List of characters")
;; (defun evil-leap--collect-keys (&optional forward?)
;; (let ((collected-keys nil))
;; (dolist (i '(0 1) collected-keys)
;; (let ((prompt (format ">%s" (mapconcat #'char-to-string collected-keys))))
;; (appendq! collected-keys (list (evil-read-key prompt)))))))
(defcustom evil-leap-character-aspect-ratio
0.3
"TODO"
:group 'evil-leap
:type "Number")
(defcustom evil-leap-equivalence-classes '((?\s ?\n ?\t ?\r))
"TODO"
:group 'evil-leap
:type "List of lists of characters")
(defun evil-leap--gather-targets-forward (regexp)
(let ((end-of-visible (window-end))
targets)
(save-excursion
(while (re-search-forward regexp end-of-visible t)
(save-excursion
(goto-char (match-beginning 0))
(push (list (point) (current-column) (line-number-at-pos))
targets))))
(reverse targets)))
(defun evil-leap--euclidean-distance (x1 y1 x2 y2)
(let* ((width (abs (- x1 x2)))
(height (* (abs (- y1 y2))
evil-leap-character-aspect-ratio))
(hypotenuse (sqrt (+ (* width width)
(* height height)))))
hypotenuse))
(defun evil-leap--sort-by-euclidean-distance-from-point (targets)
(let ((point-x (current-column))
(point-y (line-number-at-pos)))
(sort targets
:lessp
(lambda (pos1 pos2)
(pcase-let ((`(,_ ,pos1-x ,pos1-y) pos1)
(`(,_ ,pos2-x ,pos2-y) pos2))
(< (evil-leap--euclidean-distance point-x point-y pos1-x pos1-y)
(evil-leap--euclidean-distance point-x point-y pos2-x pos2-y)))))))
;; (defun evil-leap--label-targets (targets)
;; (let ((ht (make-hash-table :test 'equal)))
;; (dolist (c ))))
;; define-inline?
(defun evil-leap-jump-to (target)
(goto-char (car target)))
(defun evil-leap (&rest args)
"TODO Something something something.
Keyword arguments
:backward-p BOOL
:action ACTION
:targets TARGETS A list of targets, or a Lisp procedure returning such a
list. Each target should be a list of form
(POS LINE COLUMN . XS)."
(let ((backward-p (plist-get args :backward-p))
(action (or (plist-get args :action) #'evil-leap-jump-to))
(targets (plist-get args :targets)))
))
(evil-define-motion evil-leap-s (count keys)
"TODO"
:jump t
:type 'exclusive
(interactive)
(evil-leap--collect-keys))
(provide 'evil-leap)
;;; evil-leap.el ends here

177
scratch.el Normal file
View File

@@ -0,0 +1,177 @@
;; -*- lexical-binding: t -*-
;;;; core ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(require 'ht)
(defun syd/remove-highlights ()
(remove-overlays nil nil 'category 'evil-leap))
(defun syd/add-label (pos label)
"TODO returns overlay"
;; The label shall be displayed two characters /after/ `pos'. This ensures
;; the user is able to see the entirety of the target; that is, the first
;; character, located at `pos', and the second, immediately following.
(let ((overlay (make-overlay (+ pos 2) (+ pos 3)))
(label-string (string label)))
(put-text-property 0 1 'face (list :background "red") label-string)
(overlay-put overlay 'category 'evil-leap)
(overlay-put overlay 'before-string label-string)
;; Normally, we want the labels to cover the buffer's text, rather than
;; shifting it to the side; however, doing so unconditionally will cover
;; newlines, collapsing multiple visual lines onto one.
(unless (= (char-after (+ pos 2)) ?\n)
(overlay-put overlay 'invisible t))
overlay))
(defun syd/label-targets-safe (targets)
"TODO returns a hash table mapping labels to targets and overlays"
;; Nasty! While I'd prefer to iterate over `zip evil-leap-safe-labels
;; targets`, this isn't Haskell; each iteration through `targets', we pop
;; `labels'.
(let ((labels evil-leap-safe-labels)
(labeled-targets (ht-create 'eq)))
;; The first target is assigned the label -1, to indicate that it can be
;; auto-jumped to. The remaining targets are labeled as you'd expect.
(ht-set! labeled-targets -1 (cons (car targets) nil))
(dolist (tgt (cdr targets) labeled-targets)
(pcase-let* ((`(,pos ,_ ,_) tgt)
(lbl (pop labels))
(overlay (syd/add-label pos lbl)))
(ht-set! labeled-targets lbl (cons tgt overlay))))))
(defun syd/label-targets-unsafe (targets)
"TODO returns a hash table mapping labels to targets and overlays"
;; TODO: space labels don't work
(let ((labels (append evil-leap-labels (-cycle '(?\s))))
(labeled-targets (ht-create 'eq)))
(dolist (tgt targets labeled-targets)
(pcase-let* ((`(,pos ,_ ,_) tgt)
(lbl (pop labels))
(overlay (syd/add-label pos lbl)))
(ht-set! labeled-targets lbl (cons tgt overlay))))))
(defun syd/label-targets (targets)
"TODO returns a hash table mapping labels to targets and overlays"
(let ((safe? (<= (length targets) (length evil-leap-safe-labels))))
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; FIXME: I think this should be (+ 1 (length evil-leap-safe-labels)).
(if safe?
(syd/label-targets-safe targets)
(syd/label-targets-unsafe targets))))
(defun syd/do-auto-jump (action labeled-targets)
(when-let ((tgt-and-overlay (ht-get labeled-targets -1)))
(funcall action (car tgt-and-overlay))))
(defun syd/select-targets (opts targets)
;; Safe labels are preferred, but are not available when there are more
;; targets than safe labels.
(unwind-protect
(let ((labeled-targets (syd/label-targets targets))
(action (plist-get opts :action)))
(syd/do-auto-jump action labeled-targets)
(if-let ((given-key (evil-read-key))
(selected-target-and-overlay (ht-get labeled-targets given-key)))
(funcall action (car selected-target-and-overlay))
(error "TODO no such label")))
(syd/remove-highlights)))
(defun syd/select-labeled-targets (opts labeled-targets)
(unwind-protect
(let ((action (plist-get opts :action)))
(syd/do-auto-jump action labeled-targets)
(if-let ((given-key (evil-read-key))
(selected-target-and-overlay (ht-get labeled-targets given-key)))
(funcall action (car selected-target-and-overlay))
(error "TODO no such label"))))
(syd/remove-highlights))
;;;; gathering ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun syd/insert-branch-target (table second-char target)
(ht-set! table
second-char
(cons target (ht-get table second-char))))
(defun syd/gather-branches-forward (first-char)
"Traverse each visible two-character sequence of FIRST-CHAR followed by
another character. The returned value will be a hash map, mapping discovered
second characters to a list of targets representing their occurences."
(let ((end-of-visible (window-end))
(pattern (rx-to-string `(seq ,first-char (group anychar))))
;; (pattern (string first-char ?.))
(table (ht-create 'equal)))
(save-excursion
(while (re-search-forward pattern end-of-visible t)
;; We are forced to save-excursion a second time, lest we enter a
;; feedback loop, where `re-search-forward' moves to a match, and
;; `goto-char' jumps to a position *preceding* the match.
(save-excursion
(goto-char (match-beginning 0))
(let ((second-char (aref (match-string 1) 0)) ; string->char
(target (list (point) (current-column) (line-number-at-pos))))
(syd/insert-branch-target table second-char target)))))
;; Reverse each list of targets.
(ht-each (lambda (k v) (ht-set! table k (reverse v)))
table)
table))
;;;; entry point ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; (defun syd/gather-targets-forward (regexp)
;; (let ((end-of-visible (window-end))
;; targets)
;; (save-excursion
;; (while (re-search-forward regexp end-of-visible t)
;; ;; We are forced to save-excursion a second time, lest we enter a
;; ;; feedback loop, where `re-search-forward' moves to a match, and
;; ;; `goto-char' jumps to a position *preceding* the match.
;; (save-excursion
;; (goto-char (match-beginning 0))
;; (push (list (point) (current-column) (line-number-at-pos))
;; targets))))
;; (reverse targets)))
(defun syd/label-branch-targets (branches)
"Mutate BRANCHES by calling `syd/label-targets' on each value, and replacing
it with the result."
(ht-each (lambda (k tgts)
(ht-set! branches k (syd/label-targets tgts)))
branches))
(defun syd/unlabel-other-branches (second-char branches)
"Delete every overlay referenced by BRANCHES, *except* those under the branch
with key SECOND-CHAR."
(ht-each (lambda (k labeled-tgts)
(unless (eq k second-char)
(ht-each (lambda (lbl tgt-and-overlay)
;; cdr may be nil in precense of auto-jump.
(when-let ((overlay (cdr tgt-and-overlay)))
(delete-overlay overlay)))
labeled-tgts)))
branches))
(evil-define-motion syd/leap-forward (count)
"TODO"
:jump t
:type 'exclusive
(interactive)
(let* ((action (lambda (x) (goto-char (car x))))
(first-char (evil-read-key))
(branches (syd/gather-branches-forward first-char))
(_ (syd/label-branch-targets branches))
(second-char (evil-read-key))
(_ (syd/unlabel-other-branches second-char branches))
(labeled-targets (ht-get branches second-char)))
;; (print branches)
;; (print labeled-targets)
;; nil
(syd/select-labeled-targets
(list :action (lambda (x) (goto-char (car x))))
labeled-targets)
))
;; (defun syd/demo-targets (regexp)
;; (syd/select-targets
;; (list :action (lambda (x) (goto-char (car x))))
;; (syd/gather-targets-forward regexp)))