window.el 41 KB
Newer Older
1
;;; window.el --- GNU Emacs window commands aside from those written in C
Eric S. Raymond's avatar
Eric S. Raymond committed
2

3
;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001, 2002,
Glenn Morris's avatar
Glenn Morris committed
4
;;   2003, 2004, 2005, 2006, 2007 Free Software Foundation, Inc.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
5

Eric S. Raymond's avatar
Eric S. Raymond committed
6
;; Maintainer: FSF
Gerd Moellmann's avatar
Gerd Moellmann committed
7
;; Keywords: internal
Eric S. Raymond's avatar
Eric S. Raymond committed
8

Joseph Arceneaux's avatar
Joseph Arceneaux committed
9 10 11 12
;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
Jim Blandy's avatar
Jim Blandy committed
13
;; the Free Software Foundation; either version 2, or (at your option)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
14 15 16 17 18 19 20 21
;; any later version.

;; GNU Emacs 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.

;; You should have received a copy of the GNU General Public License
Erik Naggum's avatar
Erik Naggum committed
22
;; along with GNU Emacs; see the file COPYING.  If not, write to the
Lute Kamstra's avatar
Lute Kamstra committed
23 24
;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.
Joseph Arceneaux's avatar
Joseph Arceneaux committed
25

26 27 28 29 30
;;; Commentary:

;; Window tree functions.

;;; Code:
31

32 33
(defvar window-size-fixed nil
 "*Non-nil in a buffer means windows displaying the buffer are fixed-size.
34
If the value is `height', then only the window's height is fixed.
35 36 37 38 39 40
If the value is `width', then only the window's width is fixed.
Any other non-nil value fixes both the width and the height.
Emacs won't change the size of any window displaying that buffer,
unless you explicitly change the size, or Emacs has no other choice.")
(make-variable-buffer-local 'window-size-fixed)

41 42
(defmacro save-selected-window (&rest body)
  "Execute BODY, then select the window that was selected before BODY.
43 44 45 46
The value returned is the value of the last form in BODY.

This macro saves and restores the current buffer, since otherwise
its normal operation could potentially make a different
Richard M. Stallman's avatar
Richard M. Stallman committed
47
buffer current.  It does not alter the buffer list ordering.
48 49 50 51 52 53 54

This macro saves and restores the selected window, as well as
the selected window in each frame.  If the previously selected
window of some frame is no longer live at the end of BODY, that
frame's selected window is left alone.  If the selected window is
no longer live, then whatever window is selected at the end of
BODY remains selected."
55
  `(let ((save-selected-window-window (selected-window))
Richard M. Stallman's avatar
Richard M. Stallman committed
56 57 58
	 ;; It is necessary to save all of these, because calling
	 ;; select-window changes frame-selected-window for whatever
	 ;; frame that window is in.
59
	 (save-selected-window-alist
60
	  (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
61
		  (frame-list))))
62 63 64 65 66
     (save-current-buffer
       (unwind-protect
	   (progn ,@body)
	 (dolist (elt save-selected-window-alist)
	   (and (frame-live-p (car elt))
67 68
		(window-live-p (cdr elt))
		(set-frame-selected-window (car elt) (cdr elt))))
69 70
	 (if (window-live-p save-selected-window-window)
	     (select-window save-selected-window-window))))))
71

72 73 74 75
(defun window-body-height (&optional window)
  "Return number of lines in window WINDOW for actual buffer text.
This does not include the mode line (if any) or the header line (if any)."
  (or window (setq window (selected-window)))
76 77 78 79 80 81
  (if (window-minibuffer-p window)
      (window-height window)
    (with-current-buffer (window-buffer window)
      (max 1 (- (window-height window)
		(if mode-line-format 1 0)
		(if header-line-format 1 0))))))
82

83
(defun one-window-p (&optional nomini all-frames)
84
  "Return non-nil if the selected window is the only window.
85
Optional arg NOMINI non-nil means don't count the minibuffer
86 87
even if it is active.  Otherwise, the minibuffer is counted
when it is active.
88 89 90

The optional arg ALL-FRAMES t means count windows on all frames.
If it is `visible', count windows on all visible frames.
91
ALL-FRAMES nil or omitted means count only the selected frame,
92
plus the minibuffer it uses (which may be on another frame).
93 94
ALL-FRAMES 0 means count all windows in all visible or iconified frames.
If ALL-FRAMES is anything else, count only the selected frame."
95 96 97 98 99 100
  (let ((base-window (selected-window)))
    (if (and nomini (eq base-window (minibuffer-window)))
	(setq base-window (next-window base-window)))
    (eq base-window
	(next-window base-window (if nomini 'arg) all-frames))))

101 102
(defun window-current-scroll-bars (&optional window)
  "Return the current scroll-bar settings in window WINDOW.
103
Value is a cons (VERTICAL . HORIZONTAL) where VERTICAL specifies the
104
current location of the vertical scroll-bars (left, right, or nil),
105
and HORIZONTAL specifies the current location of the horizontal scroll
106 107 108 109
bars (top, bottom, or nil)."
  (let ((vert (nth 2 (window-scroll-bars window)))
	(hor nil))
    (when (or (eq vert t) (eq hor t))
110
      (let ((fcsb (frame-current-scroll-bars
111 112 113 114 115 116 117
		   (window-frame (or window (selected-window))))))
	(if (eq vert t)
	    (setq vert (car fcsb)))
	(if (eq hor t)
	    (setq hor (cdr fcsb)))))
    (cons vert hor)))

118 119 120 121 122 123 124 125 126 127 128
(defun walk-windows (proc &optional minibuf all-frames)
  "Cycle through all visible windows, calling PROC for each one.
PROC is called with a window as argument.

Optional second arg MINIBUF t means count the minibuffer window even
if not active.  MINIBUF nil or omitted means count the minibuffer iff
it is active.  MINIBUF neither t nor nil means not to count the
minibuffer even if it is active.

Several frames may share a single minibuffer; if the minibuffer
counts, all windows on all frames that share that minibuffer count
Richard M. Stallman's avatar
Richard M. Stallman committed
129 130
too.  Therefore, if you are using a separate minibuffer frame
and the minibuffer is active and MINIBUF says it counts,
131
`walk-windows' includes the windows in the frame from which you
Richard M. Stallman's avatar
Richard M. Stallman committed
132
entered the minibuffer, as well as the minibuffer window.
133

Richard M. Stallman's avatar
Richard M. Stallman committed
134 135 136
ALL-FRAMES is the optional third argument.
ALL-FRAMES nil or omitted means cycle within the frames as specified above.
ALL-FRAMES = `visible' means include windows on all visible frames.
137
ALL-FRAMES = 0 means include windows on all visible and iconified frames.
Richard M. Stallman's avatar
Richard M. Stallman committed
138
ALL-FRAMES = t means include windows on all frames including invisible frames.
139
If ALL-FRAMES is a frame, it means include windows on that frame.
Richard M. Stallman's avatar
Richard M. Stallman committed
140
Anything else means restrict to the selected frame."
141 142 143
  ;; If we start from the minibuffer window, don't fail to come back to it.
  (if (window-minibuffer-p (selected-window))
      (setq minibuf t))
144 145 146
  (save-selected-window
    (if (framep all-frames)
	(select-window (frame-first-window all-frames)))
Gerd Moellmann's avatar
Gerd Moellmann committed
147 148
    (let* (walk-windows-already-seen
	   (walk-windows-current (selected-window)))
149 150 151
      (while (progn
	       (setq walk-windows-current
		     (next-window walk-windows-current minibuf all-frames))
Gerd Moellmann's avatar
Gerd Moellmann committed
152 153 154 155 156
	       (not (memq walk-windows-current walk-windows-already-seen)))
	(setq walk-windows-already-seen
	      (cons walk-windows-current walk-windows-already-seen))
	(funcall proc walk-windows-current)))))

157 158
(defun get-window-with-predicate (predicate &optional minibuf
					    all-frames default)
Gerd Moellmann's avatar
Gerd Moellmann committed
159 160 161 162 163 164 165 166 167 168 169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
  "Return a window satisfying PREDICATE.

This function cycles through all visible windows using `walk-windows',
calling PREDICATE on each one.  PREDICATE is called with a window as
argument.  The first window for which PREDICATE returns a non-nil
value is returned.  If no window satisfies PREDICATE, DEFAULT is
returned.

Optional second arg MINIBUF t means count the minibuffer window even
if not active.  MINIBUF nil or omitted means count the minibuffer iff
it is active.  MINIBUF neither t nor nil means not to count the
minibuffer even if it is active.

Several frames may share a single minibuffer; if the minibuffer
counts, all windows on all frames that share that minibuffer count
too.  Therefore, if you are using a separate minibuffer frame
and the minibuffer is active and MINIBUF says it counts,
`walk-windows' includes the windows in the frame from which you
entered the minibuffer, as well as the minibuffer window.

ALL-FRAMES is the optional third argument.
ALL-FRAMES nil or omitted means cycle within the frames as specified above.
ALL-FRAMES = `visible' means include windows on all visible frames.
ALL-FRAMES = 0 means include windows on all visible and iconified frames.
ALL-FRAMES = t means include windows on all frames including invisible frames.
If ALL-FRAMES is a frame, it means include windows on that frame.
Anything else means restrict to the selected frame."
  (catch 'found
187
    (walk-windows #'(lambda (window)
Gerd Moellmann's avatar
Gerd Moellmann committed
188 189 190 191
		      (when (funcall predicate window)
			(throw 'found window)))
		  minibuf all-frames)
    default))
192

193 194
(defalias 'some-window 'get-window-with-predicate)

195 196 197 198 199 200 201 202 203 204 205 206
;; This should probably be written in C (i.e., without using `walk-windows').
(defun get-buffer-window-list (buffer &optional minibuf frame)
  "Return list of all windows displaying BUFFER, or nil if none.
BUFFER can be a buffer or a buffer name.
See `walk-windows' for the meaning of MINIBUF and FRAME."
  (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
    (walk-windows (function (lambda (window)
			      (if (eq (window-buffer window) buffer)
				  (setq windows (cons window windows)))))
		  minibuf frame)
    windows))

207 208
(defun minibuffer-window-active-p (window)
  "Return t if WINDOW (a minibuffer window) is now active."
209
  (eq window (active-minibuffer-window)))
210

Joseph Arceneaux's avatar
Joseph Arceneaux committed
211
(defun count-windows (&optional minibuf)
212
   "Return the number of visible windows.
213 214 215
This counts the windows in the selected frame and (if the minibuffer is
to be counted) its minibuffer frame (if that's not the same frame).
The optional arg MINIBUF non-nil means count the minibuffer
Karl Heuer's avatar
Karl Heuer committed
216
even if it is inactive."
Joseph Arceneaux's avatar
Joseph Arceneaux committed
217
   (let ((count 0))
218
     (walk-windows (function (lambda (w)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
219 220 221 222
			       (setq count (+ count 1))))
		   minibuf)
     count))

223
(defun window-safely-shrinkable-p (&optional window)
224 225
  "Non-nil if the WINDOW can be shrunk without shrinking other windows.
If WINDOW is nil or omitted, it defaults to the currently selected window."
226 227 228 229 230
  (with-selected-window (or window (selected-window))
    (let ((edges (window-edges)))
      (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
	  (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))

231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247 248

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;; `balance-windows' subroutines using `window-tree'

;;; Translate from internal window tree format

(defun bw-get-tree (&optional window-or-frame)
  "Get a window split tree in our format.

WINDOW-OR-FRAME must be nil, a frame, or a window.  If it is nil,
then the whole window split tree for `selected-frame' is returned.
If it is a frame, then this is used instead.  If it is a window,
then the smallest tree containing that window is returned."
  (when window-or-frame
    (unless (or (framep window-or-frame)
                (windowp window-or-frame))
      (error "Not a frame or window: %s" window-or-frame)))
  (let ((subtree (bw-find-tree-sub window-or-frame)))
249 250 251 252
    (when subtree
      (if (integerp subtree)
	  nil
	(bw-get-tree-1 subtree)))))
253 254 255 256 257 258 259 260 261 262 263 264 265 266 267 268 269 270 271 272 273 274 275 276 277 278 279 280 281 282 283 284 285 286 287 288 289 290 291 292 293 294 295 296 297 298 299 300

(defun bw-get-tree-1 (split)
  (if (windowp split)
      split
    (let ((dir (car split))
          (edges (car (cdr split)))
          (childs (cdr (cdr split))))
      (list
       (cons 'dir (if dir 'ver 'hor))
       (cons 'b (nth 3 edges))
       (cons 'r (nth 2 edges))
       (cons 't (nth 1 edges))
       (cons 'l (nth 0 edges))
       (cons 'childs (mapcar #'bw-get-tree-1 childs))))))

(defun bw-find-tree-sub (window-or-frame &optional get-parent)
  (let* ((window (when (windowp window-or-frame) window-or-frame))
         (frame (when (windowp window) (window-frame window)))
         (wt (car (window-tree frame))))
    (when (< 1 (length (window-list frame 0)))
      (if window
          (bw-find-tree-sub-1 wt window get-parent)
        wt))))

(defun bw-find-tree-sub-1 (tree win &optional get-parent)
  (unless (windowp win) (error "Not a window: %s" win))
  (if (memq win tree)
      (if get-parent
          get-parent
        tree)
    (let ((childs (cdr (cdr tree)))
          child
          subtree)
      (while (and childs (not subtree))
        (setq child (car childs))
        (setq childs (cdr childs))
        (when (and child (listp child))
          (setq subtree (bw-find-tree-sub-1 child win get-parent))))
      (if (integerp subtree)
          (progn
            (if (= 1 subtree)
                tree
              (1- subtree)))
        subtree
        ))))

;;; Window or object edges

301
(defun bw-l (obj)
302 303
  "Left edge of OBJ."
  (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
304
(defun bw-t (obj)
305 306
  "Top edge of OBJ."
  (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
307
(defun bw-r (obj)
308 309
  "Right edge of OBJ."
  (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
310
(defun bw-b (obj)
311 312 313 314 315
  "Bottom edge of OBJ."
  (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))

;;; Split directions

316
(defun bw-dir (obj)
317
  "Return window split tree direction if OBJ.
318
If OBJ is a window return 'both.  If it is a window split tree
319 320 321 322 323 324 325 326 327 328
then return its direction."
  (if (symbolp obj)
      obj
    (if (windowp obj)
        'both
      (let ((dir (cdr (assq 'dir obj))))
        (unless (memq dir '(hor ver both))
          (error "Can't find dir in %s" obj))
        dir))))

329
(defun bw-eqdir (obj1 obj2)
330 331
  "Return t if window split tree directions are equal.
OBJ1 and OBJ2 should be either windows or window split trees in
332
our format.  The directions returned by `bw-dir' are compared and
333 334 335 336 337 338 339 340 341
t is returned if they are `eq' or one of them is 'both."
  (let ((dir1 (bw-dir obj1))
        (dir2 (bw-dir obj2)))
    (or (eq dir1 dir2)
        (eq dir1 'both)
        (eq dir2 'both))))

;;; Building split tree

342
(defun bw-refresh-edges (obj)
343 344 345 346 347 348 349 350 351 352 353 354 355 356 357 358 359 360 361 362 363 364 365 366 367
  "Refresh the edge information of OBJ and return OBJ."
  (unless (windowp obj)
    (let ((childs (cdr (assq 'childs obj)))
          (ol 1000)
          (ot 1000)
          (or -1)
          (ob -1))
      (dolist (o childs)
        (when (> ol (bw-l o)) (setq ol (bw-l o)))
        (when (> ot (bw-t o)) (setq ot (bw-t o)))
        (when (< or (bw-r o)) (setq or (bw-r o)))
        (when (< ob (bw-b o)) (setq ob (bw-b o))))
      (setq obj (delq 'l obj))
      (setq obj (delq 't obj))
      (setq obj (delq 'r obj))
      (setq obj (delq 'b obj))
      (add-to-list 'obj (cons 'l ol))
      (add-to-list 'obj (cons 't ot))
      (add-to-list 'obj (cons 'r or))
      (add-to-list 'obj (cons 'b ob))
      ))
  obj)

;;; Balance windows

368
(defun balance-windows (&optional window-or-frame)
369 370 371
  "Make windows the same heights or widths in window split subtrees.

When called non-interactively WINDOW-OR-FRAME may be either a
372 373
window or a frame.  It then balances the windows on the implied
frame.  If the parameter is a window only the corresponding window
374
subtree is balanced."
Joseph Arceneaux's avatar
Joseph Arceneaux committed
375
  (interactive)
376 377 378 379 380 381 382 383 384 385 386
  (let (
        (wt (bw-get-tree window-or-frame))
        (w)
        (h)
        (tried-sizes)
        (last-sizes)
        (windows (window-list nil 0))
        (counter 0))
    (when wt
      (while (not (member last-sizes tried-sizes))
        (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
387
        (setq last-sizes (mapcar (lambda (w)
388 389 390 391 392 393 394 395
                                   (window-edges w))
                                 windows))
        (when (eq 'hor (bw-dir wt))
          (setq w (- (bw-r wt) (bw-l wt))))
        (when (eq 'ver (bw-dir wt))
          (setq h (- (bw-b wt) (bw-t wt))))
        (bw-balance-sub wt w h)))))

396
(defun bw-adjust-window (window delta horizontal)
397 398
  "Wrapper around `adjust-window-trailing-edge' with error checking.
Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
399 400 401 402 403 404 405 406 407
  ;; `adjust-window-trailing-edge' may fail if delta is too large.
  (while (>= (abs delta) 1)
    (condition-case err
        (progn
          (adjust-window-trailing-edge window delta horizontal)
          (setq delta 0))
      (error
       ;;(message "adjust: %s" (error-message-string err))
       (setq delta (/ delta 2))))))
408

409
(defun bw-balance-sub (wt w h)
410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426 427 428 429
  (setq wt (bw-refresh-edges wt))
  (unless w (setq w (- (bw-r wt) (bw-l wt))))
  (unless h (setq h (- (bw-b wt) (bw-t wt))))
  (if (windowp wt)
      (progn
        (when w
          (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
            (when (/= 0 dw)
                (bw-adjust-window wt dw t))))
        (when h
          (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
            (when (/= 0 dh)
              (bw-adjust-window wt dh nil)))))
    (let* ((childs (cdr (assq 'childs wt)))
           (lastchild (car (last childs)))
           (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
           (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
      (dolist (c childs)
          (bw-balance-sub c cw ch)))))

430 431 432 433 434 435 436 437 438 439 440 441 442 443 444 445 446 447 448 449 450 451 452 453 454 455 456 457 458 459 460 461 462 463 464 465 466 467 468 469 470 471 472 473 474 475 476 477 478 479 480 481 482 483 484 485 486 487 488 489 490 491 492 493 494 495 496 497 498 499 500 501 502 503 504 505 506 507 508 509 510 511 512 513 514 515 516 517 518 519 520 521 522
;;; A different solution to balance-windows

(defun window-fixed-size-p (&optional window direction)
  "Non-nil if WINDOW cannot be resized in DIRECTION.
DIRECTION can be nil (i.e. any), `height' or `width'."
  (with-current-buffer (window-buffer window)
    (let ((fixed (and (boundp 'window-size-fixed) window-size-fixed)))
      (when fixed
	(not (and direction
		  (member (cons direction window-size-fixed)
			  '((height . width) (width . height)))))))))

(defvar window-area-factor 1
  "Factor by which the window area should be over-estimated.
This is used by `balance-windows-area'.
Changing this globally has no effect.")

(defun balance-windows-area ()
  "Make all visible windows the same area (approximately).
See also `window-area-factor' to change the relative size of specific buffers."
  (interactive)
  (let* ((unchanged 0) (carry 0) (round 0)
         ;; Remove fixed-size windows.
         (wins (delq nil (mapcar (lambda (win)
                                   (if (not (window-fixed-size-p win)) win))
                                 (window-list nil 'nomini))))
         (changelog nil)
         next)
    ;; Resizing a window changes the size of surrounding windows in complex
    ;; ways, so it's difficult to balance them all.  The introduction of
    ;; `adjust-window-trailing-edge' made it a bit easier, but it is still
    ;; very difficult to do.  `balance-window' above takes an off-line
    ;; approach: get the whole window tree, then balance it, then try to
    ;; adjust the windows so they fit the result.
    ;; Here, instead, we take a "local optimization" approach, where we just
    ;; go through all the windows several times until nothing needs to be
    ;; changed.  The main problem with this approach is that it's difficult
    ;; to make sure it terminates, so we use some heuristic to try and break
    ;; off infinite loops.
    ;; After a round without any change, we allow a second, to give a chance
    ;; to the carry to propagate a minor imbalance from the end back to
    ;; the beginning.
    (while (< unchanged 2)
      ;; (message "New round")
      (setq unchanged (1+ unchanged) round (1+ round))
      (dolist (win wins)
        (setq next win)
        (while (progn (setq next (next-window next))
                      (window-fixed-size-p next)))
        ;; (assert (eq next (or (cadr (member win wins)) (car wins))))
        (let* ((horiz
                (< (car (window-edges win)) (car (window-edges next))))
               (areadiff (/ (- (* (window-height next) (window-width next)
                                  (buffer-local-value 'window-area-factor
                                                      (window-buffer next)))
                               (* (window-height win) (window-width win)
                                  (buffer-local-value 'window-area-factor
                                                      (window-buffer win))))
                            (max (buffer-local-value 'window-area-factor
                                                     (window-buffer win))
                                 (buffer-local-value 'window-area-factor
                                                     (window-buffer next)))))
               (edgesize (if horiz
                             (+ (window-height win) (window-height next))
                           (+ (window-width win) (window-width next))))
               (diff (/ areadiff edgesize)))
          (when (zerop diff)
            ;; Maybe diff is actually closer to 1 than to 0.
            (setq diff (/ (* 3 areadiff) (* 2 edgesize))))
          (when (and (zerop diff) (not (zerop areadiff)))
            (setq diff (/ (+ areadiff carry) edgesize))
            ;; Change things smoothly.
            (if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
          (if (zerop diff)
              ;; Make sure negligible differences don't accumulate to
              ;; become significant.
              (setq carry (+ carry areadiff))
            (bw-adjust-window win diff horiz)
            ;; (sit-for 0.5)
            (let ((change (cons win (window-edges win))))
              ;; If the same change has been seen already for this window,
              ;; we're most likely in an endless loop, so don't count it as
              ;; a change.
              (unless (member change changelog)
                (push change changelog)
                (setq unchanged 0 carry 0)))))))
    ;; We've now basically balanced all the windows.
    ;; But there may be some minor off-by-one imbalance left over,
    ;; so let's do some fine tuning.
    ;; (bw-finetune wins)
    ;; (message "Done in %d rounds" round)
    ))

523
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
524

525
;; I think this should be the default; I think people will prefer it--rms.
Richard M. Stallman's avatar
Richard M. Stallman committed
526
(defcustom split-window-keep-point t
527 528
  "*If non-nil, \\[split-window-vertically] keeps the original point \
in both children.
529 530
This is often more convenient for editing.
If nil, adjust point in each of the two windows to minimize redisplay.
531 532 533 534
This is convenient on slow terminals, but point can move strangely.

This option applies only to `split-window-vertically' and
functions that call it.  `split-window' always keeps the original
535
point in both children."
Richard M. Stallman's avatar
Richard M. Stallman committed
536 537
  :type 'boolean
  :group 'windows)
Jim Blandy's avatar
Jim Blandy committed
538

Joseph Arceneaux's avatar
Joseph Arceneaux committed
539 540
(defun split-window-vertically (&optional arg)
  "Split current window into two windows, one above the other.
541
The uppermost window gets ARG lines and the other gets the rest.
542
Negative ARG means select the size of the lowermost window instead.
543 544 545
With no argument, split equally or close to it.
Both windows display the same buffer now current.

546
If the variable `split-window-keep-point' is non-nil, both new windows
Jim Blandy's avatar
Jim Blandy committed
547
will get the same value of point as the current window.  This is often
548
more convenient for editing.  The upper window is the selected window.
Jim Blandy's avatar
Jim Blandy committed
549

550
Otherwise, we choose window starts so as to minimize the amount of
Jim Blandy's avatar
Jim Blandy committed
551 552 553
redisplay; this is convenient on slow terminals.  The new selected
window is the one that the current value of point appears in.  The
value of point can change if the text around point is hidden by the
554 555 556 557 558
new mode line.

Regardless of the value of `split-window-keep-point', the upper
window is the original one and the return value is the new, lower
window."
Joseph Arceneaux's avatar
Joseph Arceneaux committed
559 560
  (interactive "P")
  (let ((old-w (selected-window))
561
	(old-point (point))
562
	(size (and arg (prefix-numeric-value arg)))
563 564
        (window-full-p nil)
	new-w bottom switch moved)
565 566
    (and size (< size 0) (setq size (+ (window-height) size)))
    (setq new-w (split-window nil size))
Jim Blandy's avatar
Jim Blandy committed
567
    (or split-window-keep-point
568
	(progn
Jim Blandy's avatar
Jim Blandy committed
569 570 571
	  (save-excursion
	    (set-buffer (window-buffer))
	    (goto-char (window-start))
572
            (setq moved (vertical-motion (window-height)))
Jim Blandy's avatar
Jim Blandy committed
573 574 575
	    (set-window-start new-w (point))
	    (if (> (point) (window-point new-w))
		(set-window-point new-w (point)))
576 577 578 579 580 581 582 583 584 585 586 587 588
            (and (= moved (window-height))
                 (progn
                   (setq window-full-p t)
                   (vertical-motion -1)))
            (setq bottom (point)))
          (and window-full-p
               (<= bottom (point))
               (set-window-point old-w (1- bottom)))
	  (and window-full-p
               (<= (window-start new-w) old-point)
               (progn
                 (set-window-point new-w old-point)
                 (select-window new-w)))))
589 590
    (split-window-save-restore-data new-w old-w)))

591 592 593
;; This is to avoid compiler warnings.
(defvar view-return-to-alist)

594
(defun split-window-save-restore-data (new-w old-w)
595
  (with-current-buffer (window-buffer)
596 597
    (if view-mode
	(let ((old-info (assq old-w view-return-to-alist)))
598 599 600
	  (if old-info
	      (push (cons new-w (cons (car (cdr old-info)) t))
		    view-return-to-alist))))
601
    new-w))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
602 603 604

(defun split-window-horizontally (&optional arg)
  "Split current window into two windows side by side.
605
This window becomes the leftmost of the two, and gets ARG columns.
606
Negative ARG means select the size of the rightmost window instead.
607 608
The argument includes the width of the window's scroll bar; if there
are no scroll bars, it includes the width of the divider column
609 610 611 612
to the window's right, if any.  No ARG means split equally.

The original, leftmost window remains selected.
The return value is the new, rightmost window."
Joseph Arceneaux's avatar
Joseph Arceneaux committed
613
  (interactive "P")
614 615
  (let ((old-w (selected-window))
	(size (and arg (prefix-numeric-value arg))))
616 617
    (and size (< size 0)
	 (setq size (+ (window-width) size)))
618
    (split-window-save-restore-data (split-window nil size t) old-w)))
619 620 621 622 623 624 625 626 627 628 629 630 631 632


(defun set-window-text-height (window height)
  "Sets the height in lines of the text display area of WINDOW to HEIGHT.
This doesn't include the mode-line (or header-line if any) or any
partial-height lines in the text display area.

If WINDOW is nil, the selected window is used.

Note that the current implementation of this function cannot always set
the height exactly, but attempts to be conservative, by allocating more
lines than are actually needed in the case where some error may be present."
  (let ((delta (- height (window-text-height window))))
    (unless (zerop delta)
633 634 635 636 637
      ;; Setting window-min-height to a value like 1 can lead to very
      ;; bizarre displays because it also allows Emacs to make *other*
      ;; windows 1-line tall, which means that there's no more space for
      ;; the modeline.
      (let ((window-min-height (min 2 height))) ;One text line plus a modeline.
638 639 640 641 642
	(if (and window (not (eq window (selected-window))))
	    (save-selected-window
	      (select-window window)
	      (enlarge-window delta))
	  (enlarge-window delta))))))
643

644

Joseph Arceneaux's avatar
Joseph Arceneaux committed
645 646 647 648 649 650 651 652 653 654
(defun enlarge-window-horizontally (arg)
  "Make current window ARG columns wider."
  (interactive "p")
  (enlarge-window arg t))

(defun shrink-window-horizontally (arg)
  "Make current window ARG columns narrower."
  (interactive "p")
  (shrink-window arg t))

655 656
(defun window-buffer-height (window)
  "Return the height (in screen lines) of the buffer that WINDOW is displaying."
657 658 659 660 661 662 663
  (with-current-buffer (window-buffer window)
    (max 1
	 (count-screen-lines (point-min) (point-max)
			     ;; If buffer ends with a newline, ignore it when
			     ;; counting height unless point is after it.
			     (eobp)
			     window))))
664

665 666 667 668 669 670 671 672
(defun count-screen-lines (&optional beg end count-final-newline window)
  "Return the number of screen lines in the region.
The number of screen lines may be different from the number of actual lines,
due to line breaking, display table, etc.

Optional arguments BEG and END default to `point-min' and `point-max'
respectively.

673
If region ends with a newline, ignore it unless optional third argument
674 675 676
COUNT-FINAL-NEWLINE is non-nil.

The optional fourth argument WINDOW specifies the window used for obtaining
677
parameters such as width, horizontal scrolling, and so on.  The default is
678 679 680
to use the selected window's parameters.

Like `vertical-motion', `count-screen-lines' always uses the current buffer,
681
regardless of which buffer is displayed in WINDOW.  This makes possible to use
682 683 684 685 686 687 688 689 690 691 692 693 694 695 696 697 698 699 700
`count-screen-lines' in any buffer, whether or not it is currently displayed
in some window."
  (unless beg
    (setq beg (point-min)))
  (unless end
    (setq end (point-max)))
  (if (= beg end)
      0
    (save-excursion
      (save-restriction
        (widen)
        (narrow-to-region (min beg end)
                          (if (and (not count-final-newline)
                                   (= ?\n (char-before (max beg end))))
                              (1- (max beg end))
                            (max beg end)))
        (goto-char (point-min))
        (1+ (vertical-motion (buffer-size) window))))))

701
(defun fit-window-to-buffer (&optional window max-height min-height)
702
  "Make WINDOW the right height to display its contents exactly.
703
If WINDOW is omitted or nil, it defaults to the selected window.
704 705 706 707 708 709 710 711 712 713 714
If the optional argument MAX-HEIGHT is supplied, it is the maximum height
  the window is allowed to be, defaulting to the frame height.
If the optional argument MIN-HEIGHT is supplied, it is the minimum
  height the window is allowed to be, defaulting to `window-min-height'.

The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or
header-line."
  (interactive)

  (when (null window)
    (setq window (selected-window)))
715 716
  (when (null max-height)
    (setq max-height (frame-height (window-frame window))))
717

718 719 720 721
  (let* ((buf
	  ;; Buffer that is displayed in WINDOW
	  (window-buffer window))
	 (window-height
722 723
	  ;; The current height of WINDOW
	  (window-height window))
724
	 (desired-height
725 726
	  ;; The height necessary to show the buffer displayed by WINDOW
	  ;; (`count-screen-lines' always works on the current buffer).
727 728
	  (with-current-buffer buf
	    (+ (count-screen-lines)
729 730 731 732 733
	       ;; If the buffer is empty, (count-screen-lines) is
	       ;; zero.  But, even in that case, we need one text line
	       ;; for cursor.
	       (if (= (point-min) (point-max))
		   1 0)
734 735 736 737 738 739
	       ;; For non-minibuffers, count the mode-line, if any
	       (if (and (not (window-minibuffer-p window))
			mode-line-format)
		   1 0)
	       ;; Count the header-line, if any
	       (if header-line-format 1 0))))
740 741
	 (delta
	  ;; Calculate how much the window height has to change to show
742 743
	  ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
	  (- (max (min desired-height max-height)
744
		  (or min-height window-min-height))
745
	     window-height)))
746 747 748

    ;; Don't try to redisplay with the cursor at the end
    ;; on its own line--that would force a scroll and spoil things.
749 750 751 752 753 754 755 756 757 758 759 760 761 762 763 764 765
    (when (with-current-buffer buf
	    (and (eobp) (bolp) (not (bobp))))
      (set-window-point window (1- (window-point window))))

    (save-selected-window
      (select-window window)

      ;; Adjust WINDOW to the nominally correct size (which may actually
      ;; be slightly off because of variable height text, etc).
      (unless (zerop delta)
	(enlarge-window delta))

      ;; Check if the last line is surely fully visible.  If not,
      ;; enlarge the window.
      (let ((end (with-current-buffer buf
		   (save-excursion
		     (goto-char (point-max))
766 767 768 769 770 771 772 773 774 775 776
		     (when (and (bolp) (not (bobp)))
		       ;; Don't include final newline
		       (backward-char 1))
		     (when truncate-lines
		       ;; If line-wrapping is turned off, test the
		       ;; beginning of the last line for visibility
		       ;; instead of the end, as the end of the line
		       ;; could be invisible by virtue of extending past
		       ;; the edge of the window.
		       (forward-line 0))
		     (point)))))
777 778 779
	(set-window-vscroll window 0)
	(while (and (< desired-height max-height)
		    (= desired-height (window-height window))
780
		    (not (pos-visible-in-window-p end window)))
781
	  (enlarge-window 1)
782
	  (setq desired-height (1+ desired-height)))))))
783

784
(defun shrink-window-if-larger-than-buffer (&optional window)
785
  "Shrink the WINDOW to be as small as possible to display its contents.
786
If WINDOW is omitted or nil, it defaults to the selected window.
787
Do not shrink to less than `window-min-height' lines.
788
Do nothing if the buffer contains more lines than the present window height,
789
or if some of the window's contents are scrolled out of view,
790
or if shrinking this window would also shrink another window,
791
or if the window is the only window of its frame."
792
  (interactive)
793 794 795 796 797 798
  (when (null window)
    (setq window (selected-window)))
  (let* ((frame (window-frame window))
	 (mini (frame-parameter frame 'minibuffer))
	 (edges (window-edges window)))
    (if (and (not (eq window (frame-root-window frame)))
799
	     (window-safely-shrinkable-p)
800 801 802
	     (pos-visible-in-window-p (point-min) window)
	     (not (eq mini 'only))
	     (or (not mini)
803 804 805 806 807
		 (let ((mini-window (minibuffer-window frame)))
		   (or (null mini-window)
		       (not (eq frame (window-frame mini-window)))
		       (< (nth 3 edges)
			  (nth 1 (window-edges mini-window)))
808
		       (> (nth 1 edges)
809
			  (frame-parameter frame 'menu-bar-lines))))))
810
	(fit-window-to-buffer window (window-height window)))))
811 812 813 814

(defun kill-buffer-and-window ()
  "Kill the current buffer and delete the selected window."
  (interactive)
815
  (let ((window-to-delete (selected-window))
816
	(buffer-to-kill (current-buffer))
817 818 819 820
	(delete-window-hook (lambda ()
			      (condition-case nil
				  (delete-window)
				(error nil)))))
821 822 823 824 825 826 827 828 829 830 831 832 833 834
    (unwind-protect
	(progn
	  (add-hook 'kill-buffer-hook delete-window-hook t t)
	  (if (kill-buffer (current-buffer))
	      ;; If `delete-window' failed before, we rerun it to regenerate
	      ;; the error so it can be seen in the echo area.
	      (when (eq (selected-window) window-to-delete)
		(delete-window))))
      ;; If the buffer is not dead for some reason (probably because
      ;; of a `quit' signal), remove the hook again.
      (condition-case nil
	  (with-current-buffer buffer-to-kill
	    (remove-hook 'kill-buffer-hook delete-window-hook t))
	(error nil)))))
835

836 837
(defun quit-window (&optional kill window)
  "Quit the current buffer.  Bury it, and maybe delete the selected frame.
838
\(The frame is deleted if it contains a dedicated window for the buffer.)
839 840 841 842 843 844 845 846 847
With a prefix argument, kill the buffer instead.

Noninteractively, if KILL is non-nil, then kill the current buffer,
otherwise bury it.

If WINDOW is non-nil, it specifies a window; we delete that window,
and the buffer that is killed or buried is the one in that window."
  (interactive "P")
  (let ((buffer (window-buffer window))
848
	(frame (window-frame (or window (selected-window))))
849 850 851 852 853 854 855 856 857 858
	(window-solitary
	 (save-selected-window
	   (if window
	       (select-window window))
	   (one-window-p t)))
	window-handled)

    (save-selected-window
      (if window
	  (select-window window))
859 860 861
      (or (window-minibuffer-p)
	  (window-dedicated-p (selected-window))
	  (switch-to-buffer (other-buffer))))
862 863 864

    ;; Get rid of the frame, if it has just one dedicated window
    ;; and other visible frames exist.
865
    (and (or (window-minibuffer-p) (window-dedicated-p window))
866 867 868 869 870 871 872 873 874 875 876 877 878 879 880 881
	 (delq frame (visible-frame-list))
	 window-solitary
	 (if (and (eq default-minibuffer-frame frame)
		  (= 1 (length (minibuffer-frame-list))))
	     (setq window nil)
	   (delete-frame frame)
	   (setq window-handled t)))

    ;; Deal with the buffer.
    (if kill
	(kill-buffer buffer)
      (bury-buffer buffer))

    ;; Maybe get rid of the window.
    (and window (not window-handled) (not window-solitary)
	 (delete-window window))))
882 883 884 885 886 887 888 889 890 891

(defvar mouse-autoselect-window-timer nil
  "Timer used by delayed window autoselection.")

(defvar mouse-autoselect-window-position nil
  "Last mouse position recorded by delayed window autoselection.")

(defvar mouse-autoselect-window-window nil
  "Last window recorded by delayed window autoselection.")

892 893 894 895 896
(defvar mouse-autoselect-window-state nil
  "When non-nil, special state of delayed window autoselection.
Possible values are `suspend' \(suspend autoselection after a menu or
scrollbar interaction\) and `select' \(the next invocation of
'handle-select-window' shall select the window immediately\).")
897 898 899 900 901 902 903 904 905

(defun mouse-autoselect-window-cancel (&optional force)
  "Cancel delayed window autoselection.
Optional argument FORCE means cancel unconditionally."
  (unless (and (not force)
	       ;; Don't cancel while the user drags a scroll bar.
	       (eq this-command 'scroll-bar-toolkit-scroll)
	       (memq (nth 4 (event-end last-input-event))
		     '(handle end-scroll)))
906
    (setq mouse-autoselect-window-state nil)
907 908 909 910
    (when (timerp mouse-autoselect-window-timer)
      (cancel-timer mouse-autoselect-window-timer))
    (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))

911
(defun mouse-autoselect-window-start (mouse-position &optional window suspend)
912
  "Start delayed window autoselection.
913 914 915 916 917 918 919 920 921
MOUSE-POSITION is the last position where the mouse was seen as returned
by `mouse-position'.  Optional argument WINDOW non-nil denotes the
window where the mouse was seen.  Optional argument SUSPEND non-nil
means suspend autoselection."
  ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
  (setq mouse-autoselect-window-position mouse-position)
  (when window (setq mouse-autoselect-window-window window))
  (setq mouse-autoselect-window-state (when suspend 'suspend))
  ;; Install timer which runs `mouse-autoselect-window-select' after
922 923 924
  ;; `mouse-autoselect-window' seconds.
  (setq mouse-autoselect-window-timer
	(run-at-time
925
	 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
926 927 928 929 930 931 932 933

(defun mouse-autoselect-window-select ()
  "Select window with delayed window autoselection.
If the mouse position has stabilized in a non-selected window, select
that window.  The minibuffer window is selected iff the minibuffer is
active.  This function is run by `mouse-autoselect-window-timer'."
  (condition-case nil
      (let* ((mouse-position (mouse-position))
934 935 936 937 938
	     (window
	      (condition-case nil
		  (window-at (cadr mouse-position) (cddr mouse-position)
			     (car mouse-position))
		(error nil))))
939
	(cond
940 941 942 943 944 945 946 947 948
	 ((or (menu-or-popup-active-p)
	      (and window
		   (not (coordinates-in-window-p (cdr mouse-position) window))))
	  ;; A menu / popup dialog is active or the mouse is on the scroll-bar
	  ;; of WINDOW, temporarily suspend delayed autoselection.
	  (mouse-autoselect-window-start mouse-position nil t))
	 ((eq mouse-autoselect-window-state 'suspend)
	  ;; Delayed autoselection was temporarily suspended, reenable it.
	  (mouse-autoselect-window-start mouse-position))
949 950 951 952 953 954 955 956
	 ((and window (not (eq window (selected-window)))
	       (or (not (numberp mouse-autoselect-window))
		   (and (> mouse-autoselect-window 0)
			;; If `mouse-autoselect-window' is positive, select
			;; window if the window is the same as before.
			(eq window mouse-autoselect-window-window))
		   ;; Otherwise select window iff the mouse is at the same
		   ;; position as before.  Observe that the first test after
957 958 959 960
		   ;; starting autoselection usually fails since the value of
		   ;; `mouse-autoselect-window-position' recorded there is the
		   ;; position where the mouse has entered the new window and
		   ;; not necessarily where the mouse has stopped moving.
961 962 963 964
		   (equal mouse-position mouse-autoselect-window-position))
	       ;; The minibuffer is a candidate window iff it's active.
	       (or (not (window-minibuffer-p window))
		   (eq window (active-minibuffer-window))))
965 966
	  ;; Mouse position has stabilized in non-selected window: Cancel
	  ;; delayed autoselection and try to select that window.
967 968 969 970
	  (mouse-autoselect-window-cancel t)
	  ;; Select window where mouse appears unless the selected window is the
	  ;; minibuffer.  Use `unread-command-events' in order to execute pre-
	  ;; and post-command hooks and trigger idle timers.  To avoid delaying
971
	  ;; autoselection again, set `mouse-autoselect-window-state'."
972
	  (unless (window-minibuffer-p (selected-window))
973
	    (setq mouse-autoselect-window-state 'select)
974 975 976 977 978 979 980
	    (setq unread-command-events
		  (cons (list 'select-window (list window))
			unread-command-events))))
	 ((or (and window (eq window (selected-window)))
	      (not (numberp mouse-autoselect-window))
	      (equal mouse-position mouse-autoselect-window-position))
	  ;; Mouse position has either stabilized in the selected window or at
981
	  ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
982 983
	  (mouse-autoselect-window-cancel t))
	 (t
984 985 986
	  ;; Mouse position has not stabilized yet, resume delayed
	  ;; autoselection.
	  (mouse-autoselect-window-start mouse-position window))))
987
    (error nil)))
988

989 990 991 992
(defun handle-select-window (event)
  "Handle select-window events."
  (interactive "e")
  (let ((window (posn-window (event-start event))))
993 994 995 996 997 998 999 1000 1001 1002 1003
    (when (and (window-live-p window)
	       ;; Don't switch if we're currently in the minibuffer.
	       ;; This tries to work around problems where the minibuffer gets
	       ;; unselected unexpectedly, and where you then have to move
	       ;; your mouse all the way down to the minibuffer to select it.
	       (not (window-minibuffer-p (selected-window)))
	       ;; Don't switch to a minibuffer window unless it's active.
	       (or (not (window-minibuffer-p window))
		   (minibuffer-window-active-p window)))
      (unless (and (numberp mouse-autoselect-window)
		   (not (zerop mouse-autoselect-window))
1004 1005 1006 1007 1008 1009 1010 1011 1012 1013 1014 1015
		   (not (eq mouse-autoselect-window-state 'select))
		   (progn
		     ;; Cancel any delayed autoselection.
		     (mouse-autoselect-window-cancel t)
		     ;; Start delayed autoselection from current mouse position
		     ;; and window.
		     (mouse-autoselect-window-start (mouse-position) window)
		     ;; Executing a command cancels delayed autoselection.
		     (add-hook
		      'pre-command-hook 'mouse-autoselect-window-cancel)))
	;; Reset state of delayed autoselection.
	(setq mouse-autoselect-window-state nil)
1016 1017 1018 1019
	(when mouse-autoselect-window
	  ;; Run `mouse-leave-buffer-hook' when autoselecting window.
	  (run-hooks 'mouse-leave-buffer-hook))
	(select-window window)))))
1020

Joseph Arceneaux's avatar
Joseph Arceneaux committed
1021
(define-key ctl-x-map "2" 'split-window-vertically)
Jim Blandy's avatar
Jim Blandy committed
1022
(define-key ctl-x-map "3" 'split-window-horizontally)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
1023 1024
(define-key ctl-x-map "}" 'enlarge-window-horizontally)
(define-key ctl-x-map "{" 'shrink-window-horizontally)
1025 1026
(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
(define-key ctl-x-map "+" 'balance-windows)
1027
(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
Eric S. Raymond's avatar
Eric S. Raymond committed
1028

1029
;; arch-tag: b508dfcc-c353-4c37-89fa-e773fe10cea9
1030
;;; window.el ends here