;; Author: Oleh Krehel <ohwoeowho@gmail.com>
;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com>
;; URL: https://github.com/abo-abo/ace-window
- ;; Version: 0.8.1
- ;; Package-Requires: ((avy "0.1.0"))
+ ;; Version: 0.9.0
+ ;; Package-Requires: ((avy "0.2.0"))
;; Keywords: window, location
;; This file is part of GNU Emacs.
;; deleted instead.
;;; Code:
- (require 'avy-jump)
+ (require 'avy)
(require 'ring)
;;* Customization
(const :tag "single char" 'char)
(const :tag "full path" 'path)))
+ (defcustom aw-dispatch-always nil
+ "When non-nil, `ace-window' will issue a `read-char' even for one window.
+ This will make `ace-window' act different from `other-window' for
+ one or two windows."
+ :type 'boolean)
+
(defface aw-leading-char-face
'((((class color)) (:foreground "red"))
(((background dark)) (:foreground "gray100"))
(sort
(cl-remove-if
(lambda (w)
- (let ((f (window-frame w))
- (b (window-buffer w)))
+ (let ((f (window-frame 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)))))))
+ (aw-ignored-p w))))
(cl-case aw-scope
(global
(cl-mapcan #'window-list (frame-list)))
(nconc minor-mode-alist
(list '(ace-window-mode ace-window-mode))))
+ (defvar aw-empty-buffers-list nil
+ "Store the read-only empty buffers which had to be modified.
+ Modify them back eventually.")
+
(defun aw--done ()
"Clean up mode line and overlays."
;; mode line
- (setq ace-window-mode nil)
- (force-mode-line-update)
+ (aw-set-mode-line nil)
;; background
(mapc #'delete-overlay aw-overlays-back)
(setq aw-overlays-back nil)
- (avy--remove-leading-chars))
+ (avy--remove-leading-chars)
+ (dolist (b aw-empty-buffers-list)
+ (with-current-buffer b
+ (when (string= (buffer-string) " ")
+ (let ((inhibit-read-only t))
+ (delete-region (point-min) (point-max))))))
+ (setq aw-empty-buffers-list nil))
(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 (or
- (ignore-errors
- (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")
+ (let ((wnd (cdr leaf)))
+ (with-selected-window wnd
+ (when (= 0 (buffer-size))
+ (push (current-buffer) aw-empty-buffers-list)
+ (let ((inhibit-read-only t))
+ (insert " ")))
+ (let* ((pt (car leaf))
+ (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
+ (old-str (or
+ (ignore-errors
+ (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
- (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 avy--overlays-lead)))
+ (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 avy--overlays-lead)))))
(defun aw--make-backgrounds (wnd-list)
"Create a dim background overlay for each window on WND-LIST."
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)
+ (define-obsolete-variable-alias
+ 'aw-flip-keys 'aw--flip-keys "0.1.0"
+ "Use `aw-dispatch-alist' instead.")
+
+ (defvar aw-dispatch-function 'aw-dispatch-default
+ "Function to call when a character not in `aw-keys' is pressed.")
+
+ (defvar aw-action nil
+ "Function to call at the end of `aw-select'.")
+
+ (defun aw-set-mode-line (str)
+ "Set mode line indicator to STR."
+ (setq ace-window-mode str)
+ (force-mode-line-update))
+
+ (defvar aw-dispatch-alist
+ '((?x aw-delete-window " Ace - Delete Window")
+ (?m aw-swap-window " Ace - Swap Window")
+ (?n aw-flip-window)
+ (?v aw-split-window-vert " Ace - Split Vert Window")
+ (?b aw-split-window-horz " Ace - Split Horz Window")
+ (?i delete-other-windows " Ace - Maximize Window")
+ (?o delete-other-windows))
+ "List of actions for `aw-dispatch-default'.")
+
+ (defun aw-dispatch-default (char)
+ "Perform an action depending on CHAR."
+ (let ((val (cdr (assoc char aw-dispatch-alist))))
+ (if val
+ (if (and (car val) (cadr val))
+ (prog1 (setq aw-action (car val))
+ (aw-set-mode-line (cadr val)))
+ (funcall (car val))
+ (throw 'done 'exit))
+ (avy-handler-default char))))
+
+ (defun aw-select (mode-line &optional action)
"Return a selected other window.
Amend MODE-LINE to the mode line for the duration of the selection."
+ (setq aw-action action)
(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
- #'avy--remove-leading-chars))
- start-window)
- (error
- (if (memq (nth 2 err) aw--flip-keys)
- (aw--pop-window)
- (signal (car err) (cdr err)))))
- (aw--done)))))))
+ window)
+ (setq window
+ (cond ((<= (length wnd-list) 1)
+ (when aw-dispatch-always
+ (setq aw-action
+ (unwind-protect
+ (catch 'done
+ (funcall aw-dispatch-function (read-char)))
+ (aw--done)))
+ (when (eq aw-action 'exit)
+ (setq aw-action nil)))
+ (or (car wnd-list) start-window))
+ ((and (= (length wnd-list) 2)
+ (not aw-dispatch-always)
+ (not aw-ignore-current))
+ (let ((wnd (next-window nil nil next-window-scope)))
+ (while (and (aw-ignored-p wnd)
+ (not (equal wnd start-window)))
+ (setq wnd (next-window wnd nil next-window-scope)))
+ wnd))
+ (t
+ (let ((candidate-list
+ (mapcar (lambda (wnd)
+ (cons (aw-offset wnd) wnd))
+ wnd-list)))
+ (aw--make-backgrounds wnd-list)
+ (aw-set-mode-line mode-line)
+ ;; turn off helm transient map
+ (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
+ (unwind-protect
+ (let* ((avy-handler-function aw-dispatch-function)
+ (res (avy-read (avy-tree candidate-list aw-keys)
+ #'aw--lead-overlay
+ #'avy--remove-leading-chars)))
+ (if (eq res 'exit)
+ (setq aw-action nil)
+ (or (cdr res)
+ start-window)))
+ (aw--done))))))
+ (if aw-action
+ (funcall aw-action window)
+ window)))
;;* Interactive
;;;###autoload
(defun ace-select-window ()
"Ace select window."
(interactive)
- (aw-switch-to-window
- (aw-select " Ace - Window")))
+ (aw-select " Ace - Window"
+ #'aw-switch-to-window))
;;;###autoload
(defun ace-delete-window ()
"Ace delete window."
(interactive)
- (aw-delete-window
- (aw-select " Ace - Delete Window")))
+ (aw-select " Ace - Delete Window"
+ #'aw-delete-window))
;;;###autoload
(defun ace-swap-window ()
"Ace swap window."
(interactive)
- (aw-swap-window
- (aw-select " Ace - Swap Window")))
+ (aw-select " Ace - Swap Window"
+ #'aw-swap-window))
;;;###autoload
(defun ace-maximize-window ()
"Ace maximize window."
(interactive)
- (select-window
- (aw-select " Ace - Maximize Window"))
- (delete-other-windows))
+ (aw-select " Ace - Maximize Window"
+ #'delete-other-windows))
;;;###autoload
(defun ace-window (arg)
"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)))))
+ (while (or (not (window-live-p
+ (setq res (ring-remove aw--window-ring 0))))
+ (equal res (selected-window))))
(error
- (error "No previous windows stored")))
+ (if (= (length (aw-window-list)) 2)
+ (progn
+ (other-window 1)
+ (setq res (selected-window)))
+ (error "No previous windows stored"))))
res))
(defun aw-switch-to-window (window)
(delete-window window)
(error "Got a dead window %S" window)))))
+ (defcustom aw-swap-invert nil
+ "When non-nil, the other of the two swapped windows gets the point."
+ :type 'boolean)
+
(defun aw-swap-window (window)
"Swap buffers of current window and WINDOW."
(cl-labels ((swap-windows (window1 window2)
(when (and (window-live-p window)
(not (eq window this-window)))
(aw--push-window this-window)
- (swap-windows this-window window)))))
+ (if aw-swap-invert
+ (swap-windows window this-window)
+ (swap-windows this-window window))))))
+
+ (defun aw-split-window-vert (window)
+ "Split WINDOW vertically."
+ (select-window window)
+ (split-window-vertically))
+
+ (defun aw-split-window-horz (window)
+ "Split WINDOW horizontally."
+ (select-window window)
+ (split-window-horizontally))
(defun aw-offset (window)
"Return point in WINDOW that's closest to top left corner.