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

idk

Browse Source
This commit is contained in:
Madeleine Sydney
2024-11-26 14:20:58 -07:00
parent 0dbf837cbf
commit e49883a6c9
3 changed files with 427 additions and 97 deletions
Download Patch File Download Diff File Expand all files Collapse all files

62
README.org
View File

@@ -2,3 +2,65 @@
#+author: Madeleine Sydney
Evil's answer to Neovim's answer to the mouse
* Tasks
** TODO Equivalence classes
** TODO Many targets w/ [[kbd:][SPC]] and [[kbd:][DEL]] labels
** TODO Match newlines with [[kbd:][SPC SPC]]
** DONE Passthrough input on fail
CLOSED: [2024-11-23 Sat 09:07]
** DONE Leap backwards
CLOSED: [2024-11-24 Sun 08:55]
** TODO Leap from window
** TODO Only leap to visible targets
Currently, we take care to only search from the point to the beg/end of the window, but we don't account for concealed text, e.g. folded org subtrees.
~evil-snipe~ achieves this by, in their search function, checking if the target is invisible, and skipping the match, if so.
#+begin_src elisp
(defun evil-snipe--seek-re (data scope count)
(let ((regex (mapconcat #'cdr data ""))
result)
(when (and evil-snipe-skip-leading-whitespace
(looking-at-p "[ \t]+")
(string-match-p "^[ \t]+" (mapconcat #'car data "")))
(setq regex (concat regex "[^ \t]")))
(when (setq result (re-search-forward regex scope t count))
; ↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓↓
(if (or (invisible-p (match-beginning 0)) ; ←
(invisible-p (1- (match-end 0)))) ; ←
(evil-snipe--seek-re data scope count) ; ←
; ↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑↑
result))))
#+end_src
** TODO Leap any direction
** TODO Cleanup w/ ~pre-command-hook~
** TODO Extract equivalence classes from =char-fold-table=
** TODO Documentation
*** TODO Clarify terminology
- "Auto-jump" really means "call ~evil-leap-action~ automatically."
- "Jump to target" really means "call ~evil-leap-action~ on target."
*** TODO Comparison with =evil-snipe=
*** TODO Comparison with ~leap.nvim~
** TODO Correctly use =count= prefix argument
** TODO Support input methods
[[https://github.com/emacs-evil/evil/issues/5][Weird.]]

367
evil-leap.el
View File

@@ -7,18 +7,26 @@
;; Created: October 06, 2024
;; Modified: October 06, 2024
;; Version: 0.0.1
;; Keywords: evil movement
;; Keywords: convenience text
;; Homepage: https://github.com/crumbtoo/leap.el
;; Package-Requires: ((emacs "24.3"))
;; Package-Requires: ((emacs "26.1") (evil "1.2.12"))
;;
;; This file is not part of GNU Emacs.
;;
;;; Commentary:
;;
;; Evil leap.
;;
;;
;;; Code:
(require 'evil)
(eval-when-compile (require 'evil))
(require 'ht)
(require 'cl-lib)
; Options
(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
@@ -34,12 +42,6 @@ jump."
: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"
@@ -51,16 +53,171 @@ jump."
: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)))
(defface evil-leap-label-face '((t :inherit isearch))
"TODO"
:group 'evil-leap)
(defcustom evil-leap-use-char-fold-table t
"TODO"
:group 'evil-leap
:type "Boolean")
; Core
(cl-defstruct
(evil-leap-target
(:constructor evil-leap-make-target))
"TODO"
pos
line
column
;; TODO: Perhaps we should be tracking /buffers/ rather than windows...
(window
nil
:type "TODO window or nil"
:documentation
"TODO nil means current window")
overlay
payload)
(defun evil-leap--target-at-point ()
"TODO"
(evil-leap-make-target :pos (point)
:line (line-number-at-pos)
:column (current-column)
:window (or (minibuffer-selected-window)
(selected-window))))
(define-inline evil-leap-jump-to-target (target)
(when-let ((window (evil-leap-target-window target)))
(select-window window))
(goto-char (evil-leap-target-pos target)))
(defvar evil-leap-action #'evil-leap-jump-to-target)
(defun evil-leap--remove-all-labels ()
(remove-overlays nil nil 'category 'evil-leap))
;; ₁₂
(defun evil-leap--add-overlay-target! (target label)
"TODO returns overlay and sets overlay slot"
;; 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* ((pos (evil-leap-target-pos target))
;; If `target' has an associated window, grab the buffer associated
;; thereupon — we need to place the overlay in the correct buffer, of
;; course!
(buffer (-some-> (evil-leap-target-window target)
window-buffer))
;; If overlay already exists, just make sure it's in the correct
;; position. If it doesn't exist, create it.
(overlay (if-let ((ov (evil-leap-target-overlay target)))
(move-overlay ov (+ pos 2) (+ pos 3)
buffer)
(make-overlay (+ pos 2) (+ pos 3)
buffer)))
(label-string (string label)))
(put-text-property 0 1 'face 'evil-leap-label-face 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 (memq (char-after (+ pos 2)) '(?\n ?\r))
(overlay-put overlay 'invisible t))
(setf (evil-leap-target-overlay target) overlay)
overlay))
(defun evil-leap--add-to-labeled-targets! (labeled-targets label target)
"TODO Mutate LABELED-TARGETS by inserting value TARGET under key LABEL — with
spice!
Spice: If an entry with key LABEL already exists in LABELED-TARGETS, a fresh
hash table will be created and inserted into LABELED-TARGETS under key '?\\s'.
This fresh hash table will itself have a key '?\\b' pointing back to
LABELED-TARGETS. If this '?\\s' entry already exists in LABELED-TARGETS, it
will instead try to insert it into /that/ hash table, continuing until a
suitable home is found.
This all implies that important parts of evil-leap will enter the eldritch world
of Undefined Behaviour, should either `evil-leap-safe-labels' or
`evil-leap-labels' contain '?\\s' or '?\\b'."
;; If the label is already present in `labeled-targets', we insert it into the
;; "next" map at key '?\s'.
(let ((existing-targets (ht-get labeled-targets label target)))
;; REVIEW: This is terribly inefficient to be ran in a tight loop (i.e.
;; `evil-leap--label-targets').
(if (<= (length evil-leap-labels) (length existing-targets))
;; If labeled-targets[?\s] (the "next map") exists, ...
(if-let ((next-labeled-targets (ht-get labeled-targets ?\s)))
;; ... recurse into it. ...
(evil-leap--add-to-labeled-targets!
next-labeled-targets label target)
;; ... If it doesn't, create a new hash table, stored in
;; `labeled-targets' at key '?\s', containing nought but a back-link key
;; ('?\b')[1], and the given label/target pair[2].
(print "here!")
(ht-set! labeled-targets ?\s
(ht (?\b labeled-targets) ; [1]
(label (list target))))) ; [2]
;; The label does not exist, meaning we needn't muck around with the next
;; map. Proceed normally with `ht-set!'!
(ht-set! labeled-targets label target))))
(defun evil-leap--label-targets-safe (targets)
"TODO returns a hash table mapping labels to targets"
;; 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 `auto-jump', to indicate that it can be
;; auto-jumped to. The remaining targets are labeled as you'd expect.
(ht-set! labeled-targets 'auto-jump (car targets))
(dolist (target (cdr targets) labeled-targets)
(let ((lbl (pop labels)))
(evil-leap--add-overlay-target! target lbl)
(evil-leap--add-to-labeled-targets! labeled-targets lbl target)))))
(defun evil-leap--label-targets-unsafe (targets)
"TODO returns a hash table mapping labels to targets"
;; TODO: space labels don't work
(let ((labels (-cycle evil-leap-labels))
(labeled-targets (ht-create 'eq)))
(dolist (target targets labeled-targets)
(let ((lbl (pop labels)))
(evil-leap--add-overlay-target! target lbl)
(evil-leap--add-to-labeled-targets! labeled-targets lbl target)))))
(defun evil-leap--label-targets (targets)
"TODO returns a hash table mapping labels to targets. Labels are
represented by characters. Adds overlays for labels"
;; Safe labels are preferred, but are not available when there are more
;; targets than safe labels.
(let ((safe? (<= (length targets) (length evil-leap-safe-labels))))
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; FIXME: I think this should be (+ 1 (length evil-leap-safe-labels)) to
;; account for the "anonymous label" given to the auto-jump target.
(if safe?
(evil-leap--label-targets-safe targets)
(evil-leap--label-targets-unsafe targets))))
(defun evil-leap--update-target-overlays! (labeled-targets)
"TODO Create or update overlays to visually present a set of targets'
associated labels."
;; TODO: blah
(ht-each (lambda (k v)
(cond
;; No-op; auto-jump targets are not labeled in the typical sense.
((eq k 'auto-jump)
nil)
((eq k ?\s)
(error "TODO: Recurse into "))))
labeled-targets))
(defun evil-leap--euclidean-distance (x1 y1 x2 y2)
(let* ((width (abs (- x1 x2)))
@@ -75,40 +232,168 @@ jump."
(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)))))))
(lambda (target-1 target-2)
(< (evil-leap--euclidean-distance
point-x
point-y
(evil-leap-target-column target-1)
(evil-leap-target-line target-1))
(evil-leap--euclidean-distance
point-x
point-y
(evil-leap-target-column target-2)
(evil-leap-target-line target-2)))))))
;; (defun evil-leap--label-targets (targets)
;; (let ((ht (make-hash-table :test 'equal)))
;; (dolist (c ))))
(defun evil-leap--try-auto-jump (labeled-targets)
(when-let ((auto-jump-target (ht-get labeled-targets 'auto-jump)))
(funcall evil-leap-action auto-jump-target)))
;; define-inline?
(defun evil-leap-jump-to (target)
(goto-char (car target)))
(defun evil-leap-select-from-labeled-targets (labeled-targets)
"Given LABELED-TARGETS, a hash table mapping labels to targets,
- auto-jump to the first target, if possible;
- read a key from the user;
- if the key corresponds to a label, jump to it;
- otherwise, let the input `fall through,' as if Leap were never here."
(progn
;; REVIEW: Should the return value of `evil-leap-action' be returned by us?
(evil-leap--try-auto-jump labeled-targets)
(let ((given-key (evil-read-key)))
(if-let ((selected-target (ht-get labeled-targets given-key)))
(funcall evil-leap-action selected-target)
;; If we are given a key that does not correspond to any label, we let
;; it 'fall through' to give it a proper run through Emacs' command
;; loop. We do this as a formality in the general case, but it is
;; essential to the idea behind auto-jump.
(defun evil-leap (&rest args)
;; REVIEW: Should the passthrough behaviour be configurable in the
;; non-auto-jump case?
(progn (push given-key unread-command-events)
nil)))))
; Labels
(defun evil-leap--label-branch-targets! (branches)
"Mutate BRANCHES by calling `evil-leap--label-targets' on each value, and
replacing it with the result."
(ht-each (lambda (k tgts)
(ht-set! branches k (evil-leap--label-targets tgts)))
branches))
(defun evil-leap--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-targets)
(unless (eq k second-char)
(ht-each
(lambda (_label target)
;; 1. A value in `labeled-targets' isn't always a target (e.g. entries
;; at '?\s' and '?\b').
;; 2. If a target is an auto-jump candidate, its `overlay' slot is nil.
(when-let ((overlay (and (evil-leap-target-p target)
(evil-leap-target-overlay target))))
(delete-overlay overlay)))
labeled-targets)))
branches))
; Gathering
(defun evil-leap--insert-branch-target (table second-char target)
(ht-set! table
second-char
(cons target (ht-get table second-char))))
(cl-defun evil-leap--gather-branches (first-char &key backward-p)
"TODO Searches the scope (for maddy: currently, this just means the visible
portion of the buffer) for two-character pairs, consisting of FIRST-CHAR
followed by some SECOND-CHAR. For each P = (FIRST-CHAR, SECOND-CHAR) pair
found, the returned hash table maps SECOND-CHAR to a list of targets
corresponding to each occurence of P."
(let* ((start-of-visible (window-start))
(end-of-visible (window-end))
(pattern (rx-to-string `(seq ,first-char (group anychar))))
(table (ht-create 'equal))
;; TODO: Clean this up. }:\
(search (if backward-p
(lambda () (re-search-backward pattern start-of-visible t))
(lambda () (re-search-forward pattern end-of-visible t)))))
(save-excursion
(while (funcall search)
;; 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 (evil-leap--target-at-point)))
(evil-leap--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
(cl-defun evil-leap
(&key targets)
"TODO Something something something.
Keyword arguments
:backward-p BOOL
:action ACTION
:no-overlays BOOL Non-nil if labels shall not be visually marked with
overlays.
: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)))
))
list."
(unwind-protect
(evil-leap-select-from-labeled-targets
(evil-leap--label-targets targets))
;; TODO: would it be faster to go through `labeled-targets' and unlabel them
;; ourselves?
(evil-leap--remove-all-labels))
(evil-leap--remove-all-labels))
(evil-define-motion evil-leap-s (count keys)
;; REVIEW: Could we the preview/branch functionality be rewriten in terms of
;; higher-level functions? Preferably ones included in the public API?
;;;###autoload
(evil-define-motion evil-leap-directional (count backward-p)
"TODO"
:jump t
:type 'exclusive
(interactive)
(evil-leap--collect-keys))
;; FIXME: If the search pattern finds zero targets, `labeled-targets' ends up
;; being nil, which leads to an error in `evil-leap--select-from-labeled-targets'.
(unwind-protect
(let* ((first-char (evil-read-key))
(branches (evil-leap--gather-branches first-char
:backward-p backward-p))
(_ (evil-leap--label-branch-targets! branches))
(second-char (evil-read-key))
(_ (evil-leap--unlabel-other-branches second-char branches))
(labeled-targets (ht-get branches second-char)))
(pp labeled-targets)
(evil-leap-select-from-labeled-targets labeled-targets))
;; TODO: would it be faster to go through `labeled-targets' and unlabel them
;; ourselves?
(evil-leap--remove-all-labels))
(evil-leap--remove-all-labels))
;;;###autoload
(evil-define-motion evil-leap-forward (count)
"TODO"
:jump t
:type 'exclusive
(evil-leap-directional count nil))
;;;###autoload
(evil-define-motion evil-leap-backward (count)
"TODO"
:jump t
:type 'exclusive
(evil-leap-directional count t))
(provide 'evil-leap)
;;; evil-leap.el ends here

93
scratch.el
View File

@@ -1,8 +1,14 @@
;; -*- lexical-binding: t -*-
;;;; core ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; -*- lexical-binding: t; -*-
(require 'ht)
(defun syd/jump-to-target (target)
(goto-char (car target)))
(defvar syd/leap-action #'syd/jump-to-target)
(defun syd/remove-highlights ()
(remove-overlays nil nil 'category 'evil-leap))
@@ -51,7 +57,11 @@
(ht-set! labeled-targets lbl (cons tgt overlay))))))
(defun syd/label-targets (targets)
"TODO returns a hash table mapping labels to targets and overlays"
"TODO returns a hash table mapping labels to targets and overlays. Labels are
represented by characters. Each target is a list of form (POS LINE COLUMN
WINDOW . XS)."
;; Safe labels are preferred, but are not available when there are more
;; targets than safe labels.
(let ((safe? (<= (length targets) (length evil-leap-safe-labels))))
;; ^^^^^^^^^^^^^^^^^^^^^^^^^^^^^^
;; FIXME: I think this should be (+ 1 (length evil-leap-safe-labels)).
@@ -59,47 +69,37 @@
(syd/label-targets-safe targets)
(syd/label-targets-unsafe targets))))
(defun syd/do-auto-jump (action labeled-targets)
(defun syd/do-auto-jump (labeled-targets)
(when-let ((tgt-and-overlay (ht-get labeled-targets -1)))
(funcall action (car tgt-and-overlay))))
(funcall syd/leap-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.
(defun syd/select-from-labeled-targets (labeled-targets)
(unwind-protect
(let ((labeled-targets (syd/label-targets targets))
(action (plist-get opts :action)))
(syd/do-auto-jump action labeled-targets)
(progn
(syd/do-auto-jump syd/leap-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))
(funcall syd/leap-action (car selected-target-and-overlay))
(error "TODO no such label"))))
(syd/remove-highlights))
;;;; gathering ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; gathering
(defun syd/insert-branch-target (table second-char target)
(ht-set! table
second-char
(cons target (ht-get table second-char))))
(defun syd/target-at-point (&optional window)
(list (point) (line-number-at-pos) (current-column) window))
(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)
@@ -109,28 +109,15 @@ second characters to a list of targets representing their occurences."
(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))))
(target (syd/target-at-point)))
(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)))
;;; entry point
(defun syd/label-branch-targets (branches)
"Mutate BRANCHES by calling `syd/label-targets' on each value, and replacing
@@ -144,34 +131,30 @@ it with the result."
with key SECOND-CHAR."
(ht-each (lambda (k labeled-tgts)
(unless (eq k second-char)
(ht-each (lambda (lbl tgt-and-overlay)
(ht-each (lambda (_label 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))
(defun syd/leap ()
)
(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))
(let* ((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)))
;; TODO: would it be faster to go through `labeled-targets' and unlabel them
;; ourselves?
(unwind-protect
(syd/select-from-labeled-targets labeled-targets)
(syd/remove-labels))
(syd/remove-labels)))