code.delx.au - gnu-emacs-elpa/blob - packages/ace-window/ace-window.el

   1 ;;; ace-window.el --- Quickly switch windows. -*- lexical-binding: t -*-
   2
   3 ;; Copyright (C) 2014-2015 Oleh Krehel
   4
   5 ;; Author: Oleh Krehel <ohwoeowho@gmail.com>
   6 ;; URL: https://github.com/abo-abo/ace-window
   7 ;; Version: 0.8.0
   8 ;; Keywords: window, location
   9
  10 ;; This file is not part of GNU Emacs
  11
  12 ;; This file is free software; you can redistribute it and/or modify
  13 ;; it under the terms of the GNU General Public License as published by
  14 ;; the Free Software Foundation; either version 3, or (at your option)
  15 ;; any later version.
  16
  17 ;; This program is distributed in the hope that it will be useful,
  18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ;; GNU General Public License for more details.
  21
  22 ;; For a full copy of the GNU General Public License
  23 ;; see <http://www.gnu.org/licenses/>.
  24
  25 ;;; Commentary:
  26 ;;
  27 ;; The main function, `ace-window' is meant to replace `other-window'.
  28 ;; If fact, when there are only two windows present, `other-window' is
  29 ;; called.  If there are more, each window will have its first
  30 ;; character highlighted.  Pressing that character will switch to that
  31 ;; window.
  32 ;;
  33 ;; To setup this package, just add to your .emacs:
  34 ;;
  35 ;;    (global-set-key (kbd "M-p") 'ace-window)
  36 ;;
  37 ;; replacing "M-p"  with an appropriate shortcut.
  38 ;;
  39 ;; Depending on your window usage patterns, you might want to set
  40 ;;
  41 ;;    (setq aw-keys '(?a ?s ?d ?f ?g ?h ?j ?k ?l))
  42 ;;
  43 ;; This way they're all on the home row, although the intuitive
  44 ;; ordering is lost.
  45 ;;
  46 ;; If you don't want the gray background that makes the red selection
  47 ;; characters stand out more, set this:
  48 ;;
  49 ;;    (setq aw-background nil)
  50 ;;
  51 ;; When prefixed with one `universal-argument', instead of switching
  52 ;; to selected window, the selected window is swapped with current one.
  53 ;;
  54 ;; When prefixed with two `universal-argument', the selected window is
  55 ;; deleted instead.
  56
  57 ;;; Code:
  58 (require 'avy)
  59
  60 ;;* Customization
  61 (defgroup ace-window nil
  62   "Quickly switch current window."
  63   :group 'convenience
  64   :prefix "aw-")
  65
  66 (defcustom aw-keys '(?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)
  67   "Keys for selecting window.")
  68
  69 (defcustom aw-scope 'global
  70   "The scope used by `ace-window'."
  71   :type '(choice
  72           (const :tag "global" global)
  73           (const :tag "frame" frame)))
  74
  75 (defcustom aw-ignored-buffers '("*Calc Trail*" "*LV*")
  76   "List of buffers to ignore when selecting window."
  77   :type '(repeat string))
  78
  79 (defcustom aw-ignore-on t
  80   "When t, `ace-window' will ignore `aw-ignored-buffers'.
  81 Use M-0 `ace-window' to toggle this value."
  82   :type 'boolean)
  83
  84 (defcustom aw-background t
  85   "When t, `ace-window' will dim out all buffers temporarily when used.'."
  86   :type 'boolean)
  87
  88 (defcustom aw-leading-char-style 'char
  89   "Style of the leading char overlay."
  90   :type '(choice
  91           (const :tag "single char" 'char)
  92           (const :tag "full path" 'path)))
  93
  94 (defface aw-leading-char-face
  95     '((((class color)) (:foreground "red"))
  96       (((background dark)) (:foreground "gray100"))
  97       (((background light)) (:foreground "gray0"))
  98       (t (:foreground "gray100" :underline nil)))
  99   "Face for each window's leading char.")
 100
 101 (defface aw-background-face
 102   '((t (:foreground "gray40")))
 103   "Face for whole window background during selection.")
 104
 105 (defface aw-mode-line-face
 106     '((t (:inherit mode-line-buffer-id)))
 107   "Face used for displaying the ace window key in the mode-line.")
 108
 109 ;;* Implementation
 110 (defun aw-ignored-p (window)
 111   "Return t if WINDOW should be ignored."
 112   (and aw-ignore-on
 113        (member (buffer-name (window-buffer window))
 114                aw-ignored-buffers)))
 115
 116 (defun aw-window-list ()
 117   "Return the list of interesting windows."
 118   (sort
 119    (cl-remove-if
 120     (lambda (w)
 121       (let ((f (window-frame w))
 122             (b (window-buffer w)))
 123         (or (not (and (frame-live-p f)
 124                       (frame-visible-p f)))
 125             (string= "initial_terminal" (terminal-name f))
 126             (aw-ignored-p w)
 127             (with-current-buffer b
 128               (and buffer-read-only
 129                    (= 0 (buffer-size b)))))))
 130     (cl-case aw-scope
 131       (global
 132        (cl-mapcan #'window-list (frame-list)))
 133       (frame
 134        (window-list))
 135       (t
 136        (error "Invalid `aw-scope': %S" aw-scope))))
 137    'aw-window<))
 138
 139 (defvar aw-overlays-lead nil
 140   "Hold overlays for leading chars.")
 141
 142 (defvar aw-overlays-back nil
 143   "Hold overlays for when `aw-background' is t.")
 144
 145 (defvar ace-window-mode nil
 146   "Minor mode during the selection process.")
 147
 148 ;; register minor mode
 149 (or (assq 'ace-window-mode minor-mode-alist)
 150     (nconc minor-mode-alist
 151            (list '(ace-window-mode ace-window-mode))))
 152
 153 (defun aw--done ()
 154   "Clean up mode line and overlays."
 155   ;; mode line
 156   (setq ace-window-mode nil)
 157   (force-mode-line-update)
 158   ;; background
 159   (mapc #'delete-overlay aw-overlays-back)
 160   (setq aw-overlays-back nil)
 161   (aw--remove-leading-chars))
 162
 163 (defun aw--lead-overlay (path leaf)
 164   "Create an overlay using PATH at LEAF.
 165 LEAF is (PT . WND)."
 166   (let* ((pt (car leaf))
 167          (wnd (cdr leaf))
 168          (ol (make-overlay pt (1+ pt) (window-buffer wnd)))
 169          (old-str (with-selected-window wnd
 170                     (buffer-substring pt (1+ pt))))
 171          (new-str
 172           (concat
 173            (cl-case aw-leading-char-style
 174              (char
 175               (apply #'string (last path)))
 176              (path
 177               (apply #'string (reverse path)))
 178              (t
 179               (error "Bad `aw-leading-char-style': %S"
 180                      aw-leading-char-style)))
 181            (cond ((string-equal old-str "\t")
 182                   (make-string (1- tab-width) ?\ ))
 183                  ((string-equal old-str "\n")
 184                   "\n")
 185                  (t
 186                   (make-string
 187                    (max 0 (1- (string-width old-str)))
 188                    ?\ ))))))
 189     (overlay-put ol 'face 'aw-leading-char-face)
 190     (overlay-put ol 'window wnd)
 191     (overlay-put ol 'display new-str)
 192     (push ol aw-overlays-lead)))
 193
 194 (defun aw--remove-leading-chars ()
 195   "Remove leading char overlays."
 196   (mapc #'delete-overlay aw-overlays-lead)
 197   (setq aw-overlays-lead nil))
 198
 199 (defun aw--make-backgrounds (wnd-list)
 200   "Create a dim background overlay for each window on WND-LIST."
 201   (when aw-background
 202     (setq aw-overlays-back
 203           (mapcar (lambda (w)
 204                     (let ((ol (make-overlay
 205                                (window-start w)
 206                                (window-end w)
 207                                (window-buffer w))))
 208                       (overlay-put ol 'face 'aw-background-face)
 209                       ol))
 210                   wnd-list))))
 211
 212 (defvar aw--flip-keys nil
 213   "Pre-processed `aw-flip-keys'.")
 214
 215 (defcustom aw-flip-keys '("n")
 216   "Keys which should select the last window."
 217   :set (lambda (sym val)
 218          (set sym val)
 219          (setq aw--flip-keys
 220                (mapcar (lambda (x) (aref (kbd x) 0)) val))))
 221
 222 (defun aw-select (mode-line)
 223   "Return a selected other window.
 224 Amend MODE-LINE to the mode line for the duration of the selection."
 225   (let ((start-window (selected-window))
 226         (next-window-scope (cl-case aw-scope
 227                              ('global 'visible)
 228                              ('frame 'frame)))
 229         (wnd-list (aw-window-list))
 230         final-window)
 231     (cl-case (length wnd-list)
 232       (0
 233        start-window)
 234       (1
 235        (car wnd-list))
 236       (2
 237        (setq final-window (next-window nil nil next-window-scope))
 238        (while (and (aw-ignored-p final-window)
 239                    (not (equal final-window start-window)))
 240          (setq final-window (next-window final-window nil next-window-scope)))
 241        final-window)
 242       (t
 243        (let ((candidate-list
 244               (mapcar (lambda (wnd)
 245                         ;; can't jump if the buffer is empty
 246                         (with-current-buffer (window-buffer wnd)
 247                           (when (= 0 (buffer-size))
 248                             (insert " ")))
 249                         (cons (aw-offset wnd) wnd))
 250                       wnd-list)))
 251          (aw--make-backgrounds wnd-list)
 252          (setq ace-window-mode mode-line)
 253          (force-mode-line-update)
 254          ;; turn off helm transient map
 255          (remove-hook 'post-command-hook 'helm--maybe-update-keymap)
 256          (unwind-protect
 257               (condition-case err
 258                   (or (cdr (avy-read (avy-tree candidate-list aw-keys)
 259                                      #'aw--lead-overlay
 260                                      #'aw--remove-leading-chars))
 261                       start-window)
 262                 (error
 263                  (if (memq (caddr err) aw--flip-keys)
 264                      (aw--pop-window)
 265                    (signal (car err) (cdr err)))))
 266            (aw--done)))))))
 267
 268 ;;* Interactive
 269 ;;;###autoload
 270 (defun ace-select-window ()
 271   "Ace select window."
 272   (interactive)
 273   (aw-switch-to-window
 274    (aw-select " Ace - Window")))
 275
 276 ;;;###autoload
 277 (defun ace-delete-window ()
 278   "Ace delete window."
 279   (interactive)
 280   (aw-delete-window
 281    (aw-select " Ace - Delete Window")))
 282
 283 ;;;###autoload
 284 (defun ace-swap-window ()
 285   "Ace swap window."
 286   (interactive)
 287   (aw-swap-window
 288    (aw-select " Ace - Swap Window")))
 289
 290 ;;;###autoload
 291 (defun ace-maximize-window ()
 292   "Ace maximize window."
 293   (interactive)
 294   (select-window
 295    (aw-select " Ace - Maximize Window"))
 296   (delete-other-windows))
 297
 298 ;;;###autoload
 299 (defun ace-window (arg)
 300   "Select a window.
 301 Perform an action based on ARG described below.
 302
 303 By default, behaves like extended `other-window'.
 304
 305 Prefixed with one \\[universal-argument], does a swap between the
 306 selected window and the current window, so that the selected
 307 buffer moves to current window (and current buffer moves to
 308 selected window).
 309
 310 Prefixed with two \\[universal-argument]'s, deletes the selected
 311 window."
 312   (interactive "p")
 313   (cl-case arg
 314     (0
 315      (setq aw-ignore-on
 316            (not aw-ignore-on))
 317      (ace-select-window))
 318     (4 (ace-swap-window))
 319     (16 (ace-delete-window))
 320     (t (ace-select-window))))
 321
 322 ;;* Utility
 323 (defun aw-window< (wnd1 wnd2)
 324   "Return true if WND1 is less than WND2.
 325 This is determined by their respective window coordinates.
 326 Windows are numbered top down, left to right."
 327   (let ((f1 (window-frame wnd1))
 328         (f2 (window-frame wnd2))
 329         (e1 (window-edges wnd1))
 330         (e2 (window-edges wnd2)))
 331     (cond ((string< (frame-parameter f1 'window-id)
 332                     (frame-parameter f2 'window-id))
 333            t)
 334           ((< (car e1) (car e2))
 335            t)
 336           ((> (car e1) (car e2))
 337            nil)
 338           ((< (cadr e1) (cadr e2))
 339            t))))
 340
 341 (defvar aw--window-ring (make-ring 10)
 342   "Hold the window switching history.")
 343
 344 (defun aw--push-window (window)
 345   "Store WINDOW to `aw--window-ring'."
 346   (when (or (zerop (ring-length aw--window-ring))
 347             (not (equal
 348                   (ring-ref aw--window-ring 0)
 349                   window)))
 350     (ring-insert aw--window-ring (selected-window))))
 351
 352 (defun aw--pop-window ()
 353   "Return the removed top of `aw--window-ring'."
 354   (let (res)
 355     (condition-case nil
 356         (while (not (window-live-p
 357                      (setq res (ring-remove aw--window-ring 0)))))
 358       (error
 359        (error "No previous windows stored")))
 360     res))
 361
 362 (defun aw-switch-to-window (window)
 363   "Switch to the window WINDOW."
 364   (let ((frame (window-frame window)))
 365     (when (and (frame-live-p frame)
 366                (not (eq frame (selected-frame))))
 367       (select-frame-set-input-focus frame))
 368     (if (window-live-p window)
 369         (progn
 370           (aw--push-window (selected-window))
 371           (select-window window))
 372       (error "Got a dead window %S" window))))
 373
 374 (defun aw-flip-window ()
 375   "Switch to the window you were previously in."
 376   (interactive)
 377   (aw-switch-to-window (aw--pop-window)))
 378
 379 (defun aw-delete-window (window)
 380   "Delete window WINDOW."
 381   (let ((frame (window-frame window)))
 382     (when (and (frame-live-p frame)
 383                (not (eq frame (selected-frame))))
 384       (select-frame-set-input-focus (window-frame window)))
 385     (if (= 1 (length (window-list)))
 386         (delete-frame frame)
 387       (if (window-live-p window)
 388           (delete-window window)
 389         (error "Got a dead window %S" window)))))
 390
 391 (defun aw-swap-window (window)
 392   "Swap buffers of current window and WINDOW."
 393   (cl-labels ((swap-windows (window1 window2)
 394                 "Swap the buffers of WINDOW1 and WINDOW2."
 395                 (let ((buffer1 (window-buffer window1))
 396                       (buffer2 (window-buffer window2)))
 397                   (set-window-buffer window1 buffer2)
 398                   (set-window-buffer window2 buffer1)
 399                   (select-window window2))))
 400     (let ((frame (window-frame window))
 401           (this-window (selected-window)))
 402       (when (and (frame-live-p frame)
 403                  (not (eq frame (selected-frame))))
 404         (select-frame-set-input-focus (window-frame window)))
 405       (when (and (window-live-p window)
 406                  (not (eq window this-window)))
 407         (aw--push-window this-window)
 408         (swap-windows this-window window)))))
 409
 410 (defun aw-offset (window)
 411   "Return point in WINDOW that's closest to top left corner.
 412 The point is writable, i.e. it's not part of space after newline."
 413   (let ((h (window-hscroll window))
 414         (beg (window-start window))
 415         (end (window-end window))
 416         (inhibit-field-text-motion t))
 417     (with-current-buffer
 418         (window-buffer window)
 419       (save-excursion
 420         (goto-char beg)
 421         (while (and (< (point) end)
 422                     (< (- (line-end-position)
 423                           (line-beginning-position))
 424                        h))
 425           (forward-line))
 426         (+ (point) h)))))
 427
 428 ;;* Mode line
 429 ;;;###autoload
 430 (define-minor-mode ace-window-display-mode
 431     "Minor mode for showing the ace window key in the mode line."
 432   :global t
 433   (if ace-window-display-mode
 434       (progn
 435         (aw-update)
 436         (set-default
 437          'mode-line-format
 438          `((ace-window-display-mode
 439             (:eval (window-parameter (selected-window) 'ace-window-path)))
 440            ,@(assq-delete-all
 441               'ace-window-display-mode
 442               (default-value 'mode-line-format))))
 443         (force-mode-line-update t)
 444         (add-hook 'window-configuration-change-hook 'aw-update))
 445     (set-default
 446      'mode-line-format
 447      (assq-delete-all
 448       'ace-window-display-mode
 449       (default-value 'mode-line-format)))
 450     (remove-hook 'window-configuration-change-hook 'aw-update)))
 451
 452 (defun aw-update ()
 453   "Update ace-window-path window parameter for all windows."
 454   (avy-traverse
 455    (avy-tree (aw-window-list) aw-keys)
 456    (lambda (path leaf)
 457      (set-window-parameter
 458       leaf 'ace-window-path
 459       (propertize
 460        (apply #'string (reverse path))
 461        'face 'aw-mode-line-face)))))
 462
 463 (provide 'ace-window)
 464
 465 ;;; ace-window.el ends here