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

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

[elpa] master b11606c 68/68: Add 'packages/ace-window/' from commit '258


From: Oleh Krehel
Subject: [elpa] master b11606c 68/68: Add 'packages/ace-window/' from commit '2580bf9bd7f66ed4e923a125ee8efcc4b6a043e0'
Date: Sat, 21 Mar 2015 19:07:12 +0000

branch: master
commit b11606c5ae9b9948da5d5431d6ff939ad7254ffb
Merge: 6afd045 2580bf9
Author: Oleh Krehel <address@hidden>
Commit: Oleh Krehel <address@hidden>

    Add 'packages/ace-window/' from commit 
'2580bf9bd7f66ed4e923a125ee8efcc4b6a043e0'
    
    git-subtree-dir: packages/ace-window
    git-subtree-mainline: 6afd0453ab48e472d725a32f99a238cb06cd5265
    git-subtree-split: 2580bf9bd7f66ed4e923a125ee8efcc4b6a043e0
---
 packages/ace-window/Makefile      |   14 ++
 packages/ace-window/README.md     |   78 ++++++
 packages/ace-window/ace-window.el |  465 +++++++++++++++++++++++++++++++++++++
 packages/ace-window/avy-jump.el   |  259 +++++++++++++++++++++
 packages/ace-window/avy-test.el   |   42 ++++
 packages/ace-window/avy.el        |  119 ++++++++++
 6 files changed, 977 insertions(+), 0 deletions(-)

diff --git a/packages/ace-window/Makefile b/packages/ace-window/Makefile
new file mode 100644
index 0000000..4f0a640
--- /dev/null
+++ b/packages/ace-window/Makefile
@@ -0,0 +1,14 @@
+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
+
+clean:
+       rm -f *.elc
diff --git a/packages/ace-window/README.md b/packages/ace-window/README.md
new file mode 100644
index 0000000..1b2f808
--- /dev/null
+++ b/packages/ace-window/README.md
@@ -0,0 +1,78 @@
+# ace-window
+
+**GNU Emacs package for selecting a window to switch to**
+
+## What and why
+
+I'm sure you're aware of `other-window` command. While it's great for
+two windows, it quickly loses it's value when there are more windows:
+you need to call it many times, and since it's not easily predictable,
+you have to check each time if you're in the window that you wanted.
+
+Another approach is to use `windmove-left`, `windmove-up` etc.  These
+are fast and predictable. Their disadvantage is that they need 4 key
+bindings.  The default ones are shift+arrows, which are hard to reach.
+
+This package aims to take the speed and predictability of `windmove`
+and pack it into a single key binding, similar to `other-window`.
+
+## Setup
+
+Just assign `ace-window` to a short key binding, as switching windows
+is a common task. I suggest <kbd>M-p</kbd>, as it's short and not
+bound in the default Emacs.
+
+## Usage
+
+When there are two windows, `ace-window` will call `other-window`.  If
+there are more, each window will have its first character highlighted.
+Pressing that character will switch to that window.  Note that, unlike
+`ace-jump-mode`, the point position will not be changed: it's the same
+behavior as that of `other-window`.
+
+The windows are ordered top-down, left-to-right. This means that if
+you remember your window layouts, you can switch windows without even
+looking at the leading char.  For instance, the top left window will
+always be `1`.
+
+`ace-window` works across multiple frames, as you can see from the
+[in-action gif](http://oremacs.com/download/ace-window.gif).
+
+## Swap and delete window
+
+- You can swap windows by calling `ace-window` with a prefix argument 
<kbd>C-u</kbd>.
+
+- You can delete the selected window by calling `ace-window` with a double 
prefix argument, i.e. <kbd>C-u C-u</kbd>.
+
+## Customization
+Aside from binding `ace-window`:
+
+    (global-set-key (kbd "M-p") 'ace-window)
+
+maybe you'd like the following customizations:
+
+### `aw-keys`
+`aw-keys` - the sequence of leading characters for each window:
+
+    (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
+
+`aw-keys` are 0-9 by default, which is reasonable, but in the setup
+above, the keys are on the home row.
+
+### `aw-scope`
+The default one is `global`, which means that `ace-window` will work
+across frames. If you set this to `frame`, `ace-window` will offer you
+the windows only on current frame.
+
+### `aw-background`
+
+By default, `ace-window` temporarily sets a gray background and
+removes color from available windows in order to make the
+window-switching characters more visible. This is the behavior
+inherited from `ace-jump-mode`.
+
+This behavior might not be necessary, as you already know the locations
+where to look, i.e. the top-left corners of each window.
+So you can turn off the gray background with:
+
+    (setq aw-background nil)
diff --git a/packages/ace-window/ace-window.el 
b/packages/ace-window/ace-window.el
new file mode 100644
index 0000000..a846869
--- /dev/null
+++ b/packages/ace-window/ace-window.el
@@ -0,0 +1,465 @@
+;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*-
+
+;; Copyright (C) 2014-2015 Oleh Krehel
+
+;; Author: Oleh Krehel <address@hidden>
+;; URL: https://github.com/abo-abo/ace-window
+;; Version: 0.8.0
+;; Keywords: window, location
+
+;; This file is not 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:
+;;
+;; The main function, `ace-window' is meant to replace `other-window'.
+;; If fact, when there are only two windows present, `other-window' is
+;; called.  If there are more, each window will have its first
+;; character highlighted.  Pressing that character will switch to that
+;; window.
+;;
+;; To setup this package, just add to your .emacs:
+;;
+;;    (global-set-key (kbd "M-p") 'ace-window)
+;;
+;; replacing "M-p"  with an appropriate shortcut.
+;;
+;; Depending on your window usage patterns, you might want to set
+;;
+;;    (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
+;;
+;; This way they're all on the home row, although the intuitive
+;; ordering is lost.
+;;
+;; If you don't want the gray background that makes the red selection
+;; characters stand out more, set this:
+;;
+;;    (setq aw-background nil)
+;;
+;; When prefixed with one `universal-argument', instead of switching
+;; to selected window, the selected window is swapped with current one.
+;;
+;; When prefixed with two `universal-argument', the selected window is
+;; deleted instead.
+
+;;; Code:
+(require 'avy)
+
+;;* Customization
+(defgroup ace-window nil
+  "Quickly switch current window."
+  :group 'convenience
+  :prefix "aw-")
+
+(defcustom aw-keys '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
+  "Keys for selecting window.")
+
+(defcustom aw-scope 'global
+  "The scope used by `ace-window'."
+  :type '(choice
+          (const :tag "global" global)
+          (const :tag "frame" frame)))
+
+(defcustom aw-ignored-buffers '("*Calc Trail*" "*LV*")
+  "List of buffers to ignore when selecting window."
+  :type '(repeat string))
+
+(defcustom aw-ignore-on t
+  "When t, `ace-window' will ignore `aw-ignored-buffers'.
+Use M-0 `ace-window' to toggle this value."
+  :type 'boolean)
+
+(defcustom aw-background t
+  "When t, `ace-window' will dim out all buffers temporarily when used.'."
+  :type 'boolean)
+
+(defcustom aw-leading-char-style 'char
+  "Style of the leading char overlay."
+  :type '(choice
+          (const :tag "single char" 'char)
+          (const :tag "full path" 'path)))
+
+(defface aw-leading-char-face
+    '((((class color)) (:foreground "red"))
+      (((background dark)) (:foreground "gray100"))
+      (((background light)) (:foreground "gray0"))
+      (t (:foreground "gray100" :underline nil)))
+  "Face for each window's leading char.")
+
+(defface aw-background-face
+  '((t (:foreground "gray40")))
+  "Face for whole window background during selection.")
+
+(defface aw-mode-line-face
+    '((t (:inherit mode-line-buffer-id)))
+  "Face used for displaying the ace window key in the mode-line.")
+
+;;* Implementation
+(defun aw-ignored-p (window)
+  "Return t if WINDOW should be ignored."
+  (and aw-ignore-on
+       (member (buffer-name (window-buffer window))
+               aw-ignored-buffers)))
+
+(defun aw-window-list ()
+  "Return the list of interesting windows."
+  (sort
+   (cl-remove-if
+    (lambda (w)
+      (let ((f (window-frame w))
+            (b (window-buffer w)))
+        (or (not (and (frame-live-p f)
+                      (frame-visible-p f)))
+            (string= "initial_terminal" (terminal-name f))
+            (aw-ignored-p w)
+            (with-current-buffer b
+              (and buffer-read-only
+                   (= 0 (buffer-size b)))))))
+    (cl-case aw-scope
+      (global
+       (cl-mapcan #'window-list (frame-list)))
+      (frame
+       (window-list))
+      (t
+       (error "Invalid `aw-scope': %S" aw-scope))))
+   'aw-window<))
+
+(defvar aw-overlays-lead nil
+  "Hold overlays for leading chars.")
+
+(defvar aw-overlays-back nil
+  "Hold overlays for when `aw-background' is t.")
+
+(defvar ace-window-mode nil
+  "Minor mode during the selection process.")
+
+;; register minor mode
+(or (assq 'ace-window-mode minor-mode-alist)
+    (nconc minor-mode-alist
+           (list '(ace-window-mode ace-window-mode))))
+
+(defun aw--done ()
+  "Clean up mode line and overlays."
+  ;; mode line
+  (setq ace-window-mode nil)
+  (force-mode-line-update)
+  ;; background
+  (mapc #'delete-overlay aw-overlays-back)
+  (setq aw-overlays-back nil)
+  (aw--remove-leading-chars))
+
+(defun aw--lead-overlay (path leaf)
+  "Create an overlay using PATH at LEAF.
+LEAF is (PT . WND)."
+  (let* ((pt (car leaf))
+         (wnd (cdr leaf))
+         (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
+         (old-str (with-selected-window wnd
+                    (buffer-substring pt (1+ pt))))
+         (new-str
+          (concat
+           (cl-case aw-leading-char-style
+             (char
+              (apply #'string (last path)))
+             (path
+              (apply #'string (reverse path)))
+             (t
+              (error "Bad `aw-leading-char-style': %S"
+                     aw-leading-char-style)))
+           (cond ((string-equal old-str "\t")
+                  (make-string (1- tab-width) ?\ ))
+                 ((string-equal old-str "\n")
+                  "\n")
+                 (t
+                  (make-string
+                   (max 0 (1- (string-width old-str)))
+                   ?\ ))))))
+    (overlay-put ol 'face 'aw-leading-char-face)
+    (overlay-put ol 'window wnd)
+    (overlay-put ol 'display new-str)
+    (push ol aw-overlays-lead)))
+
+(defun aw--remove-leading-chars ()
+  "Remove leading char overlays."
+  (mapc #'delete-overlay aw-overlays-lead)
+  (setq aw-overlays-lead nil))
+
+(defun aw--make-backgrounds (wnd-list)
+  "Create a dim background overlay for each window on WND-LIST."
+  (when aw-background
+    (setq aw-overlays-back
+          (mapcar (lambda (w)
+                    (let ((ol (make-overlay
+                               (window-start w)
+                               (window-end w)
+                               (window-buffer w))))
+                      (overlay-put ol 'face 'aw-background-face)
+                      ol))
+                  wnd-list))))
+
+(defvar aw--flip-keys nil
+  "Pre-processed `aw-flip-keys'.")
+
+(defcustom aw-flip-keys '("n")
+  "Keys which should select the last window."
+  :set (lambda (sym val)
+         (set sym val)
+         (setq aw--flip-keys
+               (mapcar (lambda (x) (aref (kbd x) 0)) val))))
+
+(defun aw-select (mode-line)
+  "Return a selected other window.
+Amend MODE-LINE to the mode line for the duration of the selection."
+  (let ((start-window (selected-window))
+        (next-window-scope (cl-case aw-scope
+                             ('global 'visible)
+                             ('frame 'frame)))
+        (wnd-list (aw-window-list))
+        final-window)
+    (cl-case (length wnd-list)
+      (0
+       start-window)
+      (1
+       (car wnd-list))
+      (2
+       (setq final-window (next-window nil nil next-window-scope))
+       (while (and (aw-ignored-p final-window)
+                   (not (equal final-window start-window)))
+         (setq final-window (next-window final-window nil next-window-scope)))
+       final-window)
+      (t
+       (let ((candidate-list
+              (mapcar (lambda (wnd)
+                        ;; can't jump if the buffer is empty
+                        (with-current-buffer (window-buffer wnd)
+                          (when (= 0 (buffer-size))
+                            (insert " ")))
+                        (cons (aw-offset wnd) wnd))
+                      wnd-list)))
+         (aw--make-backgrounds wnd-list)
+         (setq ace-window-mode mode-line)
+         (force-mode-line-update)
+         ;; turn off helm transient map
+         (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
+         (unwind-protect
+              (condition-case err
+                  (or (cdr (avy-read (avy-tree candidate-list aw-keys)
+                                     #'aw--lead-overlay
+                                     #'aw--remove-leading-chars))
+                      start-window)
+                (error
+                 (if (memq (caddr err) aw--flip-keys)
+                     (aw--pop-window)
+                   (signal (car err) (cdr err)))))
+           (aw--done)))))))
+
+;;* Interactive
+;;;###autoload
+(defun ace-select-window ()
+  "Ace select window."
+  (interactive)
+  (aw-switch-to-window
+   (aw-select " Ace - Window")))
+
+;;;###autoload
+(defun ace-delete-window ()
+  "Ace delete window."
+  (interactive)
+  (aw-delete-window
+   (aw-select " Ace - Delete Window")))
+
+;;;###autoload
+(defun ace-swap-window ()
+  "Ace swap window."
+  (interactive)
+  (aw-swap-window
+   (aw-select " Ace - Swap Window")))
+
+;;;###autoload
+(defun ace-maximize-window ()
+  "Ace maximize window."
+  (interactive)
+  (select-window
+   (aw-select " Ace - Maximize Window"))
+  (delete-other-windows))
+
+;;;###autoload
+(defun ace-window (arg)
+  "Select a window.
+Perform an action based on ARG described below.
+
+By default, behaves like extended `other-window'.
+
+Prefixed with one \\[universal-argument], does a swap between the
+selected window and the current window, so that the selected
+buffer moves to current window (and current buffer moves to
+selected window).
+
+Prefixed with two \\[universal-argument]'s, deletes the selected
+window."
+  (interactive "p")
+  (cl-case arg
+    (0
+     (setq aw-ignore-on
+           (not aw-ignore-on))
+     (ace-select-window))
+    (4 (ace-swap-window))
+    (16 (ace-delete-window))
+    (t (ace-select-window))))
+
+;;* Utility
+(defun aw-window< (wnd1 wnd2)
+  "Return true if WND1 is less than WND2.
+This is determined by their respective window coordinates.
+Windows are numbered top down, left to right."
+  (let ((f1 (window-frame wnd1))
+        (f2 (window-frame wnd2))
+        (e1 (window-edges wnd1))
+        (e2 (window-edges wnd2)))
+    (cond ((string< (frame-parameter f1 'window-id)
+                    (frame-parameter f2 'window-id))
+           t)
+          ((< (car e1) (car e2))
+           t)
+          ((> (car e1) (car e2))
+           nil)
+          ((< (cadr e1) (cadr e2))
+           t))))
+
+(defvar aw--window-ring (make-ring 10)
+  "Hold the window switching history.")
+
+(defun aw--push-window (window)
+  "Store WINDOW to `aw--window-ring'."
+  (when (or (zerop (ring-length aw--window-ring))
+            (not (equal
+                  (ring-ref aw--window-ring 0)
+                  window)))
+    (ring-insert aw--window-ring (selected-window))))
+
+(defun aw--pop-window ()
+  "Return the removed top of `aw--window-ring'."
+  (let (res)
+    (condition-case nil
+        (while (not (window-live-p
+                     (setq res (ring-remove aw--window-ring 0)))))
+      (error
+       (error "No previous windows stored")))
+    res))
+
+(defun aw-switch-to-window (window)
+  "Switch to the window WINDOW."
+  (let ((frame (window-frame window)))
+    (when (and (frame-live-p frame)
+               (not (eq frame (selected-frame))))
+      (select-frame-set-input-focus frame))
+    (if (window-live-p window)
+        (progn
+          (aw--push-window (selected-window))
+          (select-window window))
+      (error "Got a dead window %S" window))))
+
+(defun aw-flip-window ()
+  "Switch to the window you were previously in."
+  (interactive)
+  (aw-switch-to-window (aw--pop-window)))
+
+(defun aw-delete-window (window)
+  "Delete window WINDOW."
+  (let ((frame (window-frame window)))
+    (when (and (frame-live-p frame)
+               (not (eq frame (selected-frame))))
+      (select-frame-set-input-focus (window-frame window)))
+    (if (= 1 (length (window-list)))
+        (delete-frame frame)
+      (if (window-live-p window)
+          (delete-window window)
+        (error "Got a dead window %S" window)))))
+
+(defun aw-swap-window (window)
+  "Swap buffers of current window and WINDOW."
+  (cl-labels ((swap-windows (window1 window2)
+                "Swap the buffers of WINDOW1 and WINDOW2."
+                (let ((buffer1 (window-buffer window1))
+                      (buffer2 (window-buffer window2)))
+                  (set-window-buffer window1 buffer2)
+                  (set-window-buffer window2 buffer1)
+                  (select-window window2))))
+    (let ((frame (window-frame window))
+          (this-window (selected-window)))
+      (when (and (frame-live-p frame)
+                 (not (eq frame (selected-frame))))
+        (select-frame-set-input-focus (window-frame window)))
+      (when (and (window-live-p window)
+                 (not (eq window this-window)))
+        (aw--push-window this-window)
+        (swap-windows this-window window)))))
+
+(defun aw-offset (window)
+  "Return point in WINDOW that's closest to top left corner.
+The point is writable, i.e. it's not part of space after newline."
+  (let ((h (window-hscroll window))
+        (beg (window-start window))
+        (end (window-end window))
+        (inhibit-field-text-motion t))
+    (with-current-buffer
+        (window-buffer window)
+      (save-excursion
+        (goto-char beg)
+        (while (and (< (point) end)
+                    (< (- (line-end-position)
+                          (line-beginning-position))
+                       h))
+          (forward-line))
+        (+ (point) h)))))
+
+;;* Mode line
+;;;###autoload
+(define-minor-mode ace-window-display-mode
+    "Minor mode for showing the ace window key in the mode line."
+  :global t
+  (if ace-window-display-mode
+      (progn
+        (aw-update)
+        (set-default
+         'mode-line-format
+         `((ace-window-display-mode
+            (:eval (window-parameter (selected-window) 'ace-window-path)))
+           ,@(assq-delete-all
+              'ace-window-display-mode
+              (default-value 'mode-line-format))))
+        (force-mode-line-update t)
+        (add-hook 'window-configuration-change-hook 'aw-update))
+    (set-default
+     'mode-line-format
+     (assq-delete-all
+      'ace-window-display-mode
+      (default-value 'mode-line-format)))
+    (remove-hook 'window-configuration-change-hook 'aw-update)))
+
+(defun aw-update ()
+  "Update ace-window-path window parameter for all windows."
+  (avy-traverse
+   (avy-tree (aw-window-list) aw-keys)
+   (lambda (path leaf)
+     (set-window-parameter
+      leaf 'ace-window-path
+      (propertize
+       (apply #'string (reverse path))
+       'face 'aw-mode-line-face)))))
+
+(provide 'ace-window)
+
+;;; ace-window.el ends here
diff --git a/packages/ace-window/avy-jump.el b/packages/ace-window/avy-jump.el
new file mode 100644
index 0000000..13b6102
--- /dev/null
+++ b/packages/ace-window/avy-jump.el
@@ -0,0 +1,259 @@
+;;; avy-jump.el --- jump to things tree-style
+
+;; Author: Oleh Krehel <address@hidden>
+;; Version: 0.1.0
+;; Keywords: point
+
+;; This file is not 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)
+(require 'ace-window)
+
+;;* 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)
+
+(defface avi-lead-face
+  '((t (:foreground "white" :background "#e52b50")))
+  "Face used for the leading chars.")
+
+;;* 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)))
+      (goto-char pt))))
+
+(defun avi--process (candidates overlay-fn)
+  "Select one of CANDIDATES using `avy-read'."
+  (unwind-protect
+       (let ((aw-background avi-background))
+         (cl-case (length candidates)
+           (0
+            nil)
+           (1
+            (car candidates))
+           (t
+            (aw--make-backgrounds (list (selected-window)))
+            (avy-read (avy-tree candidates avi-keys)
+                      overlay-fn
+                      #'aw--remove-leading-chars))))
+    (aw--done)))
+
+(defun avi--regex-candidates (regex &optional wnd beg end)
+  "Return all elements that match REGEX in WND.
+Each element of the list is ((BEG . END) . WND)."
+  (setq wnd (or wnd (selected-window)))
+  (let ((we (or end (window-end (selected-window) t)))
+        candidates)
+    (save-window-excursion
+      (select-window wnd)
+      (save-excursion
+        (goto-char (or beg (window-start)))
+        (while (re-search-forward regex we t)
+          (push (cons (cons (match-beginning 0)
+                            (match-end 0))
+                      wnd) candidates)))
+      (nreverse candidates))))
+
+(defun avi--overlay (str pt wnd)
+  "Create an overlay with STR at PT in WND."
+  (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 'aw-background-face)))
+    (overlay-put ol 'window wnd)
+    (overlay-put ol 'display (concat str old-str))
+    (push ol aw-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)
+   (if (consp (car leaf))
+       (caar leaf)
+     (car leaf))
+   (cdr leaf)))
+
+(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)
+   (if (consp (car leaf))
+       (cdar leaf)
+     (car leaf))
+   (cdr leaf)))
+
+;;* Commands
+;;;###autoload
+(defun avi-goto-char ()
+  "Read one char and jump to it in current window."
+  (interactive)
+  (avi--goto
+   (avi--process
+    (avi--regex-candidates
+     (string (read-char "char: "))
+     (selected-window))
+    #'avi--overlay-post)))
+
+;;;###autoload
+(defun avi-goto-char-2 ()
+  "Read two chars and jump to them in current window."
+  (interactive)
+  (avi--goto
+   (avi--process
+    (avi--regex-candidates
+     (string
+      (read-char "char 1: ")
+      (read-char "char 2: "))
+     (selected-window))
+    #'avi--overlay-post)))
+
+;;;###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 ()
+  "Jump to a word start in current window."
+  (interactive)
+  (let* ((avi-keys (number-sequence ?a ?z))
+         (candidates (avi--regex-candidates "\\b\\sw")))
+    (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 ((candidates (avi--regex-candidates
+                     (concat
+                      "\\b"
+                      (string (read-char "char: "))))))
+    (avi--goto
+     (avi--process candidates #'avi--overlay-pre))))
+
+(defun avi--line ()
+  "Select line in current window."
+  (let ((avi-background nil)
+        candidates)
+    (save-excursion
+      (save-restriction
+        (narrow-to-region (window-start) (window-end (selected-window) t))
+        (goto-char (point-min))
+        (while (< (point) (point-max))
+          (push (cons (point) (selected-window))
+                candidates)
+          (forward-line 1))))
+    (avi--process (nreverse candidates) #'avi--overlay-pre)))
+
+;;;###autoload
+(defun avi-goto-line ()
+  "Jump to a line start in current buffer."
+  (interactive)
+  (avi--goto (avi--line)))
+
+;;;###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)))))
+
+;;;###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/packages/ace-window/avy-test.el b/packages/ace-window/avy-test.el
new file mode 100644
index 0000000..84d9766
--- /dev/null
+++ b/packages/ace-window/avy-test.el
@@ -0,0 +1,42 @@
+(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/ace-window/avy.el b/packages/ace-window/avy.el
new file mode 100644
index 0000000..ebaec20
--- /dev/null
+++ b/packages/ace-window/avy.el
@@ -0,0 +1,119 @@
+;;; avy.el --- set-based completion -*- lexical-binding: t -*-
+
+;; Copyright (C) 2015 Oleh Krehel
+
+;; Author: Oleh Krehel <address@hidden>
+;; Version: 0.1.0
+;; Keywords: completion
+
+;; This file is not 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:
+
+(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))))
+         (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]