ace-window.el (34993B)
1 ;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*- 2 3 ;; Copyright (C) 2015-2020 Free Software Foundation, Inc. 4 5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com> 6 ;; Maintainer: Oleh Krehel <ohwoeowho@gmail.com> 7 ;; URL: https://github.com/abo-abo/ace-window 8 ;; Version: 0.10.0 9 ;; Package-Requires: ((avy "0.5.0")) 10 ;; Keywords: window, location 11 12 ;; This file is part of GNU Emacs. 13 14 ;; This file is free software; you can redistribute it and/or modify 15 ;; it under the terms of the GNU General Public License as published by 16 ;; the Free Software Foundation; either version 3, or (at your option) 17 ;; any later version. 18 19 ;; This program is distributed in the hope that it will be useful, 20 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22 ;; GNU General Public License for more details. 23 24 ;; For a full copy of the GNU General Public License 25 ;; see <http://www.gnu.org/licenses/>. 26 27 ;;; Commentary: 28 ;; 29 ;; The main function, `ace-window' is meant to replace `other-window' 30 ;; by assigning each window a short, unique label. When there are only 31 ;; two windows present, `other-window' is called (unless 32 ;; aw-dispatch-always is set non-nil). If there are more, each 33 ;; window will have its first label character highlighted. Once a 34 ;; unique label is typed, ace-window will switch to that window. 35 ;; 36 ;; To setup this package, just add to your .emacs: 37 ;; 38 ;; (global-set-key (kbd "M-o") 'ace-window) 39 ;; 40 ;; replacing "M-o" with an appropriate shortcut. 41 ;; 42 ;; By default, ace-window uses numbers for window labels so the window 43 ;; labeling is intuitively ordered. But if you prefer to type keys on 44 ;; your home row for quicker access, use this setting: 45 ;; 46 ;; (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l)) 47 ;; 48 ;; Whenever ace-window prompts for a window selection, it grays out 49 ;; all the window characters, highlighting window labels in red. To 50 ;; disable this behavior, set this: 51 ;; 52 ;; (setq aw-background nil) 53 ;; 54 ;; If you want to know the selection characters ahead of time, turn on 55 ;; `ace-window-display-mode'. 56 ;; 57 ;; When prefixed with one `universal-argument', instead of switching 58 ;; to the selected window, the selected window is swapped with the 59 ;; current one. 60 ;; 61 ;; When prefixed with two `universal-argument', the selected window is 62 ;; deleted instead. 63 64 ;;; Code: 65 (require 'avy) 66 (require 'ring) 67 (require 'subr-x) 68 69 ;;* Customization 70 (defgroup ace-window nil 71 "Quickly switch current window." 72 :group 'convenience 73 :prefix "aw-") 74 75 (defcustom aw-keys '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9) 76 "Keys for selecting window." 77 :type '(repeat character)) 78 79 (defcustom aw-scope 'global 80 "The scope used by `ace-window'." 81 :type '(choice 82 (const :tag "visible frames" visible) 83 (const :tag "global" global) 84 (const :tag "frame" frame))) 85 86 (defcustom aw-translate-char-function #'identity 87 "Function to translate user input key into another key. 88 For example, to make SPC do the same as ?a, use 89 \(lambda (c) (if (= c 32) ?a c))." 90 :type '(choice 91 (const :tag "Off" #'identity) 92 (const :tag "Ignore Case" #'downcase) 93 (function :tag "Custom"))) 94 95 (defcustom aw-minibuffer-flag nil 96 "When non-nil, also display `ace-window-mode' string in the minibuffer when ace-window is active." 97 :type 'boolean) 98 99 (defcustom aw-ignored-buffers '("*Calc Trail*" " *LV*") 100 "List of buffers and major-modes to ignore when choosing a window from the window list. 101 Active only when `aw-ignore-on' is non-nil." 102 :type '(repeat string)) 103 104 (defcustom aw-ignore-on t 105 "When t, `ace-window' will ignore buffers and major-modes in `aw-ignored-buffers'. 106 Use M-0 `ace-window' to toggle this value." 107 :type 'boolean) 108 109 (defcustom aw-ignore-current nil 110 "When t, `ace-window' will ignore `selected-window'." 111 :type 'boolean) 112 113 (defcustom aw-background t 114 "When t, `ace-window' will dim out all buffers temporarily when used." 115 :type 'boolean) 116 117 (defcustom aw-leading-char-style 'char 118 "Style of the leading char overlay." 119 :type '(choice 120 (const :tag "single char" 'char) 121 (const :tag "full path" 'path))) 122 123 (defcustom aw-dispatch-always nil 124 "When non-nil, `ace-window' will issue a `read-char' even for one window. 125 This will make `ace-window' act different from `other-window' for 126 one or two windows." 127 :type 'boolean) 128 129 (defcustom aw-dispatch-when-more-than 2 130 "If the number of windows is more than this, activate ace-window-ness." 131 :type 'integer) 132 133 (defcustom aw-reverse-frame-list nil 134 "When non-nil `ace-window' will order frames for selection in 135 the reverse of `frame-list'" 136 :type 'boolean) 137 138 (defcustom aw-frame-offset '(13 . 23) 139 "Increase in pixel offset for new ace-window frames relative to the selected frame. 140 Its value is an (x-offset . y-offset) pair in pixels." 141 :type '(cons integer integer)) 142 143 (defcustom aw-frame-size nil 144 "Frame size to make new ace-window frames. 145 Its value is a (width . height) pair in pixels or nil for the default frame size. 146 (0 . 0) is special and means make the frame size the same as the last selected frame size." 147 :type '(cons integer integer)) 148 149 (defcustom aw-char-position 'top-left 150 "Window positions of the character overlay. 151 Consider changing this if the overlay tends to overlap with other things." 152 :type '(choice 153 (const :tag "top left corner only" 'top-left) 154 (const :tag "both left corners" 'left))) 155 156 ;; Must be defined before `aw-make-frame-char' since its :set function references this. 157 (defvar aw-dispatch-alist 158 '((?x aw-delete-window "Delete Window") 159 (?m aw-swap-window "Swap Windows") 160 (?M aw-move-window "Move Window") 161 (?c aw-copy-window "Copy Window") 162 (?j aw-switch-buffer-in-window "Select Buffer") 163 (?n aw-flip-window) 164 (?u aw-switch-buffer-other-window "Switch Buffer Other Window") 165 (?e aw-execute-command-other-window "Execute Command Other Window") 166 (?F aw-split-window-fair "Split Fair Window") 167 (?v aw-split-window-vert "Split Vert Window") 168 (?b aw-split-window-horz "Split Horz Window") 169 (?o delete-other-windows "Delete Other Windows") 170 (?T aw-transpose-frame "Transpose Frame") 171 ;; ?i ?r ?t are used by hyperbole.el 172 (?? aw-show-dispatch-help)) 173 "List of actions for `aw-dispatch-default'. 174 Each action is a list of either: 175 (char function description) where function takes a single window argument 176 or 177 (char function) where function takes no argument and the description is omitted.") 178 179 (defun aw-set-make-frame-char (option value) 180 ;; Signal an error if `aw-make-frame-char' is ever set to an invalid 181 ;; or conflicting value. 182 (when value 183 (cond ((not (characterp value)) 184 (user-error "`aw-make-frame-char' must be a character, not `%s'" value)) 185 ((memq value aw-keys) 186 (user-error "`aw-make-frame-char' is `%c'; this conflicts with the same character in `aw-keys'" value)) 187 ((assq value aw-dispatch-alist) 188 (user-error "`aw-make-frame-char' is `%c'; this conflicts with the same character in `aw-dispatch-alist'" value)))) 189 (set option value)) 190 191 (defcustom aw-make-frame-char ?z 192 "Non-existing ace window label character that triggers creation of a new single-window frame for display." 193 :set 'aw-set-make-frame-char 194 :type 'character) 195 196 (defface aw-leading-char-face 197 '((((class color)) (:foreground "red")) 198 (((background dark)) (:foreground "gray100")) 199 (((background light)) (:foreground "gray0")) 200 (t (:foreground "gray100" :underline nil))) 201 "Face for each window's leading char.") 202 203 (defface aw-minibuffer-leading-char-face 204 '((t :inherit aw-leading-char-face)) 205 "Face for minibuffer leading char.") 206 207 (defface aw-background-face 208 '((t (:foreground "gray40"))) 209 "Face for whole window background during selection.") 210 211 (defface aw-mode-line-face 212 '((t (:inherit mode-line-buffer-id))) 213 "Face used for displaying the ace window key in the mode-line.") 214 215 (defface aw-key-face 216 '((t :inherit font-lock-builtin-face)) 217 "Face used by `aw-show-dispatch-help'.") 218 219 ;;* Implementation 220 (defun aw-ignored-p (window) 221 "Return t if WINDOW should be ignored when choosing from the window list." 222 (or (and aw-ignore-on 223 ;; Ignore major-modes and buffer-names in `aw-ignored-buffers'. 224 (or (memq (buffer-local-value 'major-mode (window-buffer window)) 225 aw-ignored-buffers) 226 (member (buffer-name (window-buffer window)) aw-ignored-buffers))) 227 ;; ignore child frames 228 (and (fboundp 'frame-parent) (frame-parent (window-frame window))) 229 ;; Ignore selected window if `aw-ignore-current' is non-nil. 230 (and aw-ignore-current 231 (equal window (selected-window))) 232 ;; When `ignore-window-parameters' is nil, ignore windows whose 233 ;; `no-other-window’ or `no-delete-other-windows' parameter is non-nil. 234 (unless ignore-window-parameters 235 (cl-case this-command 236 (ace-select-window (window-parameter window 'no-other-window)) 237 (ace-delete-window (window-parameter window 'no-delete-other-windows)) 238 (ace-delete-other-windows (window-parameter 239 window 'no-delete-other-windows)))))) 240 241 (defun aw-window-list () 242 "Return the list of interesting windows." 243 (sort 244 (cl-remove-if 245 (lambda (w) 246 (let ((f (window-frame w))) 247 (or (not (and (frame-live-p f) 248 (frame-visible-p f))) 249 (string= "initial_terminal" (terminal-name f)) 250 (aw-ignored-p w)))) 251 (cl-case aw-scope 252 (visible 253 (cl-mapcan #'window-list (visible-frame-list))) 254 (global 255 (cl-mapcan #'window-list (frame-list))) 256 (frame 257 (window-list)) 258 (t 259 (error "Invalid `aw-scope': %S" aw-scope)))) 260 'aw-window<)) 261 262 (defvar aw-overlays-back nil 263 "Hold overlays for when `aw-background' is t.") 264 265 (defvar ace-window-mode nil 266 "Minor mode during the selection process.") 267 268 ;; register minor mode 269 (or (assq 'ace-window-mode minor-mode-alist) 270 (nconc minor-mode-alist 271 (list '(ace-window-mode ace-window-mode)))) 272 273 (defvar aw-empty-buffers-list nil 274 "Store the read-only empty buffers which had to be modified. 275 Modify them back eventually.") 276 277 (defvar aw--windows-hscroll nil 278 "List of (window . hscroll-columns) items, each listing a window whose 279 horizontal scroll will be restored upon ace-window action completion.") 280 281 (defvar aw--windows-points nil 282 "List of (window . point) items. The point position had to be 283 moved in order to display the overlay.") 284 285 (defun aw--done () 286 "Clean up mode line and overlays." 287 ;; mode line 288 (aw-set-mode-line nil) 289 ;; background 290 (mapc #'delete-overlay aw-overlays-back) 291 (setq aw-overlays-back nil) 292 (avy--remove-leading-chars) 293 (dolist (b aw-empty-buffers-list) 294 (with-current-buffer b 295 (when (string= (buffer-string) " ") 296 (let ((inhibit-read-only t)) 297 (delete-region (point-min) (point-max)))))) 298 (setq aw-empty-buffers-list nil) 299 (aw--restore-windows-hscroll) 300 (let (c) 301 (while (setq c (pop aw--windows-points)) 302 (with-selected-window (car c) 303 (goto-char (cdr c)))))) 304 305 (defun aw--restore-windows-hscroll () 306 "Restore horizontal scroll of windows from `aw--windows-hscroll' list." 307 (let (wnd hscroll) 308 (mapc (lambda (wnd-and-hscroll) 309 (setq wnd (car wnd-and-hscroll) 310 hscroll (cdr wnd-and-hscroll)) 311 (when (window-live-p wnd) 312 (set-window-hscroll wnd hscroll))) 313 aw--windows-hscroll)) 314 (setq aw--windows-hscroll nil)) 315 316 (defun aw--overlay-str (wnd pos path) 317 "Return the replacement text for an overlay in WND at POS, 318 accessible by typing PATH." 319 (let ((old-str (or 320 (ignore-errors 321 (with-selected-window wnd 322 (buffer-substring pos (1+ pos)))) 323 ""))) 324 (concat 325 (cl-case aw-leading-char-style 326 (char 327 (string (avy--key-to-char (car (last path))))) 328 (path 329 (mapconcat 330 (lambda (x) (string (avy--key-to-char x))) 331 (reverse path) 332 "")) 333 (t 334 (error "Bad `aw-leading-char-style': %S" 335 aw-leading-char-style))) 336 (cond ((string-equal old-str "\t") 337 (make-string (1- tab-width) ?\ )) 338 ((string-equal old-str "\n") 339 "\n") 340 (t 341 (make-string 342 (max 0 (1- (string-width old-str))) 343 ?\ )))))) 344 345 (defun aw--point-visible-p () 346 "Return non-nil if point is visible in the selected window. 347 Return nil when horizontal scrolling has moved it off screen." 348 (and (>= (- (current-column) (window-hscroll)) 0) 349 (< (- (current-column) (window-hscroll)) 350 (window-width)))) 351 352 (defun aw--lead-overlay (path leaf) 353 "Create an overlay using PATH at LEAF. 354 LEAF is (PT . WND)." 355 ;; Properly adds overlay in visible region of most windows except for any one 356 ;; receiving output while this function is executing, since that moves point, 357 ;; potentially shifting the added overlay outside the window's visible region. 358 (let ((wnd (cdr leaf)) 359 ;; Prevent temporary movement of point from scrolling any window. 360 (scroll-margin 0)) 361 (with-selected-window wnd 362 (when (= 0 (buffer-size)) 363 (push (current-buffer) aw-empty-buffers-list) 364 (let ((inhibit-read-only t)) 365 (insert " "))) 366 ;; If point is not visible due to horizontal scrolling of the 367 ;; window, this next expression temporarily scrolls the window 368 ;; right until point is visible, so that the leading-char can be 369 ;; seen when it is inserted. When ace-window's action finishes, 370 ;; the horizontal scroll is restored by (aw--done). 371 (while (and (not (aw--point-visible-p)) 372 (not (zerop (window-hscroll))) 373 (progn (push (cons (selected-window) (window-hscroll)) aw--windows-hscroll) t) 374 (not (zerop (scroll-right))))) 375 (let* ((ws (window-start)) 376 (prev nil) 377 (vertical-pos (if (eq aw-char-position 'left) -1 0)) 378 (horizontal-pos (if (zerop (window-hscroll)) 0 (1+ (window-hscroll)))) 379 (old-pt (point)) 380 (pt 381 (progn 382 ;; If leading-char is to be displayed at the top-left, move 383 ;; to the first visible line in the window, otherwise, move 384 ;; to the last visible line. 385 (move-to-window-line vertical-pos) 386 (move-to-column horizontal-pos) 387 ;; Find a nearby point that is not at the end-of-line but 388 ;; is visible so have space for the overlay. 389 (setq prev (1- (point))) 390 (while (and (>= prev ws) (/= prev (point)) (eolp)) 391 (setq prev (point)) 392 (unless (bobp) 393 (line-move -1 t) 394 (move-to-column horizontal-pos))) 395 (recenter vertical-pos) 396 (point))) 397 (ol (make-overlay pt (1+ pt) (window-buffer wnd)))) 398 (if (= (aw--face-rel-height) 1) 399 (goto-char old-pt) 400 (when (/= pt old-pt) 401 (goto-char (+ pt 1)) 402 (push (cons wnd old-pt) aw--windows-points))) 403 (overlay-put ol 'display (aw--overlay-str wnd pt path)) 404 (if (window-minibuffer-p wnd) 405 (overlay-put ol 'face 'aw-minibuffer-leading-char-face) 406 (overlay-put ol 'face 'aw-leading-char-face)) 407 (overlay-put ol 'window wnd) 408 (push ol avy--overlays-lead))))) 409 410 (defun aw--make-backgrounds (wnd-list) 411 "Create a dim background overlay for each window on WND-LIST." 412 (when aw-background 413 (setq aw-overlays-back 414 (mapcar (lambda (w) 415 (let ((ol (make-overlay 416 (window-start w) 417 (window-end w) 418 (window-buffer w)))) 419 (overlay-put ol 'face 'aw-background-face) 420 ol)) 421 wnd-list)))) 422 423 (defvar aw-dispatch-function 'aw-dispatch-default 424 "Function to call when a character not in `aw-keys' is pressed.") 425 426 (defvar aw-action nil 427 "Function to call at the end of `aw-select'.") 428 429 (defun aw-set-mode-line (str) 430 "Set mode line indicator to STR." 431 (setq ace-window-mode str) 432 (when (and aw-minibuffer-flag ace-window-mode) 433 (message "%s" (string-trim-left str))) 434 (force-mode-line-update)) 435 436 (defun aw--dispatch-action (char) 437 "Return item from `aw-dispatch-alist' matching CHAR." 438 (assoc char aw-dispatch-alist)) 439 440 (defun aw-make-frame () 441 "Make a new Emacs frame using the values of `aw-frame-size' and `aw-frame-offset'." 442 (make-frame 443 (delq nil 444 (list 445 ;; This first parameter is important because an 446 ;; aw-dispatch-alist command may not want to leave this 447 ;; frame with input focus. If it is given focus, the 448 ;; command may not be able to return focus to a different 449 ;; frame since this is done asynchronously by the window 450 ;; manager. 451 '(no-focus-on-map . t) 452 (when aw-frame-size 453 (cons 'width 454 (if (zerop (car aw-frame-size)) 455 (frame-width) 456 (car aw-frame-size)))) 457 (when aw-frame-size 458 (cons 'height 459 (if (zerop (cdr aw-frame-size)) 460 (frame-height) 461 (car aw-frame-size)))) 462 (cons 'left (+ (car aw-frame-offset) 463 (car (frame-position)))) 464 (cons 'top (+ (cdr aw-frame-offset) 465 (cdr (frame-position)))))))) 466 467 (defun aw-use-frame (window) 468 "Create a new frame using the contents of WINDOW. 469 470 The new frame is set to the same size as the previous frame, offset by 471 `aw-frame-offset' (x . y) pixels." 472 (aw-switch-to-window window) 473 (aw-make-frame)) 474 475 (defun aw-clean-up-avy-current-path () 476 "Edit `avy-current-path' so only window label characters remain." 477 ;; Remove any possible ace-window command char that may 478 ;; precede the last specified window label, so 479 ;; functions can use `avy-current-path' as the chosen 480 ;; window label. 481 (when (and (> (length avy-current-path) 0) 482 (assq (aref avy-current-path 0) aw-dispatch-alist)) 483 (setq avy-current-path (substring avy-current-path 1)))) 484 485 (defun aw-dispatch-default (char) 486 "Perform an action depending on CHAR." 487 (cond ((and (fboundp 'avy-mouse-event-window) 488 (avy-mouse-event-window char))) 489 ((= char (aref (kbd "C-g") 0)) 490 (throw 'done 'exit)) 491 ((and aw-make-frame-char (= char aw-make-frame-char)) 492 ;; Make a new frame and perform any action on its window. 493 (let ((start-win (selected-window)) 494 (end-win (frame-selected-window (aw-make-frame)))) 495 (if aw-action 496 ;; Action must be called from the start-win. The action 497 ;; determines which window to leave selected. 498 (progn (select-frame-set-input-focus (window-frame start-win)) 499 (funcall aw-action end-win)) 500 ;; Select end-win when no action 501 (aw-switch-to-window end-win))) 502 (throw 'done 'exit)) 503 (t 504 (let ((action (aw--dispatch-action char))) 505 (if action 506 (cl-destructuring-bind (_key fn &optional description) action 507 (if (and fn description) 508 (prog1 (setq aw-action fn) 509 (aw-set-mode-line (format " Ace - %s" description))) 510 (if (commandp fn) 511 (call-interactively fn) 512 (funcall fn)) 513 (throw 'done 'exit))) 514 (aw-clean-up-avy-current-path) 515 ;; Prevent any char from triggering an avy dispatch command. 516 (let ((avy-dispatch-alist)) 517 (avy-handler-default char))))))) 518 519 (defcustom aw-display-mode-overlay t 520 "When nil, don't display overlays. Rely on the mode line instead." 521 :type 'boolean) 522 523 (defvar ace-window-display-mode) 524 525 (defun aw-select (mode-line &optional action) 526 "Return a selected other window. 527 Amend MODE-LINE to the mode line for the duration of the selection." 528 (setq aw-action action) 529 (let ((start-window (selected-window)) 530 (next-window-scope (cl-case aw-scope 531 ('visible 'visible) 532 ('global 'visible) 533 ('frame 'frame))) 534 (wnd-list (aw-window-list)) 535 window) 536 (setq window 537 (cond ((<= (length wnd-list) 1) 538 (when aw-dispatch-always 539 (setq aw-action 540 (unwind-protect 541 (catch 'done 542 (funcall aw-dispatch-function (read-char))) 543 (aw--done))) 544 (when (eq aw-action 'exit) 545 (setq aw-action nil))) 546 (or (car wnd-list) start-window)) 547 ((and (<= (+ (length wnd-list) (if (aw-ignored-p start-window) 1 0)) 548 aw-dispatch-when-more-than) 549 (not aw-dispatch-always) 550 (not aw-ignore-current)) 551 (let ((wnd (next-window nil nil next-window-scope))) 552 (while (and (or (not (memq wnd wnd-list)) 553 (aw-ignored-p wnd)) 554 (not (equal wnd start-window))) 555 (setq wnd (next-window wnd nil next-window-scope))) 556 wnd)) 557 (t 558 (let ((candidate-list 559 (mapcar (lambda (wnd) 560 (cons (aw-offset wnd) wnd)) 561 wnd-list))) 562 (aw--make-backgrounds wnd-list) 563 (aw-set-mode-line mode-line) 564 ;; turn off helm transient map 565 (remove-hook 'post-command-hook 'helm--maybe-update-keymap) 566 (unwind-protect 567 (let* ((avy-handler-function aw-dispatch-function) 568 (avy-translate-char-function aw-translate-char-function) 569 (transient-mark-mode nil) 570 (res (avy-read (avy-tree candidate-list aw-keys) 571 (if (and ace-window-display-mode 572 (null aw-display-mode-overlay)) 573 (lambda (_path _leaf)) 574 #'aw--lead-overlay) 575 #'avy--remove-leading-chars))) 576 (if (eq res 'exit) 577 (setq aw-action nil) 578 (or (cdr res) 579 start-window))) 580 (aw--done)))))) 581 (if aw-action 582 (funcall aw-action window) 583 window))) 584 585 ;;* Interactive 586 ;;;###autoload 587 (defun ace-select-window () 588 "Ace select window." 589 (interactive) 590 (aw-select " Ace - Window" 591 #'aw-switch-to-window)) 592 593 ;;;###autoload 594 (defun ace-delete-window () 595 "Ace delete window." 596 (interactive) 597 (aw-select " Ace - Delete Window" 598 #'aw-delete-window)) 599 600 ;;;###autoload 601 (defun ace-swap-window () 602 "Ace swap window." 603 (interactive) 604 (aw-select " Ace - Swap Window" 605 #'aw-swap-window)) 606 607 ;;;###autoload 608 (defun ace-delete-other-windows () 609 "Ace delete other windows." 610 (interactive) 611 (aw-select " Ace - Delete Other Windows" 612 #'delete-other-windows)) 613 614 ;;;###autoload 615 (defun ace-display-buffer (buffer alist) 616 "Make `display-buffer' and `pop-to-buffer' select using `ace-window'. 617 See sample config for `display-buffer-base-action' and `display-buffer-alist': 618 https://github.com/abo-abo/ace-window/wiki/display-buffer." 619 (let* ((aw-ignore-current (cdr (assq 'inhibit-same-window alist))) 620 (rf (cdr (assq 'reusable-frames alist))) 621 (aw-scope (cl-case rf 622 ((nil) 'frame) 623 (visible 'visible) 624 ((0 t) 'global)))) 625 (unless (or (<= (length (aw-window-list)) 1) 626 (not aw-scope)) 627 (window--display-buffer 628 buffer (aw-select "Ace - Display Buffer") 'reuse)))) 629 630 (declare-function transpose-frame "ext:transpose-frame") 631 (defun aw-transpose-frame (w) 632 "Select any window on frame and `tranpose-frame'." 633 (transpose-frame (window-frame w))) 634 635 ;;;###autoload 636 (defun ace-window (arg) 637 "Select a window. 638 Perform an action based on ARG described below. 639 640 By default, behaves like extended `other-window'. 641 See `aw-scope' which extends it to work with frames. 642 643 Prefixed with one \\[universal-argument], does a swap between the 644 selected window and the current window, so that the selected 645 buffer moves to current window (and current buffer moves to 646 selected window). 647 648 Prefixed with two \\[universal-argument]'s, deletes the selected 649 window." 650 (interactive "p") 651 (setq avy-current-path "") 652 (cl-case arg 653 (0 654 (let ((aw-ignore-on (not aw-ignore-on))) 655 (ace-select-window))) 656 (4 (ace-swap-window)) 657 (16 (ace-delete-window)) 658 (t (ace-select-window)))) 659 660 ;;* Utility 661 (unless (fboundp 'frame-position) 662 (defun frame-position (&optional frame) 663 (let ((pl (frame-parameter frame 'left)) 664 (pt (frame-parameter frame 'top))) 665 (when (consp pl) 666 (setq pl (eval pl))) 667 (when (consp pt) 668 (setq pt (eval pt))) 669 (cons pl pt)))) 670 671 (defun aw-window< (wnd1 wnd2) 672 "Return true if WND1 is less than WND2. 673 This is determined by their respective window coordinates. 674 Windows are numbered top down, left to right." 675 (let* ((f1 (window-frame wnd1)) 676 (f2 (window-frame wnd2)) 677 (e1 (window-edges wnd1)) 678 (e2 (window-edges wnd2)) 679 (p1 (frame-position f1)) 680 (p2 (frame-position f2)) 681 (nl (or (null (car p1)) (null (car p2))))) 682 (cond ((and (not nl) (< (car p1) (car p2))) 683 (not aw-reverse-frame-list)) 684 ((and (not nl) (> (car p1) (car p2))) 685 aw-reverse-frame-list) 686 ((< (car e1) (car e2)) 687 t) 688 ((> (car e1) (car e2)) 689 nil) 690 ((< (cadr e1) (cadr e2)) 691 t)))) 692 693 (defvar aw--window-ring (make-ring 10) 694 "Hold the window switching history.") 695 696 (defun aw--push-window (window) 697 "Store WINDOW to `aw--window-ring'." 698 (when (or (zerop (ring-length aw--window-ring)) 699 (not (equal 700 (ring-ref aw--window-ring 0) 701 window))) 702 (ring-insert aw--window-ring (selected-window)))) 703 704 (defun aw--pop-window () 705 "Return the removed top of `aw--window-ring'." 706 (let (res) 707 (condition-case nil 708 (while (or (not (window-live-p 709 (setq res (ring-remove aw--window-ring 0)))) 710 (equal res (selected-window)))) 711 (error 712 (if (= (length (aw-window-list)) 2) 713 (progn 714 (other-window 1) 715 (setq res (selected-window))) 716 (error "No previous windows stored")))) 717 res)) 718 719 (defun aw-switch-to-window (window) 720 "Switch to the window WINDOW." 721 (let ((frame (window-frame window))) 722 (aw--push-window (selected-window)) 723 (when (and (frame-live-p frame) 724 (not (eq frame (selected-frame)))) 725 (select-frame-set-input-focus frame)) 726 (if (window-live-p window) 727 (select-window window) 728 (error "Got a dead window %S" window)))) 729 730 (defun aw-flip-window () 731 "Switch to the window you were previously in." 732 (interactive) 733 (aw-switch-to-window (aw--pop-window))) 734 735 (defun aw-show-dispatch-help () 736 "Display action shortucts in echo area." 737 (interactive) 738 (message "%s" (mapconcat 739 (lambda (action) 740 (cl-destructuring-bind (key fn &optional description) action 741 (format "%s: %s" 742 (propertize 743 (char-to-string key) 744 'face 'aw-key-face) 745 (or description fn)))) 746 aw-dispatch-alist 747 "\n")) 748 ;; Prevent this from replacing any help display 749 ;; in the minibuffer. 750 (let (aw-minibuffer-flag) 751 (mapc #'delete-overlay aw-overlays-back) 752 (call-interactively 'ace-window))) 753 754 (defun aw-delete-window (window &optional kill-buffer) 755 "Delete window WINDOW. 756 When KILL-BUFFER is non-nil, also kill the buffer." 757 (let ((frame (window-frame window))) 758 (when (and (frame-live-p frame) 759 (not (eq frame (selected-frame)))) 760 (select-frame-set-input-focus (window-frame window))) 761 (if (= 1 (length (window-list))) 762 (delete-frame frame) 763 (if (window-live-p window) 764 (let ((buffer (window-buffer window))) 765 (delete-window window) 766 (when kill-buffer 767 (kill-buffer buffer))) 768 (error "Got a dead window %S" window))))) 769 770 (defun aw-switch-buffer-in-window (window) 771 "Select buffer in WINDOW." 772 (aw-switch-to-window window) 773 (aw--switch-buffer)) 774 775 (declare-function ivy-switch-buffer "ext:ivy") 776 777 (defun aw--switch-buffer () 778 (cond ((bound-and-true-p ivy-mode) 779 (ivy-switch-buffer)) 780 ((bound-and-true-p ido-mode) 781 (ido-switch-buffer)) 782 (t 783 (call-interactively 'switch-to-buffer)))) 784 785 (defcustom aw-swap-invert nil 786 "When non-nil, the other of the two swapped windows gets the point." 787 :type 'boolean) 788 789 (defun aw-swap-window (window) 790 "Swap buffers of current window and WINDOW." 791 (cl-labels ((swap-windows (window1 window2) 792 "Swap the buffers of WINDOW1 and WINDOW2." 793 (let ((buffer1 (window-buffer window1)) 794 (buffer2 (window-buffer window2))) 795 (set-window-buffer window1 buffer2) 796 (set-window-buffer window2 buffer1) 797 (select-window window2)))) 798 (let ((frame (window-frame window)) 799 (this-window (selected-window))) 800 (when (and (frame-live-p frame) 801 (not (eq frame (selected-frame)))) 802 (select-frame-set-input-focus (window-frame window))) 803 (when (and (window-live-p window) 804 (not (eq window this-window))) 805 (aw--push-window this-window) 806 (if aw-swap-invert 807 (swap-windows window this-window) 808 (swap-windows this-window window)))))) 809 810 (defun aw-move-window (window) 811 "Move the current buffer to WINDOW. 812 Switch the current window to the previous buffer." 813 (let ((buffer (current-buffer))) 814 (switch-to-buffer (other-buffer)) 815 (aw-switch-to-window window) 816 (switch-to-buffer buffer))) 817 818 (defun aw-copy-window (window) 819 "Copy the current buffer to WINDOW." 820 (let ((buffer (current-buffer))) 821 (aw-switch-to-window window) 822 (switch-to-buffer buffer))) 823 824 (defun aw-split-window-vert (window) 825 "Split WINDOW vertically." 826 (select-window window) 827 (split-window-vertically)) 828 829 (defun aw-split-window-horz (window) 830 "Split WINDOW horizontally." 831 (select-window window) 832 (split-window-horizontally)) 833 834 (defcustom aw-fair-aspect-ratio 2 835 "The aspect ratio to aim for when splitting windows. 836 Sizes are based on the number of characters, not pixels. 837 Increase to prefer wider windows, or decrease for taller windows." 838 :type 'number) 839 840 (defun aw-split-window-fair (window) 841 "Split WINDOW vertically or horizontally, based on its current dimensions. 842 Modify `aw-fair-aspect-ratio' to tweak behavior." 843 (let ((w (window-body-width window)) 844 (h (window-body-height window))) 845 (if (< (* h aw-fair-aspect-ratio) w) 846 (aw-split-window-horz window) 847 (aw-split-window-vert window)))) 848 849 (defun aw-switch-buffer-other-window (window) 850 "Switch buffer in WINDOW." 851 (aw-switch-to-window window) 852 (unwind-protect 853 (aw--switch-buffer) 854 (aw-flip-window))) 855 856 (defun aw-execute-command-other-window (window) 857 "Execute a command in WINDOW." 858 (aw-switch-to-window window) 859 (unwind-protect 860 (funcall 861 (key-binding 862 (read-key-sequence 863 "Enter key sequence: "))) 864 (aw-flip-window))) 865 866 (defun aw--face-rel-height () 867 (let ((h (face-attribute 'aw-leading-char-face :height))) 868 (cond 869 ((eq h 'unspecified) 870 1) 871 ((floatp h) 872 (max (floor h) 1)) 873 ((integerp h) 874 1) 875 (t 876 (error "unexpected: %s" h))))) 877 878 (defun aw-offset (window) 879 "Return point in WINDOW that's closest to top left corner. 880 The point is writable, i.e. it's not part of space after newline." 881 (let ((h (window-hscroll window)) 882 (beg (window-start window)) 883 (end (window-end window)) 884 (inhibit-field-text-motion t)) 885 (with-current-buffer (window-buffer window) 886 (save-excursion 887 (goto-char beg) 888 (forward-line (1- 889 (min 890 (count-lines 891 (point) 892 (point-max)) 893 (aw--face-rel-height)))) 894 (while (and (< (point) end) 895 (< (- (line-end-position) 896 (line-beginning-position)) 897 h)) 898 (forward-line)) 899 (+ (point) h))))) 900 901 (defun aw--after-make-frame (f) 902 (aw-update) 903 (make-frame-visible f)) 904 905 ;;* Mode line 906 ;;;###autoload 907 (define-minor-mode ace-window-display-mode 908 "Minor mode for showing the ace window key in the mode line." 909 :global t 910 (if ace-window-display-mode 911 (progn 912 (aw-update) 913 (set-default 914 'mode-line-format 915 `((ace-window-display-mode 916 (:eval (window-parameter (selected-window) 'ace-window-path))) 917 ,@(assq-delete-all 918 'ace-window-display-mode 919 (default-value 'mode-line-format)))) 920 (force-mode-line-update t) 921 (add-hook 'window-configuration-change-hook 'aw-update) 922 ;; Add at the end so does not precede select-frame call. 923 (add-hook 'after-make-frame-functions #'aw--after-make-frame t)) 924 (set-default 925 'mode-line-format 926 (assq-delete-all 927 'ace-window-display-mode 928 (default-value 'mode-line-format))) 929 (remove-hook 'window-configuration-change-hook 'aw-update) 930 (remove-hook 'after-make-frame-functions 'aw--after-make-frame))) 931 932 (defun aw-update () 933 "Update ace-window-path window parameter for all windows. 934 935 Ensure all windows are labeled so the user can select a specific 936 one, even from the set of windows typically ignored when making a 937 window list." 938 (let ((aw-ignore-on) 939 (aw-ignore-current) 940 (ignore-window-parameters t)) 941 (avy-traverse 942 (avy-tree (aw-window-list) aw-keys) 943 (lambda (path leaf) 944 (set-window-parameter 945 leaf 'ace-window-path 946 (propertize 947 (apply #'string (reverse path)) 948 'face 'aw-mode-line-face)))))) 949 950 (provide 'ace-window) 951 952 ;;; ace-window.el ends here