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