branch: master commit b11606c5ae9b9948da5d5431d6ff939ad7254ffb Merge: 6afd045 2580bf9 Author: Oleh Krehel <ohwoeo...@gmail.com> Commit: Oleh Krehel <ohwoeo...@gmail.com>
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 <ohwoeo...@gmail.com> +;; 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 <ohwoeo...@gmail.com> +;; 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 <ohwoeo...@gmail.com> +;; 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