X-Git-Url: https://code.delx.au/gnu-emacs-elpa/blobdiff_plain/b34a45afce1534164683210a8ceaf2923c176f8b..07bcdb8deee88ab740108cb7ff6bd9f75b5d349f:/packages/avy/avy.el

diff --git a/packages/avy/avy.el b/packages/avy/avy.el
index ce48da52e..a8a6a2524 100644
--- a/packages/avy/avy.el
+++ b/packages/avy/avy.el
@@ -4,7 +4,7 @@
 
 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
 ;; URL: https://github.com/abo-abo/avy
-;; Version: 0.2.1
+;; Version: 0.3.0
 ;; Package-Requires: ((emacs "24.1") (cl-lib "0.5"))
 ;; Keywords: point, location
 
@@ -75,14 +75,15 @@
                      (const avy-move-line))
           :value-type (repeat :tag "Keys" character)))
 
-(defcustom avy-style 'pre
+(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 "Post" post)
+          (const :tag "De Bruijn" de-bruijn)))
 
 (defcustom avy-styles-alist nil
   "Alist of avy-jump commands to the style for each command.
@@ -129,6 +130,15 @@ When nil, punctuation chars will not be matched.
 \"[!-/:-@[-`{-~]\" will match all printable punctuation chars."
   :type 'regexp)
 
+(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.")
+
+(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.")
@@ -137,6 +147,10 @@ When nil, punctuation chars will not be matched.
     '((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.")
@@ -145,6 +159,14 @@ When nil, punctuation chars will not be matched.
   '((t (:foreground "gray40")))
   "Face for whole window background during selection.")
 
+(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'.")
+
 ;;* Internals
 ;;** Tree
 (defmacro avy-multipop (lst n)
@@ -157,6 +179,71 @@ When nil, punctuation chars will not be matched.
         (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-tree (lst keys)
   "Coerce LST into a balanced tree.
 The degree of the tree is the length of KEYS.
@@ -237,7 +324,7 @@ multiple DISPLAY-FN invokations."
                         (push (cons path leaf) avy--leafs)))
         (dolist (x avy--leafs)
           (funcall display-fn (car x) (cdr x))))
-      (let ((char (read-char))
+      (let ((char (funcall avy-translate-char-function (read-char)))
             branch)
         (funcall cleanup-fn)
         (if (setq branch (assoc char tree))
@@ -247,6 +334,40 @@ multiple DISPLAY-FN invokations."
                     (concat avy-current-path (string char))))
           (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.
+  (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-char))))
+          (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 char)))
+          (cl-incf i)
+          (unless alist
+            (funcall avy-handler-function char))))
+      (cdar alist))))
+
 ;;** Rest
 (defun avy-window-list ()
   "Return a list of windows depending on `avy-all-windows'."
@@ -271,7 +392,7 @@ multiple DISPLAY-FN invokations."
                             avy-all-windows)))
      (dolist (wnd (avy-window-list))
        (with-selected-window wnd
-         (unless (memq major-mode '(image-mode doc-view-mode))
+         (unless (memq major-mode avy-ignored-modes)
            ,@body)))))
 
 (defmacro avy--with-avy-keys (command &rest body)
@@ -295,7 +416,11 @@ POS is either a position or (BEG . END)."
         ((eq x 'exit))
 
         (t
-         (select-window (cdr x))
+         (let* ((window (cdr x))
+                (frame (window-frame window)))
+           (unless (equal frame (selected-frame))
+             (select-frame-set-input-focus frame))
+           (select-window window))
          (let ((pt (car x)))
            (when (consp pt)
              (setq pt (car pt)))
@@ -314,9 +439,12 @@ Use OVERLAY-FN to visualize the decision overlay."
          (t
           (avy--make-backgrounds
            (avy-window-list))
-          (avy-read (avy-tree candidates avy-keys)
-                    overlay-fn
-                    #'avy--remove-leading-chars)))
+          (if (eq avy-style 'de-bruijn)
+              (avy-read-de-bruijn
+               candidates avy-keys)
+            (avy-read (avy-tree candidates avy-keys)
+                      overlay-fn
+                      #'avy--remove-leading-chars))))
     (avy--done)))
 
 (defvar avy--overlays-back nil
@@ -453,19 +581,32 @@ LEAF is normally ((BEG . END) . WND)."
          (beg (if (consp (car leaf))
                   (caar leaf)
                 (car leaf)))
-         (wnd (cdr leaf)))
-    (when (or avy-highlight-first (> (length str) 1))
-      (set-text-properties 0 1 '(face avy-lead-face-0) str))
+         (wnd (cdr leaf))
+         oov)
+    (dotimes (i len)
+      (set-text-properties (- len i 1) (- len i)
+                           `(face ,(nth i avy-lead-faces))
+                           str))
+    (when (eq avy-style 'de-bruijn)
+      (setq str (concat
+                 (propertize avy-current-path
+                             'face 'avy-lead-face-1)
+                 str))
+      (setq len (length str)))
     (with-selected-window wnd
       (save-excursion
         (goto-char beg)
-        (when (cl-some (lambda (o)
-                         (and (eq (overlay-get o 'category) 'avy)
-                              (eq (overlay-get o 'window) wnd)))
-                       (overlays-in (point) (min (+ (point) len)
-                                                 (line-end-position))))
-          (setq str (substring str 0 1))
-          (setq len 1))
+        (when (setq oov
+                    (delq nil
+                          (mapcar
+                           (lambda (o)
+                             (and (eq (overlay-get o 'category) 'avy)
+                                  (eq (overlay-get o 'window) wnd)
+                                  (overlay-start o)))
+                           (overlays-in (point) (min (+ (point) len)
+                                                     (line-end-position))))))
+          (setq len (- (apply #'min oov) beg))
+          (setq str (substring str 0 len)))
         (let ((other-ov (cl-find-if
                          (lambda (o)
                            (and (eq (overlay-get o 'category) 'avy)
@@ -537,6 +678,7 @@ LEAF is normally ((BEG . END) . WND)."
     (at #'avy--overlay-at)
     (at-full 'avy--overlay-at-full)
     (post #'avy--overlay-post)
+    (de-bruijn #'avy--overlay-at-full)
     (t (error "Unexpected style %S" style))))
 
 (defun avy--generic-jump (regex window-flip style)
@@ -567,6 +709,20 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
      arg
      avy-style)))
 
+;;;###autoload
+(defun avy-goto-char-in-line (char)
+  "Jump to the currently visible CHAR in the current line."
+  (interactive (list (read-char "char: ")))
+  (let ((avy-all-windows nil))
+    (avy--with-avy-keys avy-goto-char
+      (avy--goto
+       (avy--process
+        (save-restriction
+          (narrow-to-region (line-beginning-position)
+                            (line-end-position))
+          (avy--regex-candidates (regexp-quote (string char))))
+        (avy--style-fn avy-style))))))
+
 ;;;###autoload
 (defun avy-goto-char-2 (char1 char2 &optional arg)
   "Jump to the currently visible CHAR1 followed by CHAR2.
@@ -589,7 +745,7 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
             (avy--regex-candidates isearch-string))
            (avy-background nil)
            (candidate
-            (avy--process candidates #'avy--overlay-post)))
+            (avy--process candidates (avy--style-fn avy-style))))
       (isearch-done)
       (avy--goto candidate))))
 
@@ -613,7 +769,7 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
                          "\\.")
                         ((and avy-word-punc-regexp
                               (string-match avy-word-punc-regexp str))
-                         str)
+                         (regexp-quote str))
                         (t
                          (concat
                           "\\b"
@@ -778,13 +934,14 @@ The window scope is determined by `avy-all-windows' (ARG negates it)."
   (interactive "P")
   (let ((c1 (read-char "char 1: "))
         (c2 (read-char "char 2: " nil avy-timeout-seconds)))
-    (avy--generic-jump
-     (regexp-quote
-      (if c2
-          (string c1 c2)
-        (string c1)))
-     arg
-     avy-style)))
+    (avy--with-avy-keys avy-goto-char-timer
+      (avy--generic-jump
+       (regexp-quote
+        (if c2
+            (string c1 c2)
+          (string c1)))
+       arg
+       avy-style))))
 
 (define-obsolete-variable-alias
     'avy-goto-char-style 'avy-style "0.1.0"