window.el 36.4 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
13
;; the Free Software Foundation; either version 3, 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 60 61
	 (save-selected-window-alist
	  (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
		  (frame-list))))
62 63 64 65 66 67 68 69 70
     (save-current-buffer
       (unwind-protect
	   (progn ,@body)
	 (dolist (elt save-selected-window-alist)
	   (and (frame-live-p (car elt))
		(window-live-p (cadr elt))
		(set-frame-selected-window (car elt) (cadr elt))))
	 (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
(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
123
if not active.  MINIBUF nil or omitted means count the minibuffer only if
124 125 126 127 128
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
  "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
168
if not active.  MINIBUF nil or omitted means count the minibuffer only if
Gerd Moellmann's avatar
Gerd Moellmann committed
169 170 171 172 173 174 175 176 177 178 179 180 181 182 183 184 185 186
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 399 400 401 402 403 404
  "Wrapper around `adjust-window-trailing-edge' with error checking.
Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
  (condition-case err
      (adjust-window-trailing-edge window delta horizontal)
    (error
     ;;(message "adjust: %s" (error-message-string err))
     )))

405
(defun bw-balance-sub (wt w h)
406 407 408 409 410 411 412 413 414 415 416 417 418 419 420 421 422 423 424 425 426
  (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)))))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
427

428
;; I think this should be the default; I think people will prefer it--rms.
Richard M. Stallman's avatar
Richard M. Stallman committed
429
(defcustom split-window-keep-point t
430 431
  "*If non-nil, \\[split-window-vertically] keeps the original point \
in both children.
432 433
This is often more convenient for editing.
If nil, adjust point in each of the two windows to minimize redisplay.
434 435 436 437
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
438
point in both children."
Richard M. Stallman's avatar
Richard M. Stallman committed
439 440
  :type 'boolean
  :group 'windows)
Jim Blandy's avatar
Jim Blandy committed
441

Joseph Arceneaux's avatar
Joseph Arceneaux committed
442 443
(defun split-window-vertically (&optional arg)
  "Split current window into two windows, one above the other.
444
The uppermost window gets ARG lines and the other gets the rest.
445
Negative ARG means select the size of the lowermost window instead.
446 447 448
With no argument, split equally or close to it.
Both windows display the same buffer now current.

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

453
Otherwise, we choose window starts so as to minimize the amount of
Jim Blandy's avatar
Jim Blandy committed
454 455 456
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
457 458 459 460 461
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
462 463
  (interactive "P")
  (let ((old-w (selected-window))
464
	(old-point (point))
465
	(size (and arg (prefix-numeric-value arg)))
466 467
        (window-full-p nil)
	new-w bottom switch moved)
468 469
    (and size (< size 0) (setq size (+ (window-height) size)))
    (setq new-w (split-window nil size))
Jim Blandy's avatar
Jim Blandy committed
470
    (or split-window-keep-point
471
	(progn
Jim Blandy's avatar
Jim Blandy committed
472 473 474
	  (save-excursion
	    (set-buffer (window-buffer))
	    (goto-char (window-start))
475
            (setq moved (vertical-motion (window-height)))
Jim Blandy's avatar
Jim Blandy committed
476 477 478
	    (set-window-start new-w (point))
	    (if (> (point) (window-point new-w))
		(set-window-point new-w (point)))
479 480 481 482 483 484 485 486 487 488 489 490 491
            (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)))))
492 493
    (split-window-save-restore-data new-w old-w)))

494 495 496
;; This is to avoid compiler warnings.
(defvar view-return-to-alist)

497
(defun split-window-save-restore-data (new-w old-w)
498
  (with-current-buffer (window-buffer)
499 500
    (if view-mode
	(let ((old-info (assq old-w view-return-to-alist)))
501 502 503
	  (if old-info
	      (push (cons new-w (cons (car (cdr old-info)) t))
		    view-return-to-alist))))
504
    new-w))
Joseph Arceneaux's avatar
Joseph Arceneaux committed
505 506 507

(defun split-window-horizontally (&optional arg)
  "Split current window into two windows side by side.
508
This window becomes the leftmost of the two, and gets ARG columns.
509
Negative ARG means select the size of the rightmost window instead.
510 511
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
512 513 514 515
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
516
  (interactive "P")
517 518
  (let ((old-w (selected-window))
	(size (and arg (prefix-numeric-value arg))))
519 520
    (and size (< size 0)
	 (setq size (+ (window-width) size)))
521
    (split-window-save-restore-data (split-window nil size t) old-w)))
522 523 524 525 526 527 528 529 530 531 532 533 534 535


(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)
536 537 538 539 540
      ;; 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.
541 542 543 544 545
	(if (and window (not (eq window (selected-window))))
	    (save-selected-window
	      (select-window window)
	      (enlarge-window delta))
	  (enlarge-window delta))))))
546

547

Joseph Arceneaux's avatar
Joseph Arceneaux committed
548 549 550 551 552 553 554 555 556 557
(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))

558 559
(defun window-buffer-height (window)
  "Return the height (in screen lines) of the buffer that WINDOW is displaying."
560 561 562 563 564 565 566
  (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))))
567

568 569 570 571 572 573 574 575
(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.

576
If region ends with a newline, ignore it unless optional third argument
577 578 579
COUNT-FINAL-NEWLINE is non-nil.

The optional fourth argument WINDOW specifies the window used for obtaining
580
parameters such as width, horizontal scrolling, and so on.  The default is
581 582 583
to use the selected window's parameters.

Like `vertical-motion', `count-screen-lines' always uses the current buffer,
584
regardless of which buffer is displayed in WINDOW.  This makes possible to use
585 586 587 588 589 590 591 592 593 594 595 596 597 598 599 600 601 602 603
`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))))))

604
(defun fit-window-to-buffer (&optional window max-height min-height)
605
  "Make WINDOW the right height to display its contents exactly.
606
If WINDOW is omitted or nil, it defaults to the selected window.
607 608 609 610 611 612 613 614 615 616 617
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)))
618 619
  (when (null max-height)
    (setq max-height (frame-height (window-frame window))))
620

621 622 623 624
  (let* ((buf
	  ;; Buffer that is displayed in WINDOW
	  (window-buffer window))
	 (window-height
625 626
	  ;; The current height of WINDOW
	  (window-height window))
627
	 (desired-height
628 629
	  ;; The height necessary to show the buffer displayed by WINDOW
	  ;; (`count-screen-lines' always works on the current buffer).
630 631
	  (with-current-buffer buf
	    (+ (count-screen-lines)
632 633 634 635 636
	       ;; 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)
637 638 639 640 641 642
	       ;; 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))))
643 644
	 (delta
	  ;; Calculate how much the window height has to change to show
645 646
	  ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
	  (- (max (min desired-height max-height)
647 648 649 650 651 652 653 654
		  (or min-height window-min-height))
	     window-height))
	 ;; We do our own height checking, so avoid any restrictions due to
	 ;; window-min-height.
	 (window-min-height 1))

    ;; Don't try to redisplay with the cursor at the end
    ;; on its own line--that would force a scroll and spoil things.
655 656 657 658 659 660 661 662 663 664 665 666 667 668 669 670 671
    (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))
672 673 674 675 676 677 678 679 680 681 682
		     (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)))))
683 684 685
	(set-window-vscroll window 0)
	(while (and (< desired-height max-height)
		    (= desired-height (window-height window))
686
		    (not (pos-visible-in-window-p end window)))
687
	  (enlarge-window 1)
688
	  (setq desired-height (1+ desired-height)))))))
689

690
(defun shrink-window-if-larger-than-buffer (&optional window)
691
  "Shrink the WINDOW to be as small as possible to display its contents.
692
If WINDOW is omitted or nil, it defaults to the selected window.
693
Do not shrink to less than `window-min-height' lines.
694
Do nothing if the buffer contains more lines than the present window height,
695
or if some of the window's contents are scrolled out of view,
696
or if shrinking this window would also shrink another window,
697
or if the window is the only window of its frame."
698
  (interactive)
699 700 701 702 703 704
  (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)))
705
	     (window-safely-shrinkable-p)
706 707 708
	     (pos-visible-in-window-p (point-min) window)
	     (not (eq mini 'only))
	     (or (not mini)
709 710 711 712 713
		 (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)))
714
		       (> (nth 1 edges)
715
			  (frame-parameter frame 'menu-bar-lines))))))
716
	(fit-window-to-buffer window (window-height window)))))
717 718 719 720

(defun kill-buffer-and-window ()
  "Kill the current buffer and delete the selected window."
  (interactive)
721
  (let ((window-to-delete (selected-window))
722
	(buffer-to-kill (current-buffer))
723 724 725 726
	(delete-window-hook (lambda ()
			      (condition-case nil
				  (delete-window)
				(error nil)))))
727 728 729 730 731 732 733 734 735 736 737 738 739 740
    (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)))))
741

742 743
(defun quit-window (&optional kill window)
  "Quit the current buffer.  Bury it, and maybe delete the selected frame.
744
\(The frame is deleted if it contains a dedicated window for the buffer.)
745 746 747 748 749 750 751 752 753
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))
754
	(frame (window-frame (or window (selected-window))))
755 756 757 758 759 760 761 762 763 764
	(window-solitary
	 (save-selected-window
	   (if window
	       (select-window window))
	   (one-window-p t)))
	window-handled)

    (save-selected-window
      (if window
	  (select-window window))
765 766 767
      (or (window-minibuffer-p)
	  (window-dedicated-p (selected-window))
	  (switch-to-buffer (other-buffer))))
768 769 770

    ;; Get rid of the frame, if it has just one dedicated window
    ;; and other visible frames exist.
771
    (and (or (window-minibuffer-p) (window-dedicated-p window))
772 773 774 775 776 777 778 779 780 781 782 783 784 785 786 787
	 (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))))
788 789 790 791 792 793 794 795 796 797

(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.")

798 799 800 801 802
(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\).")
803 804 805 806 807 808 809 810 811

(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)))
812
    (setq mouse-autoselect-window-state nil)
813 814 815 816
    (when (timerp mouse-autoselect-window-timer)
      (cancel-timer mouse-autoselect-window-timer))
    (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))

817
(defun mouse-autoselect-window-start (mouse-position &optional window suspend)
818
  "Start delayed window autoselection.
819 820 821 822 823 824 825 826 827
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
828 829 830
  ;; `mouse-autoselect-window' seconds.
  (setq mouse-autoselect-window-timer
	(run-at-time
831
	 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
832 833 834 835

(defun mouse-autoselect-window-select ()
  "Select window with delayed window autoselection.
If the mouse position has stabilized in a non-selected window, select
836
that window.  The minibuffer window is selected only if the minibuffer is
837 838 839
active.  This function is run by `mouse-autoselect-window-timer'."
  (condition-case nil
      (let* ((mouse-position (mouse-position))
840 841 842 843 844
	     (window
	      (condition-case nil
		  (window-at (cadr mouse-position) (cddr mouse-position)
			     (car mouse-position))
		(error nil))))
845
	(cond
846 847 848 849 850 851 852 853 854
	 ((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))
855 856 857 858 859 860
	 ((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))
861
		   ;; Otherwise select window if the mouse is at the same
862
		   ;; position as before.  Observe that the first test after
863 864 865 866
		   ;; 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.
867
		   (equal mouse-position mouse-autoselect-window-position))
868
	       ;; The minibuffer is a candidate window if it's active.
869 870
	       (or (not (window-minibuffer-p window))
		   (eq window (active-minibuffer-window))))
871 872
	  ;; Mouse position has stabilized in non-selected window: Cancel
	  ;; delayed autoselection and try to select that window.
873 874 875 876
	  (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
877
	  ;; autoselection again, set `mouse-autoselect-window-state'."
878
	  (unless (window-minibuffer-p (selected-window))
879
	    (setq mouse-autoselect-window-state 'select)
880 881 882 883 884 885 886
	    (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
887
	  ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
888 889
	  (mouse-autoselect-window-cancel t))
	 (t
890 891 892
	  ;; Mouse position has not stabilized yet, resume delayed
	  ;; autoselection.
	  (mouse-autoselect-window-start mouse-position window))))
893
    (error nil)))
894

895 896 897 898
(defun handle-select-window (event)
  "Handle select-window events."
  (interactive "e")
  (let ((window (posn-window (event-start event))))
899 900 901 902 903 904 905 906 907 908 909
    (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))
910 911 912 913 914 915 916 917 918 919 920 921
		   (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)
922 923 924 925
	(when mouse-autoselect-window
	  ;; Run `mouse-leave-buffer-hook' when autoselecting window.
	  (run-hooks 'mouse-leave-buffer-hook))
	(select-window window)))))
926

Joseph Arceneaux's avatar
Joseph Arceneaux committed
927
(define-key ctl-x-map "2" 'split-window-vertically)
Jim Blandy's avatar
Jim Blandy committed
928
(define-key ctl-x-map "3" 'split-window-horizontally)
Joseph Arceneaux's avatar
Joseph Arceneaux committed
929 930
(define-key ctl-x-map "}" 'enlarge-window-horizontally)
(define-key ctl-x-map "{" 'shrink-window-horizontally)
931 932
(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
(define-key ctl-x-map "+" 'balance-windows)
933
(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
Eric S. Raymond's avatar
Eric S. Raymond committed
934

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