-
-
Notifications
You must be signed in to change notification settings - Fork 108
/
avy.el
2242 lines (2049 loc) · 82.2 KB
/
avy.el
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
824
825
826
827
828
829
830
831
832
833
834
835
836
837
838
839
840
841
842
843
844
845
846
847
848
849
850
851
852
853
854
855
856
857
858
859
860
861
862
863
864
865
866
867
868
869
870
871
872
873
874
875
876
877
878
879
880
881
882
883
884
885
886
887
888
889
890
891
892
893
894
895
896
897
898
899
900
901
902
903
904
905
906
907
908
909
910
911
912
913
914
915
916
917
918
919
920
921
922
923
924
925
926
927
928
929
930
931
932
933
934
935
936
937
938
939
940
941
942
943
944
945
946
947
948
949
950
951
952
953
954
955
956
957
958
959
960
961
962
963
964
965
966
967
968
969
970
971
972
973
974
975
976
977
978
979
980
981
982
983
984
985
986
987
988
989
990
991
992
993
994
995
996
997
998
999
1000
;;; avy.el --- Jump to arbitrary positions in visible text and select text quickly. -*- lexical-binding: t -*-
;; Copyright (C) 2015-2020 Free Software Foundation, Inc.
;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/avy
;; Version: 0.5.0
;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
;; Keywords: point, location
;; This file is part of GNU Emacs.
;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 3, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; For a full copy of the GNU General Public License
;; see <http://www.gnu.org/licenses/>.
;;; Commentary:
;;
;; With Avy, you can move point to any position in Emacs – even in a
;; different window – using very few keystrokes. For this, you look at
;; the position where you want point to be, invoke Avy, and then enter
;; the sequence of characters displayed at that position.
;;
;; If the position you want to jump to can be determined after only
;; issuing a single keystroke, point is moved to the desired position
;; immediately after that keystroke. In case this isn't possible, the
;; sequence of keystrokes you need to enter is comprised of more than
;; one character. Avy uses a decision tree where each candidate position
;; is a leaf and each edge is described by a character which is distinct
;; per level of the tree. By entering those characters, you navigate the
;; tree, quickly arriving at the desired candidate position, such that
;; Avy can move point to it.
;;
;; Note that this only makes sense for positions you are able to see
;; when invoking Avy. These kinds of positions are supported:
;;
;; * character positions
;; * word or subword start positions
;; * line beginning positions
;; * link positions
;; * window positions
;;
;; If you're familiar with the popular `ace-jump-mode' package, this
;; package does all that and more, without the implementation
;; headache.
;;; Code:
(require 'cl-lib)
(require 'ring)
;;* Customization
(defgroup avy nil
"Jump to things tree-style."
:group 'convenience
:prefix "avy-")
(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
"Default keys for jumping.
Any key is either a character representing a self-inserting
key (letters, digits, 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 exist in order to visualize the key
in the avy overlays.
If `avy-style' is set to words, make sure there are at least three
keys different than the following: a, e, i, o, u, y"
:type '(repeat :tag "Keys" (choice
(character :tag "char")
(symbol :tag "non-printing key"))))
(defconst avy--key-type
'(choice :tag "Command"
(const avy-goto-char)
(const avy-goto-char-2)
(const avy-isearch)
(const avy-goto-line)
(const avy-goto-subword-0)
(const avy-goto-subword-1)
(const avy-goto-word-0)
(const avy-goto-word-1)
(const avy-copy-line)
(const avy-copy-region)
(const avy-move-line)
(const avy-move-region)
(const avy-kill-whole-line)
(const avy-kill-region)
(const avy-kill-ring-save-whole-line)
(const avy-kill-ring-save-region)
(function :tag "Other command")))
(defcustom avy-keys-alist nil
"Alist of avy-jump commands to `avy-keys' overriding the default `avy-keys'."
:type `(alist
:key-type ,avy--key-type
:value-type (repeat :tag "Keys" character)))
(defcustom avy-orders-alist '((avy-goto-char . avy-order-closest))
"Alist of candidate ordering functions.
Usually, candidates appear in their point position order."
:type `(alist
:key-type ,avy--key-type
:value-type function))
(defcustom avy-words
'("am" "by" "if" "is" "it" "my" "ox" "up"
"ace" "act" "add" "age" "ago" "aim" "air" "ale" "all" "and" "ant" "any"
"ape" "apt" "arc" "are" "arm" "art" "ash" "ate" "awe" "axe" "bad" "bag"
"ban" "bar" "bat" "bay" "bed" "bee" "beg" "bet" "bid" "big" "bit" "bob"
"bot" "bow" "box" "boy" "but" "cab" "can" "cap" "car" "cat" "cog" "cop"
"cow" "cry" "cup" "cut" "day" "dew" "did" "die" "dig" "dim" "dip" "dog"
"dot" "dry" "dub" "dug" "dye" "ear" "eat" "eel" "egg" "ego" "elf" "eve"
"eye" "fan" "far" "fat" "fax" "fee" "few" "fin" "fit" "fix" "flu" "fly"
"foe" "fog" "for" "fox" "fry" "fun" "fur" "gag" "gap" "gas" "gel" "gem"
"get" "gig" "gin" "gnu" "god" "got" "gum" "gun" "gut" "guy" "gym" "had"
"hag" "ham" "has" "hat" "her" "hid" "him" "hip" "his" "hit" "hop" "hot"
"how" "hub" "hue" "hug" "hut" "ice" "icy" "imp" "ink" "inn" "ion" "ire"
"ivy" "jab" "jam" "jar" "jaw" "jet" "job" "jog" "joy" "key" "kid" "kit"
"lag" "lap" "lay" "let" "lid" "lie" "lip" "lit" "lob" "log" "lot" "low"
"mad" "man" "map" "mat" "may" "men" "met" "mix" "mob" "mop" "mud" "mug"
"nag" "nap" "new" "nil" "nod" "nor" "not" "now" "nun" "oak" "odd" "off"
"oil" "old" "one" "orb" "ore" "ork" "our" "out" "owl" "own" "pad" "pan"
"par" "pat" "paw" "pay" "pea" "pen" "pet" "pig" "pin" "pit" "pod" "pot"
"pry" "pub" "pun" "put" "rag" "ram" "ran" "rat" "raw" "ray" "red" "rib"
"rim" "rip" "rob" "rod" "rot" "row" "rub" "rug" "rum" "run" "sad" "sat"
"saw" "say" "sea" "see" "sew" "she" "shy" "sin" "sip" "sit" "six" "ski"
"sky" "sly" "sob" "son" "soy" "spy" "sum" "sun" "tab" "tad" "tag" "tan"
"tap" "tar" "tax" "tea" "the" "tie" "tin" "tip" "toe" "ton" "too" "top"
"toy" "try" "tub" "two" "urn" "use" "van" "war" "was" "wax" "way" "web"
"wed" "wet" "who" "why" "wig" "win" "wit" "woe" "won" "wry" "you" "zap"
"zip" "zoo")
"Words to use in case `avy-style' is set to `words'.
Every word should contain at least one vowel i.e. one of the following
characters: a, e, i, o, u, y
They do not have to be sorted but no word should be a prefix of another one."
:type '(repeat string))
(defcustom avy-style 'at-full
"The default method of displaying the overlays.
Use `avy-styles-alist' to customize this per-command."
:type '(choice
(const :tag "Pre" pre)
(const :tag "At" at)
(const :tag "At Full" at-full)
(const :tag "Post" post)
(const :tag "De Bruijn" de-bruijn)
(const :tag "Words" words)))
(defcustom avy-styles-alist nil
"Alist of avy-jump commands to the style for each command.
If the commands isn't on the list, `avy-style' is used."
:type '(alist
:key-type (choice :tag "Command"
(const avy-goto-char)
(const avy-goto-char-2)
(const avy-isearch)
(const avy-goto-line)
(const avy-goto-subword-0)
(const avy-goto-subword-1)
(const avy-goto-word-0)
(const avy-goto-word-1)
(const avy-copy-line)
(const avy-copy-region)
(const avy-move-line)
(const avy-move-region)
(const avy-kill-whole-line)
(const avy-kill-region)
(const avy-kill-ring-save-whole-line)
(const avy-kill-ring-save-region)
(function :tag "Other command"))
:value-type (choice
(const :tag "Pre" pre)
(const :tag "At" at)
(const :tag "At Full" at-full)
(const :tag "Post" post)
(const :tag "De Bruijn" de-bruijn)
(const :tag "Words" words))))
(defcustom avy-dispatch-alist
'((?x . avy-action-kill-move)
(?X . avy-action-kill-stay)
(?t . avy-action-teleport)
(?m . avy-action-mark)
(?n . avy-action-copy)
(?y . avy-action-yank)
(?Y . avy-action-yank-line)
(?i . avy-action-ispell)
(?z . avy-action-zap-to-char))
"List of actions for `avy-handler-default'.
Each item is (KEY . ACTION). When KEY not on `avy-keys' is
pressed during the dispatch, ACTION is set to replace the default
`avy-action-goto' once a candidate is finally selected."
:type
'(alist
:key-type (choice (character :tag "Char"))
:value-type (choice
(const :tag "Mark" avy-action-mark)
(const :tag "Copy" avy-action-copy)
(const :tag "Kill and move point" avy-action-kill-move)
(const :tag "Kill" avy-action-kill-stay))))
(defcustom avy-background nil
"When non-nil, a gray background will be added during the selection."
:type 'boolean)
(defcustom avy-all-windows t
"Determine the list of windows to consider in search of candidates."
:type
'(choice
(const :tag "All Frames" all-frames)
(const :tag "This Frame" t)
(const :tag "This Window" nil)))
(defcustom avy-case-fold-search t
"Non-nil if searches should ignore case."
:type 'boolean)
(defcustom avy-word-punc-regexp "[!-/:-@[-`{-~]"
"Regexp of punctuation chars that count as word starts for `avy-goto-word-1.
When nil, punctuation chars will not be matched.
\"[!-/:-@[-`{-~]\" will match all printable punctuation chars."
:type 'regexp)
(defcustom avy-goto-word-0-regexp "\\b\\sw"
"Regexp that determines positions for `avy-goto-word-0'."
:type '(choice
(const :tag "Default" "\\b\\sw")
(const :tag "Symbol" "\\_<\\(\\sw\\|\\s_\\)")
(const :tag "Not whitespace" "[^ \r\n\t]+")
(regexp :tag "Regex")))
(defcustom avy-ignored-modes '(image-mode doc-view-mode pdf-view-mode)
"List of modes to ignore when searching for candidates.
Typically, these modes don't use the text representation."
:type 'list)
(defcustom avy-single-candidate-jump t
"In case there is only one candidate jumps directly to it."
:type 'boolean)
(defcustom avy-del-last-char-by '(?\b ?\d)
"List of event types, i.e. key presses, that delete the last
character read. The default represents `C-h' and `DEL'. See
`event-convert-list'."
:type 'list)
(defcustom avy-escape-chars '(?\e ?\C-g)
"List of characters that quit avy during `read-char'."
:type 'list)
(defvar avy-ring (make-ring 20)
"Hold the window and point history.")
(defvar avy-translate-char-function #'identity
"Function to translate user input key into another key.
For example, to make SPC do the same as ?a, use
\(lambda (c) (if (= c 32) ?a c)).")
(defface avy-lead-face-0
'((t (:foreground "white" :background "#4f57f9")))
"Face used for first non-terminating leading chars.")
(defface avy-lead-face-1
'((t (:foreground "white" :background "gray")))
"Face used for matched leading chars.")
(defface avy-lead-face-2
'((t (:foreground "white" :background "#f86bf3")))
"Face used for leading chars.")
(defface avy-lead-face
'((t (:foreground "white" :background "#e52b50")))
"Face used for the leading chars.")
(defface avy-background-face
'((t (:foreground "gray40")))
"Face for whole window background during selection.")
(defface avy-goto-char-timer-face
'((t (:inherit highlight)))
"Face for matches during reading chars using `avy-goto-char-timer'.")
(defconst avy-lead-faces '(avy-lead-face
avy-lead-face-0
avy-lead-face-2
avy-lead-face
avy-lead-face-0
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 printable chars used in avy overlays.
This alist must contain all keys used in `avy-keys' which are not
self-inserting keys and thus aren't read as characters.")
;;* Internals
;;** Tree
(defmacro avy-multipop (lst n)
"Remove LST's first N elements and return them."
`(if (<= (length ,lst) ,n)
(prog1 ,lst
(setq ,lst nil))
(prog1 ,lst
(setcdr
(nthcdr (1- ,n) (prog1 ,lst (setq ,lst (nthcdr ,n ,lst))))
nil))))
(defun avy--de-bruijn (keys n)
"De Bruijn sequence for alphabet KEYS and subsequences of length N."
(let* ((k (length keys))
(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)))))
(db 1 1)
(mapcar (lambda (n)
(nth n keys))
sequence))))
(defun avy--path-alist-1 (lst seq-len keys)
"Build a De Bruin sequence from LST.
SEQ-LEN is how many elements of KEYS it takes to identify a match."
(let ((db-seq (avy--de-bruijn keys seq-len))
prev-pos prev-seq prev-win path-alist)
;; The De Bruijn seq is cyclic, so append the seq-len - 1 first chars to
;; the end.
(setq db-seq (nconc db-seq (cl-subseq db-seq 0 (1- seq-len))))
(cl-labels ((subseq-and-pop ()
(when (nth (1- seq-len) db-seq)
(prog1 (cl-subseq db-seq 0 seq-len)
(pop db-seq)))))
(while lst
(let* ((cur (car lst))
(pos (cond
;; ace-window has matches of the form (pos . wnd)
((integerp (car cur)) (car cur))
;; avy-jump have form ((start . end) . wnd)
((consp (car cur)) (caar cur))
(t (error "Unexpected match representation: %s" cur))))
(win (cdr cur))
(path (if prev-pos
(let ((diff (if (eq win prev-win)
(- pos prev-pos)
0)))
(when (and (> diff 0) (< diff seq-len))
(while (and (nth (1- seq-len) db-seq)
(not
(eq 0
(cl-search
(cl-subseq prev-seq diff)
(cl-subseq db-seq 0 seq-len)))))
(pop db-seq)))
(subseq-and-pop))
(subseq-and-pop))))
(if (not path)
(setq lst nil
path-alist nil)
(push (cons path (car lst)) path-alist)
(setq prev-pos pos
prev-seq path
prev-win win
lst (cdr lst))))))
(nreverse path-alist)))
(defun avy-order-closest (x)
(abs (- (if (numberp (car x))
(car x)
(caar x))
(point))))
(defvar avy-command nil
"Store the current command symbol.
E.g. 'avy-goto-line or 'avy-goto-char.")
(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."
(let* ((len (length keys))
(order-fn (cdr (assq avy-command avy-orders-alist)))
(lst (if order-fn
(cl-sort lst #'< :key order-fn)
lst)))
(cl-labels
((rd (ls)
(let ((ln (length ls)))
(if (< ln len)
(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)
(cons 'leaf (pop ls))
(rd (avy-multipop ls s))))
res))
(nreverse res))))))
(rd lst))))
(defun avy-subdiv (n b)
"Distribute N in B terms in a balanced way."
(let* ((p (1- (floor (+ (log n b) 1e-6))))
(x1 (expt b p))
(x2 (* b x1))
(delta (- n x2))
(n2 (/ delta (- x2 x1)))
(n1 (- b n2 1)))
(append
(make-list n1 x1)
(list
(- 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 KEYS and LEAF.
RECUR-KEY is used in recursion.
LEAF is a member of LST argument of `avy-tree'.
KEYS is the path from the root of `avy-tree' to LEAF."
(dolist (br tree)
(let ((key (cons (car br) recur-key)))
(if (eq (cadr br) 'leaf)
(funcall walker key (cddr br))
(avy-traverse (cdr br) walker key)))))
(defvar avy-action nil
"Function to call at the end of select.")
(defun avy-handler-default (char)
"The default handler for a bad CHAR."
(let (dispatch)
(cond ((setq dispatch (assoc char avy-dispatch-alist))
(unless (eq avy-style 'words)
(setq avy-action (cdr dispatch)))
(throw 'done 'restart))
((memq char avy-escape-chars)
;; exit silently
(throw 'done 'abort))
((eq char ??)
(avy-show-dispatch-help)
(throw 'done 'restart))
((mouse-event-p char)
(signal 'user-error (list "Mouse event not handled" char)))
(t
(message "No such candidate: %s, hit `C-g' to quit."
(if (characterp char) (string char) char))))))
(defun avy-show-dispatch-help ()
"Display action shortucts in echo area."
(let ((len (length "avy-action-")))
(message "%s" (mapconcat
(lambda (x)
(format "%s: %s"
(propertize
(char-to-string (car x))
'face 'aw-key-face)
(substring (symbol-name (cdr x)) len)))
avy-dispatch-alist
" "))))
(defvar avy-handler-function 'avy-handler-default
"A function to call for a bad `read-key' in `avy-read'.")
(defvar avy-current-path ""
"Store the current incomplete path during `avy-read'.")
(defun avy-mouse-event-window (char)
"If CHAR is a mouse event, return the window of the event if any or the selected window.
Return nil if not a mouse event."
(when (mouse-event-p char)
(cond ((windowp (posn-window (event-start char)))
(posn-window (event-start char)))
((framep (posn-window (event-start char)))
(frame-selected-window (posn-window (event-start char))))
(t (selected-window)))))
(defun avy-read (tree display-fn cleanup-fn)
"Select a leaf from TREE using consecutive `read-key'.
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 invocations."
(catch 'done
(setq avy-current-path "")
(while tree
(let ((avy--leafs nil))
(avy-traverse tree
(lambda (path leaf)
(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-key)))
window
branch)
(funcall cleanup-fn)
(if (setq window (avy-mouse-event-window char))
(throw 'done (cons char window))
(if (setq branch (assoc char tree))
(progn
;; Ensure avy-current-path stores the full path prior to
;; exit so other packages can utilize its value.
(setq avy-current-path
(concat avy-current-path (string (avy--key-to-char char))))
(if (eq (car (setq tree (cdr branch))) 'leaf)
(throw 'done (cdr tree))))
(funcall avy-handler-function char)))))))
(defun avy-read-de-bruijn (lst keys)
"Select from LST dispatching on KEYS."
;; In theory, the De Bruijn sequence B(k,n) has k^n subsequences of length n
;; (the path length) usable as paths, thus that's the lower bound. Due to
;; partially overlapping matches, not all subsequences may be usable, so it's
;; possible that the path-len must be incremented, e.g., if we're matching
;; for x and a buffer contains xaxbxcx only every second subsequence is
;; usable for the four matches.
(catch 'done
(let* ((path-len (ceiling (log (length lst) (length keys))))
(alist (avy--path-alist-1 lst path-len keys)))
(while (not alist)
(cl-incf path-len)
(setq alist (avy--path-alist-1 lst path-len keys)))
(let* ((len (length (caar alist)))
(i 0))
(setq avy-current-path "")
(while (< i len)
(dolist (x (reverse alist))
(avy--overlay-at-full (reverse (car x)) (cdr x)))
(let ((char (funcall avy-translate-char-function (read-key))))
(avy--remove-leading-chars)
(setq alist
(delq nil
(mapcar (lambda (x)
(when (eq (caar x) char)
(cons (cdr (car x)) (cdr x))))
alist)))
(setq avy-current-path
(concat avy-current-path (string (avy--key-to-char char))))
(cl-incf i)
(unless alist
(funcall avy-handler-function char))))
(cdar alist)))))
(defun avy-read-words (lst words)
"Select from LST using WORDS."
(catch 'done
(let ((num-words (length words))
(num-entries (length lst))
alist)
;; If there are not enough words to cover all the candidates,
;; we use a De Bruijn sequence to generate the remaining ones.
(when (< num-words num-entries)
(let ((keys avy-keys)
(bad-keys '(?a ?e ?i ?o ?u ?y))
(path-len 1)
(num-remaining (- num-entries num-words))
tmp-alist)
;; Delete all keys which could lead to duplicates.
;; We want at least three keys left to work with.
(dolist (x bad-keys)
(when (memq x keys)
(setq keys (delq ?a keys))))
(when (< (length keys) 3)
(signal 'user-error
'("Please add more keys to the variable `avy-keys'.")))
;; Generate the sequence and add the keys to the existing words.
(while (not tmp-alist)
(cl-incf path-len)
(setq tmp-alist (avy--path-alist-1 lst path-len keys)))
(while (>= (cl-decf num-remaining) 0)
(push (mapconcat 'string (caar tmp-alist) nil) (cdr (last words)))
(setq tmp-alist (cdr tmp-alist)))))
(dolist (x lst)
(push (cons (string-to-list (pop words)) x) alist))
(setq avy-current-path "")
(while (or (> (length alist) 1)
(caar alist))
(dolist (x (reverse alist))
(avy--overlay-at-full (reverse (car x)) (cdr x)))
(let ((char (funcall avy-translate-char-function (read-key))))
(avy--remove-leading-chars)
(setq alist
(delq nil
(mapcar (lambda (x)
(when (eq (caar x) char)
(cons (cdr (car x)) (cdr x))))
alist)))
(setq avy-current-path
(concat avy-current-path (string (avy--key-to-char char))))
(unless alist
(funcall avy-handler-function char))))
(cdar alist))))
;;** Rest
(defun avy-window-list ()
"Return a list of windows depending on `avy-all-windows'."
(cond ((eq avy-all-windows 'all-frames)
(cl-mapcan #'window-list (frame-list)))
((eq avy-all-windows t)
(window-list))
((null avy-all-windows)
(list (selected-window)))
(t
(error "Unrecognized option: %S" avy-all-windows))))
(defcustom avy-all-windows-alt nil
"The alternative `avy-all-windows' for use with \\[universal-argument]."
:type '(choice
(const :tag "Current window" nil)
(const :tag "All windows on the current frame" t)
(const :tag "All windows on all frames" all-frames)))
(defmacro avy-dowindows (flip &rest body)
"Depending on FLIP and `avy-all-windows' run BODY in each or selected window."
(declare (indent 1)
(debug (form body)))
`(let ((avy-all-windows (if ,flip
avy-all-windows-alt
avy-all-windows)))
(dolist (wnd (avy-window-list))
(with-selected-window wnd
(unless (memq major-mode avy-ignored-modes)
,@body)))))
(defun avy-resume ()
"Stub to hold last avy command.
Commands using `avy-with' macro can be resumed."
(interactive))
(defmacro avy-with (command &rest body)
"Set `avy-keys' according to COMMAND and execute BODY.
Set `avy-style' according to COMMAND as well."
(declare (indent 1)
(debug (form body)))
`(let ((avy-keys (or (cdr (assq ',command avy-keys-alist))
avy-keys))
(avy-style (or (cdr (assq ',command avy-styles-alist))
avy-style))
(avy-command ',command))
(setq avy-action nil)
(setf (symbol-function 'avy-resume)
(lambda ()
(interactive)
,@(if (eq command 'avy-goto-char-timer)
(cdr body)
body)))
,@body))
(defun avy-action-goto (pt)
"Goto PT."
(let ((frame (window-frame (selected-window))))
(unless (equal frame (selected-frame))
(select-frame-set-input-focus frame)
(raise-frame frame))
(goto-char pt)))
(defun avy-forward-item ()
(if (eq avy-command 'avy-goto-line)
(end-of-line)
(forward-sexp))
(point))
(defun avy-action-mark (pt)
"Mark sexp at PT."
(goto-char pt)
(set-mark (point))
(avy-forward-item))
(defun avy-action-copy (pt)
"Copy sexp starting on PT."
(save-excursion
(let (str)
(goto-char pt)
(avy-forward-item)
(setq str (buffer-substring pt (point)))
(kill-new str)
(message "Copied: %s" str)))
(let ((dat (ring-ref avy-ring 0)))
(select-frame-set-input-focus
(window-frame (cdr dat)))
(select-window (cdr dat))
(goto-char (car dat))))
(defun avy-action-yank (pt)
"Yank sexp starting at PT at the current point."
(avy-action-copy pt)
(yank)
t)
(defun avy-action-yank-line (pt)
"Yank sexp starting at PT at the current point."
(let ((avy-command 'avy-goto-line))
(avy-action-yank pt)))
(defun avy-action-kill-move (pt)
"Kill sexp at PT and move there."
(goto-char pt)
(avy-forward-item)
(kill-region pt (point))
(message "Killed: %s" (current-kill 0))
(point))
(defun avy-action-kill-stay (pt)
"Kill sexp at PT."
(save-excursion
(goto-char pt)
(avy-forward-item)
(kill-region pt (point))
(just-one-space))
(message "Killed: %s" (current-kill 0))
(select-window
(cdr
(ring-ref avy-ring 0)))
t)
(defun avy-action-zap-to-char (pt)
"Kill from point up to PT."
(if (> pt (point))
(kill-region (point) pt)
(kill-region pt (point))))
(defun avy-action-teleport (pt)
"Kill sexp starting on PT and yank into the current location."
(avy-action-kill-stay pt)
(select-window
(cdr
(ring-ref avy-ring 0)))
(save-excursion
(yank))
t)
(declare-function flyspell-correct-word-before-point "flyspell")
(defcustom avy-flyspell-correct-function #'flyspell-correct-word-before-point
"Function called to correct word by `avy-action-ispell' when
`flyspell-mode' is enabled."
:type 'function)
(defun avy-action-ispell (pt)
"Auto correct word at PT."
(save-excursion
(goto-char pt)
(cond
((eq avy-command 'avy-goto-line)
(ispell-region
(line-beginning-position)
(line-end-position)))
((bound-and-true-p flyspell-mode)
(funcall avy-flyspell-correct-function))
((looking-at-p "\\b")
(ispell-word))
(t
(progn
(backward-word)
(when (looking-at-p "\\b")
(ispell-word)))))))
(defvar avy-pre-action #'avy-pre-action-default
"Function to call before `avy-action' is called.")
(defun avy-pre-action-default (res)
(avy-push-mark)
(when (and (consp res)
(windowp (cdr res)))
(let* ((window (cdr res))
(frame (window-frame window)))
(unless (equal frame (selected-frame))
(select-frame-set-input-focus frame))
(select-window window))))
(defun avy--process-1 (candidates overlay-fn &optional cleanup-fn)
(let ((len (length candidates)))
(cond ((= len 0)
nil)
((and (= len 1) avy-single-candidate-jump)
(car candidates))
(t
(unwind-protect
(progn
(avy--make-backgrounds
(avy-window-list))
(cond ((eq avy-style 'de-bruijn)
(avy-read-de-bruijn
candidates avy-keys))
((eq avy-style 'words)
(avy-read-words
candidates avy-words))
(t
(avy-read (avy-tree candidates avy-keys)
overlay-fn
(or cleanup-fn #'avy--remove-leading-chars)))))
(avy--done))))))
(defvar avy-last-candidates nil
"Store the last candidate list.")
(defun avy--last-candidates-cycle (advancer)
(let* ((avy-last-candidates
(cl-remove-if-not
(lambda (x) (equal (cdr x) (selected-window)))
avy-last-candidates))
(min-dist
(apply #'min
(mapcar (lambda (x) (abs (- (caar x) (point)))) avy-last-candidates)))
(pos
(cl-position-if
(lambda (x)
(= (- (caar x) (point)) min-dist))
avy-last-candidates)))
(funcall advancer pos avy-last-candidates)))
(defun avy-prev ()
"Go to the previous candidate of the last `avy-read'."
(interactive)
(avy--last-candidates-cycle
(lambda (pos lst)
(when (> pos 0)
(goto-char (caar (nth (1- pos) lst)))))))
(defun avy-next ()
"Go to the next candidate of the last `avy-read'."
(interactive)
(avy--last-candidates-cycle
(lambda (pos lst)
(when (< pos (1- (length lst)))
(goto-char (caar (nth (1+ pos) lst)))))))
;;;###autoload
(defun avy-process (candidates &optional overlay-fn cleanup-fn)
"Select one of CANDIDATES using `avy-read'.
Use OVERLAY-FN to visualize the decision overlay.
CLEANUP-FN should take no arguments and remove the effects of
multiple OVERLAY-FN invocations."
(setq overlay-fn (or overlay-fn (avy--style-fn avy-style)))
(setq cleanup-fn (or cleanup-fn #'avy--remove-leading-chars))
(unless (and (consp (car candidates))
(windowp (cdar candidates)))
(setq candidates
(mapcar (lambda (x) (cons x (selected-window)))
candidates)))
(setq avy-last-candidates (copy-sequence candidates))
(let ((original-cands (copy-sequence candidates))
(res (avy--process-1 candidates overlay-fn cleanup-fn)))
(cond
((null res)
(if (and (eq avy-style 'words) candidates)
(avy-process original-cands overlay-fn cleanup-fn)
(message "zero candidates")
t))
((eq res 'restart)
(avy-process original-cands overlay-fn cleanup-fn))
;; ignore exit from `avy-handler-function'
((eq res 'exit))
((eq res 'abort)
nil)
(t
(funcall avy-pre-action res)
(setq res (car res))
(funcall (or avy-action 'avy-action-goto)
(if (consp res)
(car res)
res))
res))))
(define-obsolete-function-alias 'avy--process 'avy-process
"0.4.0")
(defvar avy--overlays-back nil
"Hold overlays for when `avy-background' is t.")
(defun avy--make-backgrounds (wnd-list)
"Create a dim background overlay for each window on WND-LIST."
(when avy-background
(setq avy--overlays-back
(mapcar (lambda (w)
(let ((ol (make-overlay
(window-start w)
(window-end w)
(window-buffer w))))
(overlay-put ol 'face 'avy-background-face)
(overlay-put ol 'window w)
ol))
wnd-list))))
(defun avy--done ()
"Clean up overlays."
(mapc #'delete-overlay avy--overlays-back)
(setq avy--overlays-back nil)
(avy--remove-leading-chars))
(defun avy--visible-p (s)
(let ((invisible (get-char-property s 'invisible)))
(or (null invisible)
(eq t buffer-invisibility-spec)
(null (assoc invisible buffer-invisibility-spec)))))
(defun avy--next-visible-point ()
"Return the next closest point without 'invisible property."
(let ((s (point)))
(while (and (not (= (point-max) (setq s (next-char-property-change s))))
(not (avy--visible-p s))))
s))
(defun avy--next-invisible-point ()
"Return the next closest point with 'invisible property."
(let ((s (point)))
(while (and (not (= (point-max) (setq s (next-char-property-change s))))
(avy--visible-p s)))
s))
(defun avy--find-visible-regions (rbeg rend)
"Return a list of all visible regions between RBEG and REND."
(setq rbeg (max rbeg (point-min)))
(setq rend (min rend (point-max)))
(when (< rbeg rend)
(let (visibles beg)
(save-excursion
(save-restriction
(narrow-to-region rbeg rend)
(setq beg (goto-char (point-min)))
(while (not (= (point) (point-max)))
(goto-char (avy--next-invisible-point))
(push (cons beg (point)) visibles)
(setq beg (goto-char (avy--next-visible-point))))
(nreverse visibles))))))
(defun avy--regex-candidates (regex &optional beg end pred group)
"Return all elements that match REGEX.
Each element of the list is ((BEG . END) . WND)
When PRED is non-nil, it's a filter for matching point positions.
When GROUP is non-nil, (BEG . END) should delimit that regex group."
(setq group (or group 0))
(let ((case-fold-search (or avy-case-fold-search
(string= regex (downcase regex))))
candidates)
(avy-dowindows current-prefix-arg
(dolist (pair (avy--find-visible-regions
(or beg (window-start))
(or end (window-end (selected-window) t))))
(save-excursion
(goto-char (car pair))
(while (re-search-forward regex (cdr pair) t)
(when (avy--visible-p (1- (point)))
(when (or (null pred)
(funcall pred))
(push (cons
(if (numberp group)
(cons (match-beginning group)
(match-end group))
(funcall group))
wnd) candidates)))))))
(nreverse candidates)))
(defvar avy--overlay-offset 0
"The offset to apply in `avy--overlay'.")
(defvar avy--overlays-lead nil
"Hold overlays for leading chars.")
(defun avy--remove-leading-chars ()
"Remove leading char overlays."
(mapc #'delete-overlay avy--overlays-lead)
(setq avy--overlays-lead nil))
(defun avy--old-str (pt wnd)
"Return a one-char string at PT in WND."