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

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