You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

466 lines
15 KiB

;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*-
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; 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"))
;; Keywords: window, 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:
;;
;; The main function, `ace-window' is meant to replace `other-window'.
;; In 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 are 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)
;;
;; If you want to know the selection characters ahead of time, you can
;; turn on `ace-window-display-mode'.
;;
;; 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-jump)
(require 'ring)
;;* 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-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)
(avy--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 (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")
(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."
(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
#'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)))))))
;;* 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