[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 0cac589 04/78: Allow non-printing keys in avy-keys
From: |
Oleh Krehel |
Subject: |
[elpa] master 0cac589 04/78: Allow non-printing keys in avy-keys |
Date: |
Sat, 23 Jan 2016 13:59:36 +0000 |
branch: master
commit 0cac5890f1756e430b2860fff4123c3b16719a4e
Author: Tassilo Horn <address@hidden>
Commit: Tassilo Horn <address@hidden>
Allow non-printing keys in avy-keys
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'.
---
avy.el | 117 ++++++++++++++++++++++++++++++++++++++++------------------------
1 files changed, 73 insertions(+), 44 deletions(-)
diff --git a/avy.el b/avy.el
index 9de65ad..246450f 100644
--- a/avy.el
+++ b/avy.el
@@ -28,9 +28,9 @@
;; This package provides a generic completion method based on building
;; a balanced decision tree with each candidate being a leaf. To
;; 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
;; this completion method works only for things that you can see on
;; your screen, all at once:
@@ -55,8 +55,15 @@
:prefix "avy-")
(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
- "Default keys for jumping."
- :type '(repeat :tag "Keys" character))
+ "Default keys for jumping.
+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
"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)
"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
;;** Tree
(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))
sequence)
(cl-labels ((db (T p)
- (if (> T n)
- (if (eq (% n p) 0)
- (setq sequence
- (append sequence
- (cl-subseq a 1 (1+ p)))))
- (setf (nth T a) (nth (- T p) a))
- (db (1+ T) p)
- (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
- (setf (nth T a) j)
- (db (1+ T) T)))))
+ (if (> T n)
+ (if (eq (% n p) 0)
+ (setq sequence
+ (append sequence
+ (cl-subseq a 1 (1+ p)))))
+ (setf (nth T a) (nth (- T p) a))
+ (db (1+ T) p)
+ (cl-loop for j from (1+ (nth (- T p) a)) to (1- k) do
+ (setf (nth T a) j)
+ (db (1+ T) T)))))
(db 1 1)
(mapcar (lambda (n)
(nth n keys))
@@ -302,7 +320,7 @@ KEYS is the path from the root of `avy-tree' to LEAF."
(throw 'done nil))
(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 ""
"Store the current incomplete path during `avy-read'.")
@@ -325,14 +343,14 @@ multiple DISPLAY-FN invokations."
(push (cons path leaf) avy--leafs)))
(dolist (x avy--leafs)
(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)
(funcall cleanup-fn)
(if (setq branch (assoc char tree))
(if (eq (car (setq tree (cdr branch))) 'leaf)
(throw 'done (cdr tree))
(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))))))
(defun avy-read-de-bruijn (lst keys)
@@ -354,7 +372,7 @@ multiple DISPLAY-FN invokations."
(while (< i len)
(dolist (x (reverse alist))
(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)
(setq alist
(delq nil
@@ -363,7 +381,7 @@ multiple DISPLAY-FN invokations."
(cons (cdr (car x)) (cdr x))))
alist)))
(setq avy-current-path
- (concat avy-current-path (string char)))
+ (concat avy-current-path (string (avy--key-to-char char))))
(cl-incf i)
(unless alist
(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."
: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)
"Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)."
- (let ((str (propertize (apply #'string (reverse path))
- 'face 'avy-lead-face)))
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize (apply #'string (reverse path))
+ 'face 'avy-lead-face)))
(when (or avy-highlight-first (> (length str) 1))
(set-text-properties 0 1 '(face avy-lead-face-0) str))
(setq str (concat
@@ -550,32 +576,34 @@ LEAF is normally ((BEG . END) . WND)."
"Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)."
- (let ((str (propertize
- (string (car (last path)))
- 'face 'avy-lead-face))
- (pt (+ (if (consp (car leaf))
- (caar leaf)
- (car leaf))
- avy--overlay-offset))
- (wnd (cdr leaf)))
- (let ((ol (make-overlay pt (1+ pt)
- (window-buffer wnd)))
- (old-str (with-selected-window wnd
- (buffer-substring pt (1+ pt)))))
- (when avy-background
- (setq old-str (propertize
- old-str 'face 'avy-background-face)))
- (overlay-put ol 'window wnd)
- (overlay-put ol 'display (if (string= old-str "\n")
- (concat str "\n")
- str))
- (push ol avy--overlays-lead))))
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize
+ (string (car (last path)))
+ 'face 'avy-lead-face))
+ (pt (+ (if (consp (car leaf))
+ (caar leaf)
+ (car leaf))
+ avy--overlay-offset))
+ (wnd (cdr leaf))
+ (ol (make-overlay pt (1+ pt)
+ (window-buffer wnd)))
+ (old-str (with-selected-window wnd
+ (buffer-substring pt (1+ pt)))))
+ (when avy-background
+ (setq old-str (propertize
+ old-str 'face 'avy-background-face)))
+ (overlay-put ol 'window wnd)
+ (overlay-put ol 'display (if (string= old-str "\n")
+ (concat str "\n")
+ str))
+ (push ol avy--overlays-lead)))
(defun avy--overlay-at-full (path leaf)
"Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)."
- (let* ((str (propertize
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize
(apply #'string (reverse path))
'face 'avy-lead-face))
(len (length path))
@@ -652,8 +680,9 @@ LEAF is normally ((BEG . END) . WND)."
"Create an overlay with PATH at LEAF.
PATH is a list of keys from tree root to LEAF.
LEAF is normally ((BEG . END) . WND)."
- (let ((str (propertize (apply #'string (reverse path))
- 'face 'avy-lead-face)))
+ (let* ((path (mapcar #'avy--key-to-char path))
+ (str (propertize (apply #'string (reverse path))
+ 'face 'avy-lead-face)))
(when (or avy-highlight-first (> (length str) 1))
(set-text-properties 0 1 '(face avy-lead-face-0) str))
(setq str (concat
- [elpa] master updated (4300eae -> a6b7502), Oleh Krehel, 2016/01/23
- [elpa] master 8c8ad97 01/78: Add de-bruijn to the defcustom of avy-styles-alist, Oleh Krehel, 2016/01/23
- [elpa] master eb28aeb 02/78: avy.el (avy-goto-line): push mark for numeric line, Oleh Krehel, 2016/01/23
- [elpa] master 7928d11 05/78: Remove the old obsolete aliases, Oleh Krehel, 2016/01/23
- [elpa] master 0cac589 04/78: Allow non-printing keys in avy-keys,
Oleh Krehel <=
- [elpa] master 36e4d14 03/78: Respect the current input method for target chars, Oleh Krehel, 2016/01/23
- [elpa] master 465d5f2 07/78: Improve docstrings, Oleh Krehel, 2016/01/23
- [elpa] master 26123a7 10/78: avy.el (avy-goto-line): Fixup goto-line clause, Oleh Krehel, 2016/01/23
- [elpa] master 492ac49 11/78: avy.el (avy-pop-mark): Add, Oleh Krehel, 2016/01/23
- [elpa] master 3b9a60a 09/78: avy.el (avy-dispatch-alist): Upgrade to defcustom, Oleh Krehel, 2016/01/23
- [elpa] master d22493c 12/78: Autload avy-goto-word-or-subword-1, Oleh Krehel, 2016/01/23
- [elpa] master 1d1e4b6 06/78: Allow to switch action midway from goto to kill/mark/copy, Oleh Krehel, 2016/01/23
- [elpa] master 30067dd 14/78: avy.el (avy-action-goto): Don't push mark when region is active, Oleh Krehel, 2016/01/23
- [elpa] master a6db8a3 08/78: Rename avy--with-avy-keys to avy-with, Oleh Krehel, 2016/01/23
- [elpa] master 1e578a1 15/78: Considers letter case only if given Upcase letter, Oleh Krehel, 2016/01/23