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