branch: master
commit c897759d02483b442e5123bf2d8e74f7e5fa5890
Author: Oleh Krehel <ohwoeo...@gmail.com>
Commit: Oleh Krehel <ohwoeo...@gmail.com>
Update avy interface
* avy.el (avy-tree): Rename from `avy-read'.
(avy-tree): Replace LEAF with (cons 'leaf LEAF). This way, leafs are
much easier to distinguish - there's no need to know anything about LEAF
structure to distinguish it from an internal node.
(avy-traverse): New defun.
(avy-read): The function that calls `read-char'.
* ace-window.el (aw--lead-overlay): Change arglist.
(aw--make-leading-chars): Remove in favor of `avy-read'.
(aw-select): Use `avy-read'.
* avy-test.el (avy-tree): Update test.
---
ace-window.el | 54 +++++++++++++++++++-----------------------------------
avy-test.el | 26 +++++++++++++-------------
avy.el | 47 +++++++++++++++++++++++++++++++++++++++++++----
3 files changed, 75 insertions(+), 52 deletions(-)
diff --git a/ace-window.el b/ace-window.el
index a09f4a4..0697ded 100644
--- a/ace-window.el
+++ b/ace-window.el
@@ -150,9 +150,12 @@ Use M-0 `ace-window' to toggle this value."
(setq aw-overlays-back nil)
(aw--remove-leading-chars))
-(defun aw--lead-overlay (char pt wnd)
- "Create an overlay with CHAR at PT in WND."
- (let* ((ol (make-overlay pt (1+ pt) (window-buffer wnd)))
+(defun aw--lead-overlay (char leaf)
+ "Create an overlay with CHAR at LEAF.
+LEAF is (PT . WND)."
+ (let* ((pt (car leaf))
+ (wnd (cdr leaf))
+ (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
(old-str (with-selected-window wnd
(buffer-substring pt (1+ pt))))
(new-str
@@ -172,14 +175,6 @@ Use M-0 `ace-window' to toggle this value."
(overlay-put ol 'display new-str)
(push ol aw-overlays-lead)))
-(defun aw--make-leading-chars (tree &optional char)
- "Create leading char overlays for TREE.
-CHAR is used to store the overlay char in the recursion."
- (dolist (br tree)
- (if (integerp (cadr br))
- (aw--lead-overlay (or char (car br)) (cadr br) (cddr br))
- (aw--make-leading-chars (cdr br) (or char (car br))))))
-
(defun aw--remove-leading-chars ()
"Remove leading char overlays."
(mapc #'delete-overlay aw-overlays-lead)
@@ -219,35 +214,24 @@ Amend MODE-LINE to the mode line for the duration of the
selection."
(setq final-window (next-window final-window nil next-window-scope)))
final-window)
(t
- (let* ((candidate-list
- (mapcar (lambda (wnd)
- ;; can't jump if the buffer is empty
- (with-current-buffer (window-buffer wnd)
- (when (= 0 (buffer-size))
- (insert " ")))
- (cons (aw-offset wnd) wnd))
- wnd-list))
- (avy-tree (avy-read candidate-list
- aw-keys)))
+ (let ((candidate-list
+ (mapcar (lambda (wnd)
+ ;; can't jump if the buffer is empty
+ (with-current-buffer (window-buffer wnd)
+ (when (= 0 (buffer-size))
+ (insert " ")))
+ (cons (aw-offset wnd) wnd))
+ wnd-list)))
(aw--make-backgrounds wnd-list)
(setq ace-window-mode mode-line)
(force-mode-line-update)
;; turn off helm transient map
(remove-hook 'post-command-hook 'helm--maybe-update-keymap)
- (or (catch 'done
- (unwind-protect
- (while avy-tree
- (aw--make-leading-chars avy-tree)
- (let ((char (read-char))
- branch)
- (aw--remove-leading-chars)
- (if (setq branch (assoc char avy-tree))
- (when (windowp (cdr (setq avy-tree (cdr branch))))
- (throw 'done (cdr avy-tree)))
- (message "No such position candidate.")
- (throw 'done nil))))
- (aw--done)))
- start-window))))))
+ (unwind-protect (or (cdr (avy-read (avy-tree candidate-list aw-keys)
+ #'aw--lead-overlay
+ #'aw--remove-leading-chars))
+ start-window)
+ (aw--done)))))))
;;* Interactive
;;;###autoload
diff --git a/avy-test.el b/avy-test.el
index e9a0d2f..84d9766 100644
--- a/avy-test.el
+++ b/avy-test.el
@@ -24,19 +24,19 @@
(equal (avy-subdiv 65 4)
'(16 16 16 17))))
-(ert-deftest avy-read ()
+(ert-deftest avy-tree ()
(should
(equal
- (avy-read '(0 1 2 3 4 5 6 7 8 9 10)
+ (avy-tree '(0 1 2 3 4 5 6 7 8 9 10)
'(?a ?s ?d ?f ?g ?h ?j ?k ?l))
- '((97 . 0)
- (115 . 1)
- (100 . 2)
- (102 . 3)
- (103 . 4)
- (104 . 5)
- (106 . 6)
- (107 . 7)
- (108 (97 . 8)
- (115 . 9)
- (100 . 10))))))
+ '((97 leaf . 0)
+ (115 leaf . 1)
+ (100 leaf . 2)
+ (102 leaf . 3)
+ (103 leaf . 4)
+ (104 leaf . 5)
+ (106 leaf . 6)
+ (107 leaf . 7)
+ (108 (97 leaf . 8)
+ (115 leaf . 9)
+ (100 leaf . 10))))))
diff --git a/avy.el b/avy.el
index 9ee4cce..b572c45 100644
--- a/avy.el
+++ b/avy.el
@@ -23,7 +23,7 @@
;;; Commentary:
;;
-;; Given a LIST and KEYS, `avy-read' will build a balanced tree of
+;; Given a LIST and KEYS, `avy-tree' will build a balanced tree of
;; degree B, where B is the length of KEYS.
;;
;; The corresponding member of KEYS is placed in each internal node of
@@ -42,7 +42,7 @@
(nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
nil))))
-(defun avy-read (lst keys)
+(defun avy-tree (lst keys)
"Coerce LST into a balanced tree.
The degree of the tree is the length of KEYS.
KEYS are placed appropriately on internal nodes."
@@ -51,13 +51,14 @@ KEYS are placed appropriately on internal nodes."
((rd (ls)
(let ((ln (length ls)))
(if (< ln len)
- (cl-pairlis keys ls)
+ (cl-pairlis keys
+ (mapcar (lambda (x) (cons 'leaf x)) ls))
(let ((ks (copy-sequence keys))
res)
(dolist (s (avy-subdiv ln len))
(push (cons (pop ks)
(if (eq s 1)
- (pop ls)
+ (cons 'leaf (pop ls))
(rd (avy-multipop ls s))))
res))
(nreverse res))))))
@@ -77,6 +78,44 @@ KEYS are placed appropriately on internal nodes."
(- n (* n1 x1) (* n2 x2)))
(make-list n2 x2))))
+(defun avy-traverse (tree walker &optional recur-key)
+ "Traverse TREE generated by `avy-tree'.
+WALKER is a function that takes KEY and LEAF.
+
+RECUR-KEY is used in recursion.
+
+LEAF is a member of LST argument of `avy-tree'.
+
+KEY is a member of KEYS argument of `avy-tree'. It corresponds
+to the key of the highest branch of TREE that contains LEAF."
+ (dolist (br tree)
+ (let ((key (or recur-key (car br))))
+ (if (eq (cadr br) 'leaf)
+ (funcall walker key (cddr br))
+ (avy-traverse (cdr br) walker key)))))
+
+(defun avy-read (tree display-fn cleanup-fn)
+ "Select a leaf from TREE using consecutive `read-char'.
+
+DISPLAY-FN should take CHAR and LEAF and signify that LEAFs
+associated with CHAR will be selected if CHAR is pressed. This is
+commonly done by adding a CHAR overlay at LEAF position.
+
+CLEANUP-FN should take no arguments and remove the effects of
+multiple DISPLAY-FN invokations."
+
+ (catch 'done
+ (while tree
+ (avy-traverse tree display-fn)
+ (let ((char (read-char))
+ branch)
+ (funcall cleanup-fn)
+ (if (setq branch (assoc char tree))
+ (if (eq (car (setq tree (cdr branch))) 'leaf)
+ (throw 'done (cdr tree)))
+ (user-error "No such candidate")
+ (throw 'done nil))))))
+
(provide 'avy)
;;; avy.el ends here
