emacs-elpa-diffs
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[elpa] master 876d210 17/17: Add 'packages/avy/' from commit '32003515c8


From: Oleh Krehel
Subject: [elpa] master 876d210 17/17: Add 'packages/avy/' from commit '32003515c8efa2cf38b62c45499dae30bc7cacb8'
Date: Fri, 08 May 2015 13:42:16 +0000

branch: master
commit 876d210333969ec8c6723216917150c7b532082e
Merge: 74b34f2 3200351
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    Add 'packages/avy/' from commit '32003515c8efa2cf38b62c45499dae30bc7cacb8'
    
    git-subtree-dir: packages/avy
    git-subtree-mainline: 74b34f2bbb929a1caf5cf753e59c54c3ccb74f50
    git-subtree-split: 32003515c8efa2cf38b62c45499dae30bc7cacb8
---
 packages/avy/Makefile    |   20 ++
 packages/avy/README.md   |   88 +++++++++
 packages/avy/avy-init.el |   26 +++
 packages/avy/avy-jump.el |  470 ++++++++++++++++++++++++++++++++++++++++++++++
 packages/avy/avy-test.el |   68 +++++++
 packages/avy/avy.el      |  131 +++++++++++++
 6 files changed, 803 insertions(+), 0 deletions(-)

diff --git a/packages/avy/Makefile b/packages/avy/Makefile
new file mode 100644
index 0000000..e155179
--- /dev/null
+++ b/packages/avy/Makefile
@@ -0,0 +1,20 @@
+emacs ?= emacs
+# EMACS = emacs-24.3
+
+LOAD = -l avy.el -l avy-test.el
+
+.PHONY: all test clean
+
+all: test
+
+test:
+       $(emacs) -batch $(LOAD) -f ert-run-tests-batch-and-exit
+
+compile:
+       $(emacs) -batch -l avy-init.el
+
+run:
+       $(emacs) -Q -l avy-init.el
+
+clean:
+       rm -f *.elc
diff --git a/packages/avy/README.md b/packages/avy/README.md
new file mode 100644
index 0000000..01bf587
--- /dev/null
+++ b/packages/avy/README.md
@@ -0,0 +1,88 @@
+## Introduction
+
+`avy-jump` is a GNU Emacs package for jumping to visible text using a 
char-based decision tree.  See also 
[ace-jump-mode](https://github.com/winterTTr/ace-jump-mode) and 
[vim-easymotion](https://github.com/Lokaltog/vim-easymotion) - `avy-jump` uses 
the same idea.
+
+![logo](https://raw.githubusercontent.com/wiki/abo-abo/avy-jump/images/avy-avatar-1.png)
+
+## Command overview
+
+You can bind some of these useful commands in your config.
+
+### `avy-goto-char`
+
+> Input one char, jump to it with a tree.
+
+```elisp
+(global-set-key (kbd "π") 'avy-goto-char)
+```
+
+After <kbd>πb</kbd>:
+
+![avy-goto-char](http://oremacs.com/download/avi-goto-char.png)
+
+### `avy-goto-char-2`
+
+> Input two consecutive chars, jump to the first one with a tree.
+
+The advantage over the previous one is less candidates for the tree search. 
And it's not too inconvenient to enter two consecutive chars instead of one.
+
+```elisp
+(global-set-key (kbd "C-'") 'avy-goto-char-2)
+```
+
+After <kbd>C-' bu</kbd>:
+
+![avy-goto-char-2](http://oremacs.com/download/avi-goto-char-2.png)
+
+### `avy-goto-line`
+
+> Input zero chars, jump to a line start with a tree.
+
+```elisp
+(global-set-key (kbd "M-g f") 'avy-goto-line)
+```
+
+After <kbd>M-g f</kbd>:
+
+![avy-goto-line](http://oremacs.com/download/avi-goto-line.png)
+
+### `avy-goto-word-1`
+
+> Input one char at word start, jump to a word start with a tree.
+
+```elisp
+(global-set-key (kbd "M-g w") 'avy-goto-word-1)
+```
+
+After <kbd>M-g wb</kbd>:
+
+![avy-goto-word-1](http://oremacs.com/download/avi-goto-word-1.png)
+
+### `avy-goto-word-0`
+
+> Input zero chars, jump to a word start with a tree.
+
+Compared to `avy-goto-word-1`, there are a lot more candidates. But at a least 
there's not need to input the initial char.
+
+```elisp
+(global-set-key (kbd "M-g e") 'avy-goto-word-0)
+```
+
+After <kbd>M-g e</kbd>:
+
+![avy-goto-word-0](http://oremacs.com/download/avi-goto-word-0.png)
+
+
+### Other commands
+
+There are some more commands which you can explore yourself by looking at the 
code.
+
+### Bindings
+
+You add this to your config to bind some stuff:
+
+```elisp
+(avy-setup-default)
+```
+
+It will bind, for example, `avy-isearch` to <kbd>C-'</kbd> in 
`isearch-mode-map`, so that you can select one of the currently visible 
`isearch` candidates using `avy`.
diff --git a/packages/avy/avy-init.el b/packages/avy/avy-init.el
new file mode 100644
index 0000000..37cf18e
--- /dev/null
+++ b/packages/avy/avy-init.el
@@ -0,0 +1,26 @@
+;;; avy-init.el --- bare avy init
+
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+(add-to-list 'load-path default-directory)
+(mapc #'byte-compile-file '("avy.el" "avy-jump.el"))
+(require 'avy-jump)
+(global-set-key (kbd "C-c j") 'avy-goto-char)
+(global-set-key (kbd "C-'") 'avy-goto-char-2)
diff --git a/packages/avy/avy-jump.el b/packages/avy/avy-jump.el
new file mode 100644
index 0000000..d6bb52e
--- /dev/null
+++ b/packages/avy/avy-jump.el
@@ -0,0 +1,470 @@
+;;; avy-jump.el --- jump to things tree-style. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+;; URL: https://github.com/abo-abo/avy-jump
+;; Version: 0.1.0
+;; 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:
+;;
+;; This package offers various commands for navigating to things using `avy'.
+;; They are in the "Commands" outline.
+
+;;; Code:
+;;* Requires
+(require 'avy)
+
+;;* Customization
+(defgroup avy-jump nil
+  "Jump to things tree-style."
+  :group 'convenience
+  :prefix "avy-")
+
+(defcustom avy-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
+  "Keys for jumping.")
+
+(defcustom avy-background nil
+  "When non-nil, a gray background will be added during the selection."
+  :type 'boolean)
+
+(defcustom avy-word-punc-regexp "[!-/:address@hidden"
+  "Regexp of punctuation characters that should be matched when calling
+`avy-goto-word-1' command. When nil, punctuation chars will not be matched.
+
+\"[!-/:address@hidden" will match all printable punctuation 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.")
+
+;;* Internals
+(defcustom avy-all-windows t
+  "When non-nil, loop though all windows for candidates."
+  :type 'boolean)
+
+(defmacro avy-dowindows (flip &rest body)
+  "Depending on FLIP and `avy-all-windows' run BODY in each or selected 
window."
+  (declare (indent 1))
+  `(let ((avy-all-windows (if ,flip
+                              (not avy-all-windows)
+                            avy-all-windows)))
+     (dolist (wnd (if avy-all-windows
+                      (window-list)
+                    (list (selected-window))))
+       (with-selected-window wnd
+         (unless (memq major-mode '(image-mode doc-view-mode))
+           ,@body)))))
+
+(defun avy--goto (x)
+  "Goto X.
+X is (POS . WND)
+POS is either a position or (BEG . END)."
+  (if (null x)
+      (message "zero candidates")
+    (select-window (cdr x))
+    (let ((pt (car x)))
+      (when (consp pt)
+        (setq pt (car pt)))
+      (unless (= pt (point)) (push-mark))
+      (goto-char pt))))
+
+(defun avy--process (candidates overlay-fn)
+  "Select one of CANDIDATES using `avy-read'."
+  (unwind-protect
+      (cl-case (length candidates)
+       (0
+        nil)
+       (1
+        (car candidates))
+       (t
+        (avy--make-backgrounds (list (selected-window)))
+        (avy-read (avy-tree candidates avy-keys)
+                  overlay-fn
+                  #'avy--remove-leading-chars)))
+    (avy--done)))
+
+(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)
+                      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--regex-candidates (regex &optional wnd beg end pred)
+  "Return all elements that match REGEX in WND.
+Each element of the list is ((BEG . END) . WND)
+When PRED is non-nil, it's a filter for matching point positions."
+  (let (candidates)
+    (avy-dowindows nil
+      (let ((we (or end (window-end (selected-window) t))))
+        (save-excursion
+          (goto-char (or beg (window-start)))
+          (while (re-search-forward regex we t)
+            (unless (get-char-property (point) 'invisible)
+              (when (or (null pred)
+                        (funcall pred))
+                (push (cons (cons (match-beginning 0)
+                                  (match-end 0))
+                            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--overlay (str pt wnd)
+  "Create an overlay with STR at PT in WND."
+  (when (<= (1+ pt) (with-selected-window wnd (point-max)))
+    (let* ((pt (+ pt avy--overlay-offset))
+          (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 (concat str old-str))
+      (push ol avy--overlays-lead))))
+
+(defun avy--overlay-pre (path leaf)
+  "Create an overlay with STR at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is ((BEG . END) . WND)."
+  (avy--overlay
+   (propertize (apply #'string (reverse path))
+               'face 'avy-lead-face)
+   (cond ((numberp leaf)
+          leaf)
+         ((consp (car leaf))
+          (caar leaf))
+         (t
+          (car leaf)))
+   (if (consp leaf)
+       (cdr leaf)
+     (selected-window))))
+
+(defun avy--overlay-at (path leaf)
+  "Create an overlay with STR at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is ((BEG . END) . WND)."
+  (let ((str (propertize
+              (string (car (last path)))
+              'face 'avy-lead-face))
+        (pt (if (consp (car leaf))
+                (caar leaf)
+              (car leaf)))
+        (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))))
+
+(defun avy--overlay-post (path leaf)
+  "Create an overlay with STR at LEAF.
+PATH is a list of keys from tree root to LEAF.
+LEAF is ((BEG . END) . WND)."
+  (avy--overlay
+   (propertize (apply #'string (reverse path))
+               'face 'avy-lead-face)
+   (cond ((numberp leaf)
+          leaf)
+         ((consp (car leaf))
+          (cdar leaf))
+         (t
+          (car leaf)))
+   (if (consp leaf)
+       (cdr leaf)
+     (selected-window))))
+
+(defun avy--style-fn (style)
+  "Transform STYLE symbol to a style function."
+  (cl-case style
+    (pre #'avy--overlay-pre)
+    (at #'avy--overlay-at)
+    (post #'avy--overlay-post)
+    (t (error "Unexpected style %S" style))))
+
+(defun avy--generic-jump (regex window-flip style)
+  "Jump to REGEX.
+When WINDOW-FLIP is non-nil, do the opposite of `avy-all-windows'.
+STYLE determines the leading char overlay style."
+  (let ((avy-all-windows
+         (if window-flip
+             (not avy-all-windows)
+           avy-all-windows)))
+    (avy--goto
+     (avy--process
+      (avy--regex-candidates
+       regex)
+      (avy--style-fn style)))))
+
+(defcustom avy-goto-char-style 'pre
+  "Method of displaying the overlays for `avy-goto-char' and 
`avy-goto-char-2'."
+  :type '(choice
+          (const :tag "Pre" pre)
+          (const :tag "At" at)
+          (const :tag "Post" post)))
+
+(defcustom avy-goto-word-style 'pre
+  "Method of displaying the overlays for `avy-goto-word-0' and 
`avy-goto-word-0'."
+  :type '(choice
+          (const :tag "Pre" pre)
+          (const :tag "At" at)
+          (const :tag "Post" post)))
+
+;;* Commands
+;;;###autoload
+(defun avy-goto-char (&optional arg)
+  "Read one char and jump to it.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+  (interactive "P")
+  (avy--generic-jump
+   (let ((c (read-char "char: ")))
+     (if (= 13 c)
+        "\n"
+       (regexp-quote (string c))))
+   arg
+   avy-goto-char-style))
+
+;;;###autoload
+(defun avy-goto-char-2 (&optional arg)
+  "Read two consecutive chars and jump to the first one.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+  (interactive "P")
+  (avy--generic-jump
+   (regexp-quote (string
+                 (read-char "char 1: ")
+                 (read-char "char 2: ")))
+   arg
+   avy-goto-char-style))
+
+;;;###autoload
+(defun avy-isearch ()
+  "Jump to one of the current isearch candidates."
+  (interactive)
+  (let* ((candidates
+          (avy--regex-candidates isearch-string))
+         (avy-background nil)
+         (candidate
+          (avy--process candidates #'avy--overlay-post)))
+    (isearch-done)
+    (avy--goto candidate)))
+
+;;;###autoload
+(defun avy-goto-word-0 (arg)
+  "Jump to a word start.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+  (interactive "P")
+  (let ((avy-keys (number-sequence ?a ?z)))
+    (avy--generic-jump "\\b\\sw" arg avy-goto-word-style)))
+
+;;;###autoload
+(defun avy-goto-word-1 (&optional arg)
+  "Read one char at word start and jump there.
+The window scope is determined by `avy-all-windows' (ARG negates it)."
+  (interactive "P")
+  (let* ((str (string (read-char "char: ")))
+         (regex (cond ((string= str ".")
+                       "\\.")
+                      ((and avy-word-punc-regexp
+                            (string-match avy-word-punc-regexp str))
+                       str)
+                      (t
+                       (concat
+                        "\\b"
+                        str)))))
+    (avy--generic-jump regex arg avy-goto-word-style)))
+
+(declare-function subword-backward "subword")
+
+;;;###autoload
+(defun avy-goto-subword-0 (&optional arg predicate)
+  "Jump to a word or subword start.
+
+The window scope is determined by `avy-all-windows' (ARG negates it).
+
+When PREDICATE is non-nil it's a function of zero parameters that
+should return true."
+  (interactive "P")
+  (require 'subword)
+  (let ((avy-keys (number-sequence ?a ?z))
+        (case-fold-search nil)
+        candidates)
+    (avy-dowindows arg
+      (let ((ws (window-start)))
+        (save-excursion
+          (goto-char (window-end (selected-window) t))
+          (subword-backward)
+          (while (> (point) ws)
+            (when (or (null predicate)
+                      (and predicate (funcall predicate)))
+              (push (cons (point) (selected-window)) candidates))
+            (subword-backward)))))
+    (avy--goto
+     (avy--process candidates (avy--style-fn avy-goto-word-style)))))
+
+;;;###autoload
+(defun avy-goto-subword-1 (&optional arg)
+  "Prompt for a subword start char and jump there.
+The window scope is determined by `avy-all-windows' (ARG negates it).
+The case is ignored."
+  (interactive "P")
+  (let ((char (downcase (read-char "char: "))))
+    (avy-goto-subword-0
+     arg (lambda () (eq (downcase (char-after)) char)))))
+
+(defun avy--line (&optional arg)
+  "Select line in current window."
+  (let ((avy-background nil)
+        candidates)
+    (avy-dowindows arg
+      (let ((ws (window-start)))
+        (save-excursion
+          (save-restriction
+            (narrow-to-region ws (window-end (selected-window) t))
+            (goto-char (point-min))
+            (while (< (point) (point-max))
+              (unless (get-char-property
+                       (max (1- (point)) ws) 'invisible)
+                (push (cons (point) (selected-window)) candidates))
+              (forward-line 1))))))
+    (avy--process (nreverse candidates) #'avy--overlay-pre)))
+
+;;;###autoload
+(defun avy-goto-line (&optional arg)
+  "Jump to a line start in current buffer."
+  (interactive "P")
+  (avy--goto (avy--line arg)))
+
+;;;###autoload
+(defun avy-copy-line (arg)
+  "Copy a selected line above the current line.
+ARG lines can be used."
+  (interactive "p")
+  (let ((start (car (avy--line))))
+    (move-beginning-of-line nil)
+    (save-excursion
+      (insert
+       (buffer-substring-no-properties
+        start
+        (save-excursion
+          (goto-char start)
+          (move-end-of-line arg)
+          (point)))
+       "\n"))))
+
+;;;###autoload
+(defun avy-move-line (arg)
+  "Move a selected line above the current line.
+ARG lines can be used."
+  (interactive "p")
+  (let ((start (car (avy--line))))
+    (move-beginning-of-line nil)
+    (save-excursion
+      (save-excursion
+        (goto-char start)
+        (move-end-of-line arg)
+        (kill-region start (point)))
+      (insert
+       (current-kill 0)
+       "\n"))))
+
+;;;###autoload
+(defun avy-copy-region ()
+  "Select two lines and copy the text between them here."
+  (interactive)
+  (let ((beg (car (avy--line)))
+        (end (car (avy--line)))
+        (pad (if (bolp) "" "\n")))
+    (move-beginning-of-line nil)
+    (save-excursion
+      (insert
+       (buffer-substring-no-properties
+        beg
+        (save-excursion
+          (goto-char end)
+          (line-end-position)))
+       pad))))
+
+;;;###autoload
+(defun avy-setup-default ()
+  "Setup the default shortcuts."
+  (eval-after-load 'isearch
+    '(define-key isearch-mode-map (kbd "C-'") 'avy-isearch)))
+
+(define-obsolete-variable-alias 'avi-keys 'avy-keys "0.1.0")
+(define-obsolete-variable-alias 'avi-background 'avy-background "0.1.0")
+(define-obsolete-variable-alias 'avi-word-punc-regexp 'avy-word-punc-regexp 
"0.1.0")
+(define-obsolete-face-alias 'avi-lead-face 'avy-lead-face "0.1.0")
+(define-obsolete-function-alias 'avi--goto 'avy--goto "0.1.0")
+(define-obsolete-function-alias 'avi--process 'avy--process "0.1.0")
+(define-obsolete-variable-alias 'avi-all-windows 'avy-all-windows "0.1.0")
+(define-obsolete-function-alias 'avi--overlay-pre 'avy--overlay-pre "0.1.0")
+(define-obsolete-function-alias 'avi--overlay-at 'avy--overlay-at "0.1.0")
+(define-obsolete-function-alias 'avi--overlay-post 'avy--overlay-post "0.1.0")
+(define-obsolete-function-alias 'avi-goto-char 'avy-goto-char "0.1.0")
+(define-obsolete-function-alias 'avi-goto-char-2 'avy-goto-char-2 "0.1.0")
+(define-obsolete-function-alias 'avi-isearch 'avy-isearch "0.1.0")
+(define-obsolete-function-alias 'avi-goto-word-0 'avy-goto-word-0 "0.1.0")
+(define-obsolete-function-alias 'avi-goto-subword-0 'avy-goto-subword-0 
"0.1.0")
+(define-obsolete-function-alias 'avi-goto-word-1 'avy-goto-word-1 "0.1.0")
+(define-obsolete-function-alias 'avi-goto-line 'avy-goto-line "0.1.0")
+(define-obsolete-function-alias 'avi-copy-line 'avy-copy-line "0.1.0")
+(define-obsolete-function-alias 'avi-move-line 'avy-move-line "0.1.0")
+(define-obsolete-function-alias 'avi-copy-region 'avy-copy-region "0.1.0")
+(define-obsolete-function-alias 'avi--regex-candidates 'avy--regex-candidates 
"0.1.0")
+
+(provide 'avy-jump)
+
+;;; avy-jump.el ends here
diff --git a/packages/avy/avy-test.el b/packages/avy/avy-test.el
new file mode 100644
index 0000000..339d8a0
--- /dev/null
+++ b/packages/avy/avy-test.el
@@ -0,0 +1,68 @@
+;;; avy-test.el --- Tests for avy
+
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs 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 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs 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.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs.  If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+
+;;; Code:
+
+(require 'ert)
+(require 'avy)
+
+(ert-deftest avy-subdiv ()
+  (should
+   (equal (avy-subdiv 5 4)
+          '(1 1 1 2)))
+  (should
+   (equal (avy-subdiv 10 4)
+          '(1 1 4 4)))
+  (should
+   (equal (avy-subdiv 16 4)
+          '(4 4 4 4)))
+  (should
+   (equal (avy-subdiv 17 4)
+          '(4 4 4 5)))
+  (should
+   (equal (avy-subdiv 27 4)
+          '(4 4 4 15)))
+  (should
+   (equal (avy-subdiv 50 4)
+          '(4 14 16 16)))
+  (should
+   (equal (avy-subdiv 65 4)
+          '(16 16 16 17))))
+
+(ert-deftest avy-tree ()
+  (should
+   (equal
+    (avy-tree '(0 1 2 3 4 5 6 7 8 9 10)
+              '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
+    '((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/packages/avy/avy.el b/packages/avy/avy.el
new file mode 100644
index 0000000..6a0dea7
--- /dev/null
+++ b/packages/avy/avy.el
@@ -0,0 +1,131 @@
+;;; avy.el --- set-based completion -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015  Free Software Foundation, Inc.
+
+;; Author: Oleh Krehel
+
+;; 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:
+;;
+;; 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.
+;;
+;; In order for `read-char' 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:
+;;
+;; * 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-macs)
+
+(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-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)))
+    (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)))))
+
+(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)))
+          (signal 'user-error (list "No such candidate" char))
+          (throw 'done nil))))))
+
+(provide 'avy)
+
+;;; avy.el ends here



reply via email to

[Prev in Thread] Current Thread [Next in Thread]