;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*- ;; Copyright (C) 2015 Free Software Foundation, Inc. ;; Author: Oleh Krehel ;; Maintainer: Oleh Krehel ;; URL: https://github.com/abo-abo/ace-window ;; Package-Version: 20180814.1516 ;; Version: 0.9.0 ;; Package-Requires: ((avy "0.2.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 . ;;; Commentary: ;; ;; The main function, `ace-window' is meant to replace `other-window' ;; by assigning each window a short, unique label. When there are only ;; two windows present, `other-window' is called (unless ;; aw-dispatch-always is set non-nil). If there are more, each ;; window will have its first label character highlighted. Once a ;; unique label is typed, ace-window will switch to that window. ;; ;; To setup this package, just add to your .emacs: ;; ;; (global-set-key (kbd "M-o") 'ace-window) ;; ;; replacing "M-o" with an appropriate shortcut. ;; ;; By default, ace-window uses numbers for window labels so the window ;; labeling is intuitively ordered. But if you prefer to type keys on ;; your home row for quicker access, use this setting: ;; ;; (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)) ;; ;; Whenever ace-window prompts for a window selection, it grays out ;; all the window characters, highlighting window labels in red. To ;; disable this behavior, set this: ;; ;; (setq aw-background nil) ;; ;; If you want to know the selection characters ahead of time, turn on ;; `ace-window-display-mode'. ;; ;; When prefixed with one `universal-argument', instead of switching ;; to the selected window, the selected window is swapped with the ;; current one. ;; ;; When prefixed with two `universal-argument', the selected window is ;; deleted instead. ;;; Code: (require 'avy) (require 'ring) (require 'subr-x) ;;* 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." :type '(repeat character)) (defcustom aw-scope 'global "The scope used by `ace-window'." :type '(choice (const :tag "visible frames" visible) (const :tag "global" global) (const :tag "frame" frame))) (defcustom aw-minibuffer-flag nil "When non-nil, also display `ace-window-mode' string in the minibuffer when ace-window is active." :type 'boolean) (defcustom aw-ignored-buffers '("*Calc Trail*" "*LV*") "List of buffers and major-modes to ignore when choosing a window from the window list. Active only when `aw-ignore-on' is non-nil. Windows displaying these buffers can still be chosen by typing their specific labels." :type '(repeat string)) (defcustom aw-ignore-on t "When t, `ace-window' will ignore buffers and major-modes in `aw-ignored-buffers'. Use M-0 `ace-window' to toggle this value." :type 'boolean) (defcustom aw-ignore-current nil "When t, `ace-window' will ignore `selected-window'." :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))) (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) (defcustom aw-dispatch-when-more-than 2 "If the number of windows is more than this, activate ace-window-ness." :type 'integer) (defcustom aw-reverse-frame-list nil "When non-nil `ace-window' will order frames for selection in the reverse of `frame-list'" :type 'boolean) (defcustom aw-frame-offset '(13 . 23) "Increase in pixel offset for new ace-window frames relative to the selected frame. Its value is an (x-offset . y-offset) pair in pixels." :type '(cons integer integer)) (defcustom aw-frame-size nil "Frame size to make new ace-window frames. Its value is a (width . height) pair in pixels or nil for the default frame size. (0 . 0) is special and means make the frame size the same as the last selected frame size." :type '(cons integer integer)) (defcustom aw-char-position 'top-left "Window positions of the character overlay. Consider changing this if the overlay tends to overlap with other things." :type '(choice (const :tag "top left corner only" 'top-left) (const :tag "both left corners" 'left))) ;; Must be defined before `aw-make-frame-char' since its :set function references this. (defvar aw-dispatch-alist '((?x aw-delete-window "Delete Window") (?m aw-swap-window "Swap Windows") (?M aw-move-window "Move Window") (?j aw-switch-buffer-in-window "Select Buffer") (?n aw-flip-window) (?u aw-switch-buffer-other-window "Switch Buffer Other Window") (?c aw-split-window-fair "Split Fair Window") (?v aw-split-window-vert "Split Vert Window") (?b aw-split-window-horz "Split Horz Window") (?o delete-other-windows "Delete Other Windows") (?? aw-show-dispatch-help)) "List of actions for `aw-dispatch-default'. Each action is a list of either: (char function description) where function takes a single window argument or (char function) where function takes no argument and the description is omitted.") (defun aw-set-make-frame-char (option value) ;; Signal an error if `aw-make-frame-char' is ever set to an invalid ;; or conflicting value. (when value (cond ((not (characterp value)) (user-error "`aw-make-frame-char' must be a character, not `%s'" value)) ((memq value aw-keys) (user-error "`aw-make-frame-char' is `%c'; this conflicts with the same character in `aw-keys'" value)) ((assq value aw-dispatch-alist) (user-error "`aw-make-frame-char' is `%c'; this conflicts with the same character in `aw-dispatch-alist'" value)))) (set option value)) (defcustom aw-make-frame-char ?z "Non-existing ace window label character that triggers creation of a new single-window frame for display." :set 'aw-set-make-frame-char :type 'character) (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.") (defface aw-key-face '((t :inherit font-lock-builtin-face)) "Face used by `aw-show-dispatch-help'.") ;;* Implementation (defun aw-ignored-p (window) "Return t if WINDOW should be ignored when choosing from the window list." (or (and aw-ignore-on ;; Ignore major-modes and buffer-names in `aw-ignored-buffers'. (or (memq (buffer-local-value 'major-mode (window-buffer window)) aw-ignored-buffers) (member (buffer-name (window-buffer window)) aw-ignored-buffers))) ;; Ignore selected window if `aw-ignore-current' is non-nil. (and aw-ignore-current (equal window (selected-window))) ;; When `ignore-window-parameters' is nil, ignore windows whose ;; `no-other-window’ or `no-delete-other-windows' parameter is non-nil. (unless ignore-window-parameters (cl-case this-command (ace-select-window (window-parameter window 'no-other-window)) (ace-delete-window (window-parameter window 'no-delete-other-windows)) (ace-delete-other-windows (window-parameter window 'no-delete-other-windows)))))) (defun aw-window-list () "Return the list of interesting windows." (sort (cl-remove-if (lambda (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)))) (cl-case aw-scope (visible (cl-mapcan #'window-list (visible-frame-list))) (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)))) (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 (aw-set-mode-line nil) ;; background (mapc #'delete-overlay aw-overlays-back) (setq aw-overlays-back nil) (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--overlay-str (wnd pos path) "Return the replacement text for an overlay in WND at POS, accessible by typing PATH." (let ((old-str (or (ignore-errors (with-selected-window wnd (buffer-substring pos (1+ pos)))) ""))) (concat (cl-case aw-leading-char-style (char (string (avy--key-to-char (car (last path))))) (path (mapconcat (lambda (x) (string (avy--key-to-char x))) (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))) ?\ )))))) (defun aw--lead-overlay (path leaf) "Create an overlay using PATH at LEAF. LEAF is (PT . WND)." (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)))) (overlay-put ol 'display (aw--overlay-str wnd pt path)) (overlay-put ol 'face 'aw-leading-char-face) (overlay-put ol 'window wnd) (push ol avy--overlays-lead)) (when (eq aw-char-position 'left) (let* ((pt (save-excursion ;; Move to the start of the last visible line in the buffer. (move-to-window-line -1) (move-beginning-of-line nil) ;; If this line is empty, use the previous line so we ;; have space for the overlay. (when (equal (point) (point-max)) (forward-line -1)) (point))) (ol (make-overlay pt (1+ pt) (window-buffer wnd)))) (overlay-put ol 'display (aw--overlay-str wnd pt path)) (overlay-put ol 'face 'aw-leading-char-face) (overlay-put ol 'window wnd) (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)))) (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) (when (and aw-minibuffer-flag ace-window-mode) (message "%s" (string-trim-left str))) (force-mode-line-update)) (defun aw--dispatch-action (char) "Return item from `aw-dispatch-alist' matching CHAR." (assoc char aw-dispatch-alist)) (defun aw-make-frame () "Make a new Emacs frame using the values of `aw-frame-size' and `aw-frame-offset'." (make-frame (delq nil (list ;; This first parameter is important because an ;; aw-dispatch-alist command may not want to leave this ;; frame with input focus. If it is given focus, the ;; command may not be able to return focus to a different ;; frame since this is done asynchronously by the window ;; manager. '(no-focus-on-map . t) (when aw-frame-size (cons 'width (if (zerop (car aw-frame-size)) (frame-width) (car aw-frame-size)))) (when aw-frame-size (cons 'height (if (zerop (cdr aw-frame-size)) (frame-height) (car aw-frame-size)))) (cons 'left (+ (car aw-frame-offset) (car (frame-position)))) (cons 'top (+ (cdr aw-frame-offset) (cdr (frame-position)))))))) (defun aw-use-frame (window) "Create a new frame using the contents of WINDOW. The new frame is set to the same size as the previous frame, offset by `aw-frame-offset' (x . y) pixels." (aw-switch-to-window window) (aw-make-frame)) (defun aw-clean-up-avy-current-path () "Edit `avy-current-path' so only window label characters remain." ;; Remove any possible ace-window command char that may ;; precede the last specified window label, so ;; functions can use `avy-current-path' as the chosen ;; window label. (when (and (> (length avy-current-path) 0) (assq (aref avy-current-path 0) aw-dispatch-alist)) (setq avy-current-path (substring avy-current-path 1)))) (defun aw-dispatch-default (char) "Perform an action depending on CHAR." (cond ((and (fboundp 'avy-mouse-event-window) (avy-mouse-event-window char))) ((= char (aref (kbd "C-g") 0)) (throw 'done 'exit)) ((= char aw-make-frame-char) ;; Make a new frame and perform any action on its window. (let ((start-win (selected-window)) (end-win (frame-selected-window (aw-make-frame)))) (if aw-action ;; Action must be called from the start-win. The action ;; determines which window to leave selected. (progn (select-frame-set-input-focus (window-frame start-win)) (funcall aw-action end-win)) ;; Select end-win when no action (aw-switch-to-window end-win))) (throw 'done 'exit)) (t (let ((action (aw--dispatch-action char))) (if action (cl-destructuring-bind (_key fn &optional description) action (if (and fn description) (prog1 (setq aw-action fn) (aw-set-mode-line (format " Ace - %s" description))) (funcall fn) (throw 'done 'exit))) (aw-clean-up-avy-current-path) ;; Prevent any char from triggering an avy dispatch command. (let ((avy-dispatch-alist)) (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 ('visible 'visible) ('global 'visible) ('frame 'frame))) (wnd-list (aw-window-list)) 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) aw-dispatch-when-more-than) (not aw-dispatch-always) (not aw-ignore-current)) (let ((wnd (next-window nil nil next-window-scope))) (while (and (or (not (memq wnd wnd-list)) (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) (avy-translate-char-function #'identity) (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-select " Ace - Window" #'aw-switch-to-window)) ;;;###autoload (defun ace-delete-window () "Ace delete window." (interactive) (aw-select " Ace - Delete Window" #'aw-delete-window)) ;;;###autoload (defun ace-swap-window () "Ace swap window." (interactive) (aw-select " Ace - Swap Window" #'aw-swap-window)) ;;;###autoload (defun ace-delete-other-windows () "Ace delete other windows." (interactive) (aw-select " Ace - Delete Other Windows" #'delete-other-windows)) (define-obsolete-function-alias 'ace-maximize-window 'ace-delete-other-windows "0.10.0") ;;;###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 (unless (fboundp 'frame-position) (defun frame-position (&optional frame) (let ((pl (frame-parameter frame 'left)) (pt (frame-parameter frame 'top))) (when (consp pl) (setq pl (eval pl))) (when (consp pt) (setq pt (eval pt))) (cons pl pt)))) (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 ((< (car (frame-position f1)) (car (frame-position f2))) (not aw-reverse-frame-list)) ((> (car (frame-position f1)) (car (frame-position f2))) aw-reverse-frame-list) ((< (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 (or (not (window-live-p (setq res (ring-remove aw--window-ring 0)))) (equal res (selected-window)))) (error (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) "Switch to the window WINDOW." (let ((frame (window-frame window))) (aw--push-window (selected-window)) (when (and (frame-live-p frame) (not (eq frame (selected-frame)))) (select-frame-set-input-focus frame)) (if (window-live-p 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-show-dispatch-help () "Display action shortucts in echo area." (interactive) (message "%s" (mapconcat (lambda (action) (cl-destructuring-bind (key fn &optional description) action (format "%s: %s" (propertize (char-to-string key) 'face 'aw-key-face) (or description fn)))) aw-dispatch-alist "\n")) ;; Prevent this from replacing any help display ;; in the minibuffer. (let (aw-minibuffer-flag) (mapc #'delete-overlay aw-overlays-back) (call-interactively 'ace-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-switch-buffer-in-window (window) "Select buffer in WINDOW." (aw-switch-to-window window) (aw--switch-buffer)) (declare-function ivy-switch-buffer "ext:ivy") (defun aw--switch-buffer () (cond ((bound-and-true-p ivy-mode) (ivy-switch-buffer)) ((bound-and-true-p ido-mode) (ido-switch-buffer)) (t (call-interactively 'switch-to-buffer)))) (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) "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) (if aw-swap-invert (swap-windows window this-window) (swap-windows this-window window)))))) (defun aw-move-window (window) "Move the current buffer to WINDOW. Switch the current window to the previous buffer." (let ((buffer (current-buffer))) (switch-to-buffer (other-buffer)) (aw-switch-to-window window) (switch-to-buffer buffer))) (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)) (defcustom aw-fair-aspect-ratio 2 "The aspect ratio to aim for when splitting windows. Sizes are based on the number of characters, not pixels. Increase to prefer wider windows, or decrease for taller windows." :type 'number) (defun aw-split-window-fair (window) "Split WINDOW vertically or horizontally, based on its current dimensions. Modify `aw-fair-aspect-ratio' to tweak behavior." (let ((w (window-body-width window)) (h (window-body-height window))) (if (< (* h aw-fair-aspect-ratio) w) (aw-split-window-horz window) (aw-split-window-vert window)))) (defun aw-switch-buffer-other-window (window) "Switch buffer in WINDOW without selecting WINDOW." (aw-switch-to-window window) (aw--switch-buffer) (aw-flip-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) ;; Add at the end so does not precede select-frame call. (add-hook 'after-make-frame-functions (lambda (_) (aw-update)) t)) (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) (remove-hook 'after-make-frame-functions 'aw-update))) (defun aw-update () "Update ace-window-path window parameter for all windows. Ensure all windows are labeled so the user can select a specific one, even from the set of windows typically ignored when making a window list." (let ((aw-ignore-on) (aw-ignore-current) (ignore-window-parameters t)) (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