ld/avy
1
0
Fork 0
mirror of https://github.com/abo-abo/avy.git synced 2025-10-13 13:33:03 +00:00
Code Issues Packages Projects Releases Wiki Activity

Allow non-printing keys in avy-keys

Browse Source 
Now you can set avy-keys also to the arrow keys and page up/down, e.g.,

  (setq avy-keys '(left right up down prior next))

and those will be displayed as ▲, ▼, ◀, ▶, △, ▽ in the overlays.  The
display is controlled by the variable `avy-key-to-char-alist'.
This commit is contained in:
Tassilo Horn 2015-07-14 08:31:49 +02:00
parent 36e4d145c8
commit 0cac5890f1
1 changed files with 73 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

117
avy.el
View File

@ -28,9 +28,9 @@
;; This package provides a generic completion method based on building ;; This package provides a generic completion method based on building
;; a balanced decision tree with each candidate being a leaf. To ;; a balanced decision tree with each candidate being a leaf. To
;; traverse the tree from the root to a desired leaf, typically a ;; traverse the tree from the root to a desired leaf, typically a
;; sequence of `read-char' can be used. ;; sequence of `read-key' can be used.
;; ;;
;; In order for `read-char' to make sense, the tree needs to be ;; In order for `read-key' to make sense, the tree needs to be
;; visualized appropriately, with a character at each branch node. So ;; visualized appropriately, with a character at each branch node. So
;; this completion method works only for things that you can see on ;; this completion method works only for things that you can see on
;; your screen, all at once: ;; your screen, all at once:
@ -55,8 +55,15 @@
:prefix "avy-") :prefix "avy-")
(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l) (defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
"Default keys for jumping." "Default keys for jumping.
:type '(repeat :tag "Keys" character)) Any key is either a character representing a self-inserting
key (a-z, A-Z, 0-9, punctuation, etc.) or a symbol denoting a
non-printing key like an arrow key (left, right, up, down). For
non-printing keys, a corresponding entry in
`avy-key-to-char-alist' must exists in order to visualize the key
in the avy overlays."
:type '(repeat :tag "Keys" (choice (character :tag "char")
(symbol :tag "non-printing key"))))
(defcustom avy-keys-alist nil (defcustom avy-keys-alist nil
"Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'." "Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
@ -168,6 +175,17 @@ For example, to make SPC do the same as ?a, use
avy-lead-face-2) avy-lead-face-2)
"Face sequence for `avy--overlay-at-full'.") "Face sequence for `avy--overlay-at-full'.")
(defvar avy-key-to-char-alist '((left . ?◀)
(right . ?▶)
(up . ?▲)
(down . ?▼)
(prior . ?△)
(next . ?▽))
"An alist from non-character keys to chars used to represent
them in the avy overlays. This alist must contain all keys used
in `avy-keys' which are no self-inserting keys and thus aren't
read as characters.")
;;* Internals ;;* Internals
;;** Tree ;;** Tree
(defmacro avy-multipop (lst n) (defmacro avy-multipop (lst n)
@ -186,16 +204,16 @@ For example, to make SPC do the same as ?a, use
(a (make-list (* n k) 0)) (a (make-list (* n k) 0))
sequence) sequence)
(cl-labels ((db (T p) (cl-labels ((db (T p)
(if (> T n) (if (> T n)
(if (eq (% n p) 0) (if (eq (% n p) 0)
(setq sequence (setq sequence
(append sequence (append sequence
(cl-subseq a 1 (1+ p))))) (cl-subseq a 1 (1+ p)))))
(setf (nth T a) (nth (- T p) a)) (setf (nth T a) (nth (- T p) a))
(db (1+ T) p) (db (1+ T) p)
(cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
(setf (nth T a) j) (setf (nth T a) j)
(db (1+ T) T))))) (db (1+ T) T)))))
(db 1 1) (db 1 1)
(mapcar (lambda (n) (mapcar (lambda (n)
(nth n keys)) (nth n keys))
@ -302,7 +320,7 @@ KEYS is the path from the root of `avy-tree' to LEAF."
(throw 'done nil)) (throw 'done nil))
(defvar avy-handler-function 'avy-handler-default (defvar avy-handler-function 'avy-handler-default
"A function to call for a bad `read-char' in `avy-read'.") "A function to call for a bad `read-key' in `avy-read'.")
(defvar avy-current-path "" (defvar avy-current-path ""
"Store the current incomplete path during `avy-read'.") "Store the current incomplete path during `avy-read'.")
@ -325,14 +343,14 @@ multiple DISPLAY-FN invokations."
(push (cons path leaf) avy--leafs))) (push (cons path leaf) avy--leafs)))
(dolist (x avy--leafs) (dolist (x avy--leafs)
(funcall display-fn (car x) (cdr x)))) (funcall display-fn (car x) (cdr x))))
(let ((char (funcall avy-translate-char-function (read-char))) (let ((char (funcall avy-translate-char-function (read-key)))
branch) branch)
(funcall cleanup-fn) (funcall cleanup-fn)
(if (setq branch (assoc char tree)) (if (setq branch (assoc char tree))
(if (eq (car (setq tree (cdr branch))) 'leaf) (if (eq (car (setq tree (cdr branch))) 'leaf)
(throw 'done (cdr tree)) (throw 'done (cdr tree))
(setq avy-current-path (setq avy-current-path
(concat avy-current-path (string char)))) (concat avy-current-path (string (avy--key-to-char char)))))
(funcall avy-handler-function char)))))) (funcall avy-handler-function char))))))
(defun avy-read-de-bruijn (lst keys) (defun avy-read-de-bruijn (lst keys)
@ -354,7 +372,7 @@ multiple DISPLAY-FN invokations."
(while (< i len) (while (< i len)
(dolist (x (reverse alist)) (dolist (x (reverse alist))
(avy--overlay-at-full (reverse (car x)) (cdr x))) (avy--overlay-at-full (reverse (car x)) (cdr x)))
(let ((char (funcall avy-translate-char-function (read-char)))) (let ((char (funcall avy-translate-char-function (read-key))))
(avy--remove-leading-chars) (avy--remove-leading-chars)
(setq alist (setq alist
(delq nil (delq nil
@ -363,7 +381,7 @@ multiple DISPLAY-FN invokations."
(cons (cdr (car x)) (cdr x)))) (cons (cdr (car x)) (cdr x))))
alist))) alist)))
(setq avy-current-path (setq avy-current-path
(concat avy-current-path (string char))) (concat avy-current-path (string (avy--key-to-char char))))
(cl-incf i) (cl-incf i)
(unless alist (unless alist
(funcall avy-handler-function char)))) (funcall avy-handler-function char))))
@ -522,12 +540,20 @@ When GROUP is non-nil, (BEG . END) should delimit that regex group."
Do this even when the char is terminating." Do this even when the char is terminating."
:type 'boolean) :type 'boolean)
(defun avy--key-to-char (c)
"If C is no character, translate it using `avy-key-to-char-alist'."
(if (characterp c)
c
(or (cdr (assoc c avy-key-to-char-alist))
(error "Unknown key %s" c))))
(defun avy--overlay-pre (path leaf) (defun avy--overlay-pre (path leaf)
"Create an overlay with PATH at LEAF. "Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF. PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)." LEAF is normally ((BEG . END) . WND)."
(let ((str (propertize (apply #'string (reverse path)) (let* ((path (mapcar #'avy--key-to-char path))
'face 'avy-lead-face))) (str (propertize (apply #'string (reverse path))
'face 'avy-lead-face)))
(when (or avy-highlight-first (> (length str) 1)) (when (or avy-highlight-first (> (length str) 1))
(set-text-properties 0 1 '(face avy-lead-face-0) str)) (set-text-properties 0 1 '(face avy-lead-face-0) str))
(setq str (concat (setq str (concat
@ -550,32 +576,34 @@ LEAF is normally ((BEG . END) . WND)."
"Create an overlay with PATH at LEAF. "Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF. PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)." LEAF is normally ((BEG . END) . WND)."
(let ((str (propertize (let* ((path (mapcar #'avy--key-to-char path))
(string (car (last path))) (str (propertize
'face 'avy-lead-face)) (string (car (last path)))
(pt (+ (if (consp (car leaf)) 'face 'avy-lead-face))
(caar leaf) (pt (+ (if (consp (car leaf))
(car leaf)) (caar leaf)
avy--overlay-offset)) (car leaf))
(wnd (cdr leaf))) avy--overlay-offset))
(let ((ol (make-overlay pt (1+ pt) (wnd (cdr leaf))
(window-buffer wnd))) (ol (make-overlay pt (1+ pt)
(old-str (with-selected-window wnd (window-buffer wnd)))
(buffer-substring pt (1+ pt))))) (old-str (with-selected-window wnd
(when avy-background (buffer-substring pt (1+ pt)))))
(setq old-str (propertize (when avy-background
old-str 'face 'avy-background-face))) (setq old-str (propertize
(overlay-put ol 'window wnd) old-str 'face 'avy-background-face)))
(overlay-put ol 'display (if (string= old-str "\n") (overlay-put ol 'window wnd)
(concat str "\n") (overlay-put ol 'display (if (string= old-str "\n")
str)) (concat str "\n")
(push ol avy--overlays-lead)))) str))
(push ol avy--overlays-lead)))
(defun avy--overlay-at-full (path leaf) (defun avy--overlay-at-full (path leaf)
"Create an overlay with PATH at LEAF. "Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF. PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)." LEAF is normally ((BEG . END) . WND)."
(let* ((str (propertize (let* ((path (mapcar #'avy--key-to-char path))
(str (propertize
(apply #'string (reverse path)) (apply #'string (reverse path))
'face 'avy-lead-face)) 'face 'avy-lead-face))
(len (length path)) (len (length path))
@ -652,8 +680,9 @@ LEAF is normally ((BEG . END) . WND)."
"Create an overlay with PATH at LEAF. "Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF. PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)." LEAF is normally ((BEG . END) . WND)."
(let ((str (propertize (apply #'string (reverse path)) (let* ((path (mapcar #'avy--key-to-char path))
'face 'avy-lead-face))) (str (propertize (apply #'string (reverse path))
'face 'avy-lead-face)))
(when (or avy-highlight-first (> (length str) 1)) (when (or avy-highlight-first (> (length str) 1))
(set-text-properties 0 1 '(face avy-lead-face-0) str)) (set-text-properties 0 1 '(face avy-lead-face-0) str))
(setq str (concat (setq str (concat