diff --git a/README.org b/README.org index 02dd5f8..98ee10c 100644 --- a/README.org +++ b/README.org @@ -1,7 +1,7 @@ #+title: evil-leap #+author: Madeleine Sydney -Evil's answer to Neovim's answer to the mouse +Emacs' answer to Neovim's answer to the mouse * Tasks @@ -14,7 +14,7 @@ CLOSED: [2024-11-23 Sat 09:07] ** DONE Leap backwards CLOSED: [2024-11-24 Sun 08:55] -** TODO Equivalence classes +** TODO Character equivalence classes ** TODO Match newlines with [[kbd:][SPC SPC]] @@ -74,3 +74,7 @@ ab ** TODO Support input methods [[https://github.com/emacs-evil/evil/issues/5][Weird.]] + +** TODO Leap to sexp/tree-sitter obj? + +** TODO There's no reason to depend on Evil diff --git a/evil-leap.el b/evil-leap.el index c3c4f54..2280496 100644 --- a/evil-leap.el +++ b/evil-leap.el @@ -29,8 +29,8 @@ (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." + "TODO A list of characters that you will never use immediately after an +evil-leap jump." :group 'evil-leap :type "List of characters") @@ -391,8 +391,6 @@ corresponding to each occurence of P." "TODO Something something something. Keyword arguments - :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." (unwind-protect @@ -405,12 +403,12 @@ Keyword arguments ;; REVIEW: Could we the preview/branch functionality be rewriten in terms of ;; higher-level functions? Preferably ones included in the public API? -;;;###autoload +;;;###autoload (autoload 'evil-leap-directional "evil-leap" nil t) (evil-define-motion evil-leap-directional (count backward-p) "TODO" :jump t :type 'exclusive - (interactive) + (interactive "") ;; 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 @@ -427,20 +425,26 @@ Keyword arguments (evil-leap--remove-all-labels)) (evil-leap--remove-all-labels)) -;;;###autoload +;;;###autoload (autoload 'evil-leap-forward "evil-leap" nil t) (evil-define-motion evil-leap-forward (count) "TODO" :jump t :type 'exclusive + (interactive "") (evil-leap-directional count nil)) -;;;###autoload +;;;###autoload (autoload 'evil-leap-backward "evil-leap" nil t) (evil-define-motion evil-leap-backward (count) "TODO" :jump t :type 'exclusive + (interactive "") (evil-leap-directional count t)) +;; (map! +;; :mn "s" #'evil-leap-forward +;; :mn "S" #'evil-leap-backward) + (provide 'evil-leap) diff --git a/scratch.el b/scratch.el deleted file mode 100644 index d30b8b7..0000000 --- a/scratch.el +++ /dev/null @@ -1,160 +0,0 @@ -;; -*- 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)) - -(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. 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)). - (if safe? - (syd/label-targets-safe targets) - (syd/label-targets-unsafe targets)))) - -(defun syd/do-auto-jump (labeled-targets) - (when-let ((tgt-and-overlay (ht-get labeled-targets -1))) - (funcall syd/leap-action (car tgt-and-overlay)))) - -(defun syd/select-from-labeled-targets (labeled-targets) - (unwind-protect - (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 syd/leap-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/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)))) - (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 (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/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 (_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* ((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))) - ;; 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)))