[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[elpa] master 5d2979b 01/17: Initial import
From: |
Oleh Krehel |
Subject: |
[elpa] master 5d2979b 01/17: Initial import |
Date: |
Fri, 08 May 2015 13:42:04 +0000 |
branch: master
commit 5d2979b91118d0211402af1fe03b7913ee550689
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>
Initial import
---
Makefile | 20 +++
avy-init.el | 27 ++++
avy-jump.el | 383 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++
avy-test.el | 68 +++++++++++
avy.el | 118 ++++++++++++++++++
5 files changed, 616 insertions(+), 0 deletions(-)
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..e155179
--- /dev/null
+++ b/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/avy-init.el b/avy-init.el
new file mode 100644
index 0000000..cc2a21f
--- /dev/null
+++ b/avy-init.el
@@ -0,0 +1,27 @@
+;;; 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" "ace-window.el"))
+(require 'ace-window)
+(require 'avy-jump)
+(global-set-key (kbd "C-c j") 'avi-goto-char)
+(global-set-key (kbd "C-'") 'avi-goto-char-2)
diff --git a/avy-jump.el b/avy-jump.el
new file mode 100644
index 0000000..ef854f3
--- /dev/null
+++ b/avy-jump.el
@@ -0,0 +1,383 @@
+;;; avy-jump.el --- jump to things tree-style
+
+;; 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 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 "avi-")
+
+(defcustom avi-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)
+ "Keys for jumping.")
+
+(defcustom avi-background nil
+ "When non-nil, a gray background will be added during the selection."
+ :type 'boolean)
+
+(defcustom avi-word-punc-regexp "[!-/:address@hidden"
+ "Regexp of punctuation characters that should be matched when calling
+`avi-goto-word-1' command. When nil, punctuation chars will not be matched.
+
+\"[!-/:address@hidden" will match all printable punctuation chars.")
+
+(defface avi-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
+(defun avi--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 avi--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 avi-keys)
+ overlay-fn
+ #'avy--remove-leading-chars)))
+ (avy--done)))
+
+(defvar avy--overlays-back nil
+ "Hold overlays for when `avi-background' is t.")
+
+(defun avy--make-backgrounds (wnd-list)
+ "Create a dim background overlay for each window on WND-LIST."
+ (when avi-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))
+
+(defcustom avi-all-windows t
+ "When non-nil, loop though all windows for candidates."
+ :type 'boolean)
+
+(defun avi--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)
+ (dolist (wnd (if avi-all-windows
+ (window-list)
+ (list (selected-window))))
+ (with-selected-window wnd
+ (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 avi--overlay-offset 0
+ "The offset to apply in `avi--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 avi--overlay (str pt wnd)
+ "Create an overlay with STR at PT in WND."
+ (let* ((pt (+ pt avi--overlay-offset))
+ (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
+ (old-str (with-selected-window wnd
+ (buffer-substring pt (1+ pt)))))
+ (when avi-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 avi--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)."
+ (avi--overlay
+ (propertize (apply #'string (reverse path))
+ 'face 'avi-lead-face)
+ (cond ((numberp leaf)
+ leaf)
+ ((consp (car leaf))
+ (caar leaf))
+ (t
+ (car leaf)))
+ (if (consp leaf)
+ (cdr leaf)
+ (selected-window))))
+
+(defun avi--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 'avi-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 avi-background
+ (setq old-str (propertize
+ old-str 'face 'avy-background-face)))
+ (overlay-put ol 'window wnd)
+ (overlay-put ol 'display str)
+ (push ol avy--overlays-lead))))
+
+(defun avi--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)."
+ (avi--overlay
+ (propertize (apply #'string (reverse path))
+ 'face 'avi-lead-face)
+ (cond ((numberp leaf)
+ leaf)
+ ((consp (car leaf))
+ (cdar leaf))
+ (t
+ (car leaf)))
+ (if (consp leaf)
+ (cdr leaf)
+ (selected-window))))
+
+(defun avi--generic-jump (regex flip)
+ "Jump to REGEX.
+When FLIP is non-nil, flip `avi-all-windows'."
+ (let ((avi-all-windows
+ (if flip
+ (not avi-all-windows)
+ avi-all-windows)))
+ (avi--goto
+ (avi--process
+ (avi--regex-candidates
+ regex)
+ #'avi--overlay-post))))
+
+;;* Commands
+;;;###autoload
+(defun avi-goto-char (&optional arg)
+ "Read one char and jump to it.
+The window scope is determined by `avi-all-windows'.
+When ARG is non-nil, flip the window scope."
+ (interactive "P")
+ (avi--generic-jump
+ (string (read-char "char: ")) arg))
+
+;;;###autoload
+(defun avi-goto-char-2 (&optional arg)
+ "Read two chars and jump to them in current window.
+When ARG is non-nil, flip the window scope."
+ (interactive "P")
+ (avi--generic-jump
+ (string
+ (read-char "char 1: ")
+ (read-char "char 2: "))
+ arg))
+
+;;;###autoload
+(defun avi-isearch ()
+ "Jump to one of the current isearch candidates."
+ (interactive)
+ (let* ((candidates
+ (avi--regex-candidates isearch-string))
+ (avi-background nil)
+ (candidate
+ (avi--process candidates #'avi--overlay-post)))
+ (isearch-done)
+ (avi--goto candidate)))
+
+;;;###autoload
+(defun avi-goto-word-0 (arg)
+ "Jump to a word start."
+ (interactive "P")
+ (let ((avi-keys (number-sequence ?a ?z)))
+ (avi--generic-jump "\\b\\sw" arg)))
+
+;;;###autoload
+(defun avi-goto-subword-0 (&optional arg)
+ "Jump to a word or subword start."
+ (interactive "P")
+ (let* ((avi-all-windows
+ (if arg
+ (not avi-all-windows)
+ avi-all-windows))
+ (avi-keys (number-sequence ?a ?z))
+ (candidates (avi--regex-candidates
+ "\\(\\b\\sw\\)\\|\\(?:[^A-Z]\\([A-Z]\\)\\)")))
+ (dolist (x candidates)
+ (when (> (- (cdar x) (caar x)) 1)
+ (cl-incf (caar x))))
+ (avi--goto
+ (avi--process candidates #'avi--overlay-pre))))
+
+;;;###autoload
+(defun avi-goto-word-1 ()
+ "Jump to a word start in current window.
+Read one char with which the word should start."
+ (interactive)
+ (let* ((str (string (read-char "char: ")))
+ (candidates (avi--regex-candidates
+ (if (and avi-word-punc-regexp
+ (string-match avi-word-punc-regexp str))
+ str
+ (concat
+ "\\b"
+ str)))))
+ (avi--goto
+ (avi--process candidates #'avi--overlay-pre))))
+
+(defun avi--line (&optional arg)
+ "Select line in current window."
+ (let ((avi-background nil)
+ (avi-all-windows
+ (if arg
+ (not avi-all-windows)
+ avi-all-windows))
+ candidates)
+ (dolist (wnd (if avi-all-windows
+ (window-list)
+ (list (selected-window))))
+ (with-selected-window wnd
+ (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)))))))
+ (avi--process (nreverse candidates) #'avi--overlay-pre)))
+
+;;;###autoload
+(defun avi-goto-line (&optional arg)
+ "Jump to a line start in current buffer."
+ (interactive "P")
+ (avi--goto (avi--line arg)))
+
+;;;###autoload
+(defun avi-copy-line (arg)
+ "Copy a selected line above the current line.
+ARG lines can be used."
+ (interactive "p")
+ (let ((start (car (avi--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 avi-move-line (arg)
+ "Move a selected line above the current line.
+ARG lines can be used."
+ (interactive "p")
+ (let ((start (car (avi--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 avi-copy-region ()
+ "Select two lines and copy the text between them here."
+ (interactive)
+ (let ((beg (car (avi--line)))
+ (end (car (avi--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))))
+
+(provide 'avy-jump)
+
+;;; avy-jump.el ends here
diff --git a/avy-test.el b/avy-test.el
new file mode 100644
index 0000000..339d8a0
--- /dev/null
+++ b/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/avy.el b/avy.el
new file mode 100644
index 0000000..c5baaaf
--- /dev/null
+++ b/avy.el
@@ -0,0 +1,118 @@
+;;; 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:
+;;
+;; Given a LIST and KEYS, `avy-tree' will build a balanced tree of
+;; degree B, where B is the length of KEYS.
+;;
+;; The corresponding member of KEYS is placed in each internal node of
+;; the tree. The leafs are the members of LIST. They can be obtained
+;; in the original order by traversing the tree depth-first.
+
+;;; 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
- [elpa] master updated (74b34f2 -> 876d210), Oleh Krehel, 2015/05/08
- [elpa] master 1684e6a 03/17: Avoid image-mode and doc-view-mode, Oleh Krehel, 2015/05/08
- [elpa] master 1d184b0 05/17: Regexp-quote strings of avy-goto-char* functions., Oleh Krehel, 2015/05/08
- [elpa] master 33546b6 06/17: Fix avy-goto-subword-0, Oleh Krehel, 2015/05/08
- [elpa] master 5677270 04/17: Move obsoletes to one place, Oleh Krehel, 2015/05/08
- [elpa] master 18cf1ef 07/17: README.md: add, Oleh Krehel, 2015/05/08
- [elpa] master 6c1f2f6 02/17: Move from "avi-" to "avy-", leave old stuff obsolete, Oleh Krehel, 2015/05/08
- [elpa] master 974e55b 09/17: avy-jump.el (avy--line): Avoid image-mode and doc-view-mode, Oleh Krehel, 2015/05/08
- [elpa] master 5d2979b 01/17: Initial import,
Oleh Krehel <=
- [elpa] master e9d2e60 08/17: Customize the leading char style for chars and words, Oleh Krehel, 2015/05/08
- [elpa] master 903e172 12/17: Special-case char RET to allow for jumping to end-of-lines., Oleh Krehel, 2015/05/08
- [elpa] master 487d5ea 11/17: Abstract windows and rely on subword, Oleh Krehel, 2015/05/08
- [elpa] master ca1ca04 14/17: Add avy-goto-subword-1, Oleh Krehel, 2015/05/08
- [elpa] master e4f493e 10/17: README.md: Add command descriptions, Oleh Krehel, 2015/05/08
- [elpa] master 3200351 16/17: avy-jump.el (avy-setup-default): Setup some bindings, Oleh Krehel, 2015/05/08
- [elpa] master b2112e0 13/17: avy-jump.el (avy-goto-word-1): Fix for ".", Oleh Krehel, 2015/05/08
- [elpa] master f2290f2 15/17: avy.el: Update commentary, Oleh Krehel, 2015/05/08
- [elpa] master 876d210 17/17: Add 'packages/avy/' from commit '32003515c8efa2cf38b62c45499dae30bc7cacb8', Oleh Krehel, 2015/05/08