Update years in copyright notice; nfc.
[bpt/emacs.git] / lisp / window.el
CommitLineData
55535639 1;;; window.el --- GNU Emacs window commands aside from those written in C
d46bac56 2
0d30b337 3;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001, 2002,
aaef169d 4;; 2003, 2004, 2005, 2006 Free Software Foundation, Inc.
a2535589 5
58142744 6;; Maintainer: FSF
284b3043 7;; Keywords: internal
58142744 8
a2535589
JA
9;; This file is part of GNU Emacs.
10
11;; GNU Emacs is free software; you can redistribute it and/or modify
12;; it under the terms of the GNU General Public License as published by
492878e4 13;; the Free Software Foundation; either version 2, or (at your option)
a2535589
JA
14;; any later version.
15
16;; GNU Emacs is distributed in the hope that it will be useful,
17;; but WITHOUT ANY WARRANTY; without even the implied warranty of
18;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
19;; GNU General Public License for more details.
20
21;; You should have received a copy of the GNU General Public License
b578f267 22;; along with GNU Emacs; see the file COPYING. If not, write to the
086add15
LK
23;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
24;; Boston, MA 02110-1301, USA.
a2535589 25
fe7a0e7d
SM
26;;; Commentary:
27
28;; Window tree functions.
29
30;;; Code:
82e6d8cb 31
64da8b20
RS
32(defvar window-size-fixed nil
33 "*Non-nil in a buffer means windows displaying the buffer are fixed-size.
9fa87e0d 34If the value is `height', then only the window's height is fixed.
64da8b20
RS
35If the value is `width', then only the window's width is fixed.
36Any other non-nil value fixes both the width and the height.
37Emacs won't change the size of any window displaying that buffer,
38unless you explicitly change the size, or Emacs has no other choice.")
39(make-variable-buffer-local 'window-size-fixed)
40
471af22c
AS
41(defmacro save-selected-window (&rest body)
42 "Execute BODY, then select the window that was selected before BODY.
7db3c58f
RS
43The value returned is the value of the last form in BODY.
44
45This macro saves and restores the current buffer, since otherwise
46its normal operation could potentially make a different
198081c8 47buffer current. It does not alter the buffer list ordering.
7db3c58f
RS
48
49This macro saves and restores the selected window, as well as
50the selected window in each frame. If the previously selected
51window of some frame is no longer live at the end of BODY, that
52frame's selected window is left alone. If the selected window is
53no longer live, then whatever window is selected at the end of
54BODY remains selected."
991ce473 55 `(let ((save-selected-window-window (selected-window))
1c795a0e
RS
56 ;; It is necessary to save all of these, because calling
57 ;; select-window changes frame-selected-window for whatever
58 ;; frame that window is in.
991ce473
RS
59 (save-selected-window-alist
60 (mapcar (lambda (frame) (list frame (frame-selected-window frame)))
61 (frame-list))))
7db3c58f
RS
62 (save-current-buffer
63 (unwind-protect
64 (progn ,@body)
65 (dolist (elt save-selected-window-alist)
66 (and (frame-live-p (car elt))
67 (window-live-p (cadr elt))
68 (set-frame-selected-window (car elt) (cadr elt))))
69 (if (window-live-p save-selected-window-window)
70 (select-window save-selected-window-window))))))
471af22c 71
e58bff59
RS
72(defun window-body-height (&optional window)
73 "Return number of lines in window WINDOW for actual buffer text.
74This does not include the mode line (if any) or the header line (if any)."
75 (or window (setq window (selected-window)))
9df6e638
RS
76 (if (window-minibuffer-p window)
77 (window-height window)
78 (with-current-buffer (window-buffer window)
79 (max 1 (- (window-height window)
80 (if mode-line-format 1 0)
81 (if header-line-format 1 0))))))
e58bff59 82
82e6d8cb 83(defun one-window-p (&optional nomini all-frames)
90dc1922 84 "Return non-nil if the selected window is the only window.
82e6d8cb 85Optional arg NOMINI non-nil means don't count the minibuffer
90dc1922
LT
86even if it is active. Otherwise, the minibuffer is counted
87when it is active.
82e6d8cb
RS
88
89The optional arg ALL-FRAMES t means count windows on all frames.
90If it is `visible', count windows on all visible frames.
fe7a0e7d 91ALL-FRAMES nil or omitted means count only the selected frame,
82e6d8cb 92plus the minibuffer it uses (which may be on another frame).
90dc1922
LT
93ALL-FRAMES 0 means count all windows in all visible or iconified frames.
94If ALL-FRAMES is anything else, count only the selected frame."
82e6d8cb
RS
95 (let ((base-window (selected-window)))
96 (if (and nomini (eq base-window (minibuffer-window)))
97 (setq base-window (next-window base-window)))
98 (eq base-window
99 (next-window base-window (if nomini 'arg) all-frames))))
100
22f9c48c
KS
101(defun window-current-scroll-bars (&optional window)
102 "Return the current scroll-bar settings in window WINDOW.
c62195fa 103Value is a cons (VERTICAL . HORIZONTAL) where VERTICAL specifies the
22f9c48c 104current location of the vertical scroll-bars (left, right, or nil),
c62195fa 105and HORIZONTAL specifies the current location of the horizontal scroll
22f9c48c
KS
106bars (top, bottom, or nil)."
107 (let ((vert (nth 2 (window-scroll-bars window)))
108 (hor nil))
109 (when (or (eq vert t) (eq hor t))
90dc1922 110 (let ((fcsb (frame-current-scroll-bars
22f9c48c
KS
111 (window-frame (or window (selected-window))))))
112 (if (eq vert t)
113 (setq vert (car fcsb)))
114 (if (eq hor t)
115 (setq hor (cdr fcsb)))))
116 (cons vert hor)))
117
82e6d8cb
RS
118(defun walk-windows (proc &optional minibuf all-frames)
119 "Cycle through all visible windows, calling PROC for each one.
120PROC is called with a window as argument.
121
122Optional second arg MINIBUF t means count the minibuffer window even
123if not active. MINIBUF nil or omitted means count the minibuffer iff
124it is active. MINIBUF neither t nor nil means not to count the
125minibuffer even if it is active.
126
127Several frames may share a single minibuffer; if the minibuffer
128counts, all windows on all frames that share that minibuffer count
5aa29df8
RS
129too. Therefore, if you are using a separate minibuffer frame
130and the minibuffer is active and MINIBUF says it counts,
82e6d8cb 131`walk-windows' includes the windows in the frame from which you
5aa29df8 132entered the minibuffer, as well as the minibuffer window.
82e6d8cb 133
04ea572f
RS
134ALL-FRAMES is the optional third argument.
135ALL-FRAMES nil or omitted means cycle within the frames as specified above.
136ALL-FRAMES = `visible' means include windows on all visible frames.
82e6d8cb 137ALL-FRAMES = 0 means include windows on all visible and iconified frames.
04ea572f 138ALL-FRAMES = t means include windows on all frames including invisible frames.
aeb721fe 139If ALL-FRAMES is a frame, it means include windows on that frame.
c7d031ed 140Anything else means restrict to the selected frame."
82e6d8cb
RS
141 ;; If we start from the minibuffer window, don't fail to come back to it.
142 (if (window-minibuffer-p (selected-window))
143 (setq minibuf t))
aeb721fe
GM
144 (save-selected-window
145 (if (framep all-frames)
146 (select-window (frame-first-window all-frames)))
d4aff7cc
GM
147 (let* (walk-windows-already-seen
148 (walk-windows-current (selected-window)))
aeb721fe
GM
149 (while (progn
150 (setq walk-windows-current
151 (next-window walk-windows-current minibuf all-frames))
d4aff7cc
GM
152 (not (memq walk-windows-current walk-windows-already-seen)))
153 (setq walk-windows-already-seen
154 (cons walk-windows-current walk-windows-already-seen))
155 (funcall proc walk-windows-current)))))
156
d4d986f2
GM
157(defun get-window-with-predicate (predicate &optional minibuf
158 all-frames default)
d4aff7cc
GM
159 "Return a window satisfying PREDICATE.
160
161This function cycles through all visible windows using `walk-windows',
162calling PREDICATE on each one. PREDICATE is called with a window as
163argument. The first window for which PREDICATE returns a non-nil
164value is returned. If no window satisfies PREDICATE, DEFAULT is
165returned.
166
167Optional second arg MINIBUF t means count the minibuffer window even
168if not active. MINIBUF nil or omitted means count the minibuffer iff
169it is active. MINIBUF neither t nor nil means not to count the
170minibuffer even if it is active.
171
172Several frames may share a single minibuffer; if the minibuffer
173counts, all windows on all frames that share that minibuffer count
174too. Therefore, if you are using a separate minibuffer frame
175and the minibuffer is active and MINIBUF says it counts,
176`walk-windows' includes the windows in the frame from which you
177entered the minibuffer, as well as the minibuffer window.
178
179ALL-FRAMES is the optional third argument.
180ALL-FRAMES nil or omitted means cycle within the frames as specified above.
181ALL-FRAMES = `visible' means include windows on all visible frames.
182ALL-FRAMES = 0 means include windows on all visible and iconified frames.
183ALL-FRAMES = t means include windows on all frames including invisible frames.
184If ALL-FRAMES is a frame, it means include windows on that frame.
185Anything else means restrict to the selected frame."
186 (catch 'found
fe7a0e7d 187 (walk-windows #'(lambda (window)
d4aff7cc
GM
188 (when (funcall predicate window)
189 (throw 'found window)))
190 minibuf all-frames)
191 default))
82e6d8cb 192
d4d986f2
GM
193(defalias 'some-window 'get-window-with-predicate)
194
ba27aa4c
RS
195;; This should probably be written in C (i.e., without using `walk-windows').
196(defun get-buffer-window-list (buffer &optional minibuf frame)
197 "Return list of all windows displaying BUFFER, or nil if none.
198BUFFER can be a buffer or a buffer name.
199See `walk-windows' for the meaning of MINIBUF and FRAME."
200 (let ((buffer (if (bufferp buffer) buffer (get-buffer buffer))) windows)
201 (walk-windows (function (lambda (window)
202 (if (eq (window-buffer window) buffer)
203 (setq windows (cons window windows)))))
204 minibuf frame)
205 windows))
206
82e6d8cb
RS
207(defun minibuffer-window-active-p (window)
208 "Return t if WINDOW (a minibuffer window) is now active."
0d624ea4 209 (eq window (active-minibuffer-window)))
82e6d8cb 210\f
a2535589 211(defun count-windows (&optional minibuf)
fe7a0e7d 212 "Return the number of visible windows.
b70b2dd2
KH
213This counts the windows in the selected frame and (if the minibuffer is
214to be counted) its minibuffer frame (if that's not the same frame).
215The optional arg MINIBUF non-nil means count the minibuffer
c6897d8e 216even if it is inactive."
a2535589 217 (let ((count 0))
12169754 218 (walk-windows (function (lambda (w)
a2535589
JA
219 (setq count (+ count 1))))
220 minibuf)
221 count))
222
fe7a0e7d 223(defun window-safely-shrinkable-p (&optional window)
119171dd
EZ
224 "Non-nil if the WINDOW can be shrunk without shrinking other windows.
225If WINDOW is nil or omitted, it defaults to the currently selected window."
fc4d69e1
SM
226 (with-selected-window (or window (selected-window))
227 (let ((edges (window-edges)))
228 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
229 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
230
614b38a9
EZ
231\f
232;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
233;;; `balance-windows' subroutines using `window-tree'
234
235;;; Translate from internal window tree format
236
237(defun bw-get-tree (&optional window-or-frame)
238 "Get a window split tree in our format.
239
240WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
241then the whole window split tree for `selected-frame' is returned.
242If it is a frame, then this is used instead. If it is a window,
243then the smallest tree containing that window is returned."
244 (when window-or-frame
245 (unless (or (framep window-or-frame)
246 (windowp window-or-frame))
247 (error "Not a frame or window: %s" window-or-frame)))
248 (let ((subtree (bw-find-tree-sub window-or-frame)))
249 (if (integerp subtree)
250 nil
251 (bw-get-tree-1 subtree))))
252
253(defun bw-get-tree-1 (split)
254 (if (windowp split)
255 split
256 (let ((dir (car split))
257 (edges (car (cdr split)))
258 (childs (cdr (cdr split))))
259 (list
260 (cons 'dir (if dir 'ver 'hor))
261 (cons 'b (nth 3 edges))
262 (cons 'r (nth 2 edges))
263 (cons 't (nth 1 edges))
264 (cons 'l (nth 0 edges))
265 (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
266
267(defun bw-find-tree-sub (window-or-frame &optional get-parent)
268 (let* ((window (when (windowp window-or-frame) window-or-frame))
269 (frame (when (windowp window) (window-frame window)))
270 (wt (car (window-tree frame))))
271 (when (< 1 (length (window-list frame 0)))
272 (if window
273 (bw-find-tree-sub-1 wt window get-parent)
274 wt))))
275
276(defun bw-find-tree-sub-1 (tree win &optional get-parent)
277 (unless (windowp win) (error "Not a window: %s" win))
278 (if (memq win tree)
279 (if get-parent
280 get-parent
281 tree)
282 (let ((childs (cdr (cdr tree)))
283 child
284 subtree)
285 (while (and childs (not subtree))
286 (setq child (car childs))
287 (setq childs (cdr childs))
288 (when (and child (listp child))
289 (setq subtree (bw-find-tree-sub-1 child win get-parent))))
290 (if (integerp subtree)
291 (progn
292 (if (= 1 subtree)
293 tree
294 (1- subtree)))
295 subtree
296 ))))
297
298;;; Window or object edges
299
7017d254 300(defun bw-l (obj)
614b38a9
EZ
301 "Left edge of OBJ."
302 (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
7017d254 303(defun bw-t (obj)
614b38a9
EZ
304 "Top edge of OBJ."
305 (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
7017d254 306(defun bw-r (obj)
614b38a9
EZ
307 "Right edge of OBJ."
308 (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
7017d254 309(defun bw-b (obj)
614b38a9
EZ
310 "Bottom edge of OBJ."
311 (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
312
313;;; Split directions
314
7017d254 315(defun bw-dir (obj)
614b38a9 316 "Return window split tree direction if OBJ.
7017d254 317If OBJ is a window return 'both. If it is a window split tree
614b38a9
EZ
318then return its direction."
319 (if (symbolp obj)
320 obj
321 (if (windowp obj)
322 'both
323 (let ((dir (cdr (assq 'dir obj))))
324 (unless (memq dir '(hor ver both))
325 (error "Can't find dir in %s" obj))
326 dir))))
327
7017d254 328(defun bw-eqdir (obj1 obj2)
614b38a9
EZ
329 "Return t if window split tree directions are equal.
330OBJ1 and OBJ2 should be either windows or window split trees in
7017d254 331our format. The directions returned by `bw-dir' are compared and
614b38a9
EZ
332t is returned if they are `eq' or one of them is 'both."
333 (let ((dir1 (bw-dir obj1))
334 (dir2 (bw-dir obj2)))
335 (or (eq dir1 dir2)
336 (eq dir1 'both)
337 (eq dir2 'both))))
338
339;;; Building split tree
340
7017d254 341(defun bw-refresh-edges (obj)
614b38a9
EZ
342 "Refresh the edge information of OBJ and return OBJ."
343 (unless (windowp obj)
344 (let ((childs (cdr (assq 'childs obj)))
345 (ol 1000)
346 (ot 1000)
347 (or -1)
348 (ob -1))
349 (dolist (o childs)
350 (when (> ol (bw-l o)) (setq ol (bw-l o)))
351 (when (> ot (bw-t o)) (setq ot (bw-t o)))
352 (when (< or (bw-r o)) (setq or (bw-r o)))
353 (when (< ob (bw-b o)) (setq ob (bw-b o))))
354 (setq obj (delq 'l obj))
355 (setq obj (delq 't obj))
356 (setq obj (delq 'r obj))
357 (setq obj (delq 'b obj))
358 (add-to-list 'obj (cons 'l ol))
359 (add-to-list 'obj (cons 't ot))
360 (add-to-list 'obj (cons 'r or))
361 (add-to-list 'obj (cons 'b ob))
362 ))
363 obj)
364
365;;; Balance windows
366
7017d254 367(defun balance-windows (&optional window-or-frame)
614b38a9
EZ
368 "Make windows the same heights or widths in window split subtrees.
369
370When called non-interactively WINDOW-OR-FRAME may be either a
7017d254
JB
371window or a frame. It then balances the windows on the implied
372frame. If the parameter is a window only the corresponding window
614b38a9 373subtree is balanced."
a2535589 374 (interactive)
614b38a9
EZ
375 (let (
376 (wt (bw-get-tree window-or-frame))
377 (w)
378 (h)
379 (tried-sizes)
380 (last-sizes)
381 (windows (window-list nil 0))
382 (counter 0))
383 (when wt
384 (while (not (member last-sizes tried-sizes))
385 (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
7017d254 386 (setq last-sizes (mapcar (lambda (w)
614b38a9
EZ
387 (window-edges w))
388 windows))
389 (when (eq 'hor (bw-dir wt))
390 (setq w (- (bw-r wt) (bw-l wt))))
391 (when (eq 'ver (bw-dir wt))
392 (setq h (- (bw-b wt) (bw-t wt))))
393 (bw-balance-sub wt w h)))))
394
7017d254 395(defun bw-adjust-window (window delta horizontal)
614b38a9
EZ
396 "Wrapper around `adjust-window-trailing-edge' with error checking.
397Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
398 (condition-case err
399 (adjust-window-trailing-edge window delta horizontal)
400 (error
401 ;;(message "adjust: %s" (error-message-string err))
402 )))
403
7017d254 404(defun bw-balance-sub (wt w h)
614b38a9
EZ
405 (setq wt (bw-refresh-edges wt))
406 (unless w (setq w (- (bw-r wt) (bw-l wt))))
407 (unless h (setq h (- (bw-b wt) (bw-t wt))))
408 (if (windowp wt)
409 (progn
410 (when w
411 (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
412 (when (/= 0 dw)
413 (bw-adjust-window wt dw t))))
414 (when h
415 (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
416 (when (/= 0 dh)
417 (bw-adjust-window wt dh nil)))))
418 (let* ((childs (cdr (assq 'childs wt)))
419 (lastchild (car (last childs)))
420 (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
421 (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
422 (dolist (c childs)
423 (bw-balance-sub c cw ch)))))
424
425;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82e6d8cb 426\f
4a4accf7 427;; I think this should be the default; I think people will prefer it--rms.
30e19aee 428(defcustom split-window-keep-point t
90dc1922
LT
429 "*If non-nil, \\[split-window-vertically] keeps the original point \
430in both children.
7162c5c4
RS
431This is often more convenient for editing.
432If nil, adjust point in each of the two windows to minimize redisplay.
90dc1922
LT
433This is convenient on slow terminals, but point can move strangely.
434
435This option applies only to `split-window-vertically' and
436functions that call it. `split-window' always keeps the original
7017d254 437point in both children."
30e19aee
RS
438 :type 'boolean
439 :group 'windows)
8e4b71d8 440
a2535589
JA
441(defun split-window-vertically (&optional arg)
442 "Split current window into two windows, one above the other.
c65c1681 443The uppermost window gets ARG lines and the other gets the rest.
90dc1922 444Negative ARG means select the size of the lowermost window instead.
c65c1681
RS
445With no argument, split equally or close to it.
446Both windows display the same buffer now current.
c65c1681 447
3e9890d1 448If the variable `split-window-keep-point' is non-nil, both new windows
8e4b71d8 449will get the same value of point as the current window. This is often
90dc1922 450more convenient for editing. The upper window is the selected window.
8e4b71d8 451
90dc1922 452Otherwise, we choose window starts so as to minimize the amount of
8e4b71d8
JB
453redisplay; this is convenient on slow terminals. The new selected
454window is the one that the current value of point appears in. The
455value of point can change if the text around point is hidden by the
90dc1922
LT
456new mode line.
457
458Regardless of the value of `split-window-keep-point', the upper
459window is the original one and the return value is the new, lower
460window."
a2535589
JA
461 (interactive "P")
462 (let ((old-w (selected-window))
c65c1681 463 (old-point (point))
ab94bf9f 464 (size (and arg (prefix-numeric-value arg)))
4464514e
RS
465 (window-full-p nil)
466 new-w bottom switch moved)
ab94bf9f
KH
467 (and size (< size 0) (setq size (+ (window-height) size)))
468 (setq new-w (split-window nil size))
7d7f1f33 469 (or split-window-keep-point
c65c1681 470 (progn
8e4b71d8
JB
471 (save-excursion
472 (set-buffer (window-buffer))
473 (goto-char (window-start))
4464514e 474 (setq moved (vertical-motion (window-height)))
8e4b71d8
JB
475 (set-window-start new-w (point))
476 (if (> (point) (window-point new-w))
477 (set-window-point new-w (point)))
4464514e
RS
478 (and (= moved (window-height))
479 (progn
480 (setq window-full-p t)
481 (vertical-motion -1)))
482 (setq bottom (point)))
483 (and window-full-p
484 (<= bottom (point))
485 (set-window-point old-w (1- bottom)))
486 (and window-full-p
487 (<= (window-start new-w) old-point)
488 (progn
489 (set-window-point new-w old-point)
490 (select-window new-w)))))
c361280d
RS
491 (split-window-save-restore-data new-w old-w)))
492
3d2f23d9
RS
493;; This is to avoid compiler warnings.
494(defvar view-return-to-alist)
495
c361280d 496(defun split-window-save-restore-data (new-w old-w)
4a4accf7 497 (with-current-buffer (window-buffer)
c361280d
RS
498 (if view-mode
499 (let ((old-info (assq old-w view-return-to-alist)))
6b3b4dbb
RS
500 (if old-info
501 (push (cons new-w (cons (car (cdr old-info)) t))
502 view-return-to-alist))))
2ed3f64c 503 new-w))
a2535589
JA
504
505(defun split-window-horizontally (&optional arg)
506 "Split current window into two windows side by side.
0ef2c2f2 507This window becomes the leftmost of the two, and gets ARG columns.
90dc1922 508Negative ARG means select the size of the rightmost window instead.
dd1455c2
RS
509The argument includes the width of the window's scroll bar; if there
510are no scroll bars, it includes the width of the divider column
90dc1922
LT
511to the window's right, if any. No ARG means split equally.
512
513The original, leftmost window remains selected.
514The return value is the new, rightmost window."
a2535589 515 (interactive "P")
c361280d
RS
516 (let ((old-w (selected-window))
517 (size (and arg (prefix-numeric-value arg))))
0ef2c2f2
KH
518 (and size (< size 0)
519 (setq size (+ (window-width) size)))
c361280d 520 (split-window-save-restore-data (split-window nil size t) old-w)))
361691dc
MB
521
522\f
361691dc
MB
523(defun set-window-text-height (window height)
524 "Sets the height in lines of the text display area of WINDOW to HEIGHT.
525This doesn't include the mode-line (or header-line if any) or any
526partial-height lines in the text display area.
527
528If WINDOW is nil, the selected window is used.
361691dc
MB
529
530Note that the current implementation of this function cannot always set
531the height exactly, but attempts to be conservative, by allocating more
532lines than are actually needed in the case where some error may be present."
533 (let ((delta (- height (window-text-height window))))
534 (unless (zerop delta)
38f99c27
MB
535 (let ((window-min-height 1))
536 (if (and window (not (eq window (selected-window))))
537 (save-selected-window
538 (select-window window)
539 (enlarge-window delta))
540 (enlarge-window delta))))))
361691dc 541
8075a110 542\f
a2535589
JA
543(defun enlarge-window-horizontally (arg)
544 "Make current window ARG columns wider."
545 (interactive "p")
546 (enlarge-window arg t))
547
548(defun shrink-window-horizontally (arg)
549 "Make current window ARG columns narrower."
550 (interactive "p")
551 (shrink-window arg t))
552
3b134005
RS
553(defun window-buffer-height (window)
554 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
ba96f392
SM
555 (with-current-buffer (window-buffer window)
556 (max 1
557 (count-screen-lines (point-min) (point-max)
558 ;; If buffer ends with a newline, ignore it when
559 ;; counting height unless point is after it.
560 (eobp)
561 window))))
3b134005 562
c16c855b
GM
563(defun count-screen-lines (&optional beg end count-final-newline window)
564 "Return the number of screen lines in the region.
565The number of screen lines may be different from the number of actual lines,
566due to line breaking, display table, etc.
567
568Optional arguments BEG and END default to `point-min' and `point-max'
569respectively.
570
fe7a0e7d 571If region ends with a newline, ignore it unless optional third argument
c16c855b
GM
572COUNT-FINAL-NEWLINE is non-nil.
573
574The optional fourth argument WINDOW specifies the window used for obtaining
fe7a0e7d 575parameters such as width, horizontal scrolling, and so on. The default is
c16c855b
GM
576to use the selected window's parameters.
577
578Like `vertical-motion', `count-screen-lines' always uses the current buffer,
fe7a0e7d 579regardless of which buffer is displayed in WINDOW. This makes possible to use
c16c855b
GM
580`count-screen-lines' in any buffer, whether or not it is currently displayed
581in some window."
582 (unless beg
583 (setq beg (point-min)))
584 (unless end
585 (setq end (point-max)))
586 (if (= beg end)
587 0
588 (save-excursion
589 (save-restriction
590 (widen)
591 (narrow-to-region (min beg end)
592 (if (and (not count-final-newline)
593 (= ?\n (char-before (max beg end))))
594 (1- (max beg end))
595 (max beg end)))
596 (goto-char (point-min))
597 (1+ (vertical-motion (buffer-size) window))))))
598
65e742bd
MB
599(defun fit-window-to-buffer (&optional window max-height min-height)
600 "Make WINDOW the right size to display its contents exactly.
119171dd 601If WINDOW is omitted or nil, it defaults to the selected window.
65e742bd
MB
602If the optional argument MAX-HEIGHT is supplied, it is the maximum height
603 the window is allowed to be, defaulting to the frame height.
604If the optional argument MIN-HEIGHT is supplied, it is the minimum
605 height the window is allowed to be, defaulting to `window-min-height'.
606
607The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or
608header-line."
609 (interactive)
610
611 (when (null window)
612 (setq window (selected-window)))
3511cde8
MB
613 (when (null max-height)
614 (setq max-height (frame-height (window-frame window))))
65e742bd 615
88f0a1eb
MB
616 (let* ((buf
617 ;; Buffer that is displayed in WINDOW
618 (window-buffer window))
619 (window-height
65e742bd
MB
620 ;; The current height of WINDOW
621 (window-height window))
88f0a1eb 622 (desired-height
65e742bd
MB
623 ;; The height necessary to show the buffer displayed by WINDOW
624 ;; (`count-screen-lines' always works on the current buffer).
88f0a1eb
MB
625 (with-current-buffer buf
626 (+ (count-screen-lines)
b1491763
KH
627 ;; If the buffer is empty, (count-screen-lines) is
628 ;; zero. But, even in that case, we need one text line
629 ;; for cursor.
630 (if (= (point-min) (point-max))
631 1 0)
88f0a1eb
MB
632 ;; For non-minibuffers, count the mode-line, if any
633 (if (and (not (window-minibuffer-p window))
634 mode-line-format)
635 1 0)
636 ;; Count the header-line, if any
637 (if header-line-format 1 0))))
65e742bd
MB
638 (delta
639 ;; Calculate how much the window height has to change to show
88f0a1eb
MB
640 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
641 (- (max (min desired-height max-height)
65e742bd
MB
642 (or min-height window-min-height))
643 window-height))
644 ;; We do our own height checking, so avoid any restrictions due to
645 ;; window-min-height.
646 (window-min-height 1))
647
648 ;; Don't try to redisplay with the cursor at the end
649 ;; on its own line--that would force a scroll and spoil things.
88f0a1eb
MB
650 (when (with-current-buffer buf
651 (and (eobp) (bolp) (not (bobp))))
652 (set-window-point window (1- (window-point window))))
653
654 (save-selected-window
655 (select-window window)
656
657 ;; Adjust WINDOW to the nominally correct size (which may actually
658 ;; be slightly off because of variable height text, etc).
659 (unless (zerop delta)
660 (enlarge-window delta))
661
662 ;; Check if the last line is surely fully visible. If not,
663 ;; enlarge the window.
664 (let ((end (with-current-buffer buf
665 (save-excursion
666 (goto-char (point-max))
45450dd5
MB
667 (when (and (bolp) (not (bobp)))
668 ;; Don't include final newline
669 (backward-char 1))
670 (when truncate-lines
671 ;; If line-wrapping is turned off, test the
672 ;; beginning of the last line for visibility
673 ;; instead of the end, as the end of the line
674 ;; could be invisible by virtue of extending past
675 ;; the edge of the window.
676 (forward-line 0))
677 (point)))))
88f0a1eb
MB
678 (set-window-vscroll window 0)
679 (while (and (< desired-height max-height)
680 (= desired-height (window-height window))
df0677c3 681 (not (pos-visible-in-window-p end window)))
88f0a1eb 682 (enlarge-window 1)
edb08287 683 (setq desired-height (1+ desired-height)))))))
65e742bd 684
a0900d9f 685(defun shrink-window-if-larger-than-buffer (&optional window)
d0bee390 686 "Shrink the WINDOW to be as small as possible to display its contents.
119171dd 687If WINDOW is omitted or nil, it defaults to the selected window.
30f2e5cc 688Do not shrink to less than `window-min-height' lines.
d0bee390 689Do nothing if the buffer contains more lines than the present window height,
3eb217a0 690or if some of the window's contents are scrolled out of view,
fd8529d0 691or if shrinking this window would also shrink another window,
18fde850 692or if the window is the only window of its frame."
d0bee390 693 (interactive)
65e742bd
MB
694 (when (null window)
695 (setq window (selected-window)))
696 (let* ((frame (window-frame window))
697 (mini (frame-parameter frame 'minibuffer))
698 (edges (window-edges window)))
699 (if (and (not (eq window (frame-root-window frame)))
fe7a0e7d 700 (window-safely-shrinkable-p)
65e742bd
MB
701 (pos-visible-in-window-p (point-min) window)
702 (not (eq mini 'only))
703 (or (not mini)
f92c5e7d
GM
704 (let ((mini-window (minibuffer-window frame)))
705 (or (null mini-window)
706 (not (eq frame (window-frame mini-window)))
707 (< (nth 3 edges)
708 (nth 1 (window-edges mini-window)))
f1180544 709 (> (nth 1 edges)
f92c5e7d 710 (frame-parameter frame 'menu-bar-lines))))))
65e742bd 711 (fit-window-to-buffer window (window-height window)))))
b691df0c
RS
712
713(defun kill-buffer-and-window ()
714 "Kill the current buffer and delete the selected window."
715 (interactive)
0f790c74
RS
716 (let ((window-to-delete (selected-window))
717 (delete-window-hook (lambda ()
718 (condition-case nil
719 (delete-window)
720 (error nil)))))
721 (add-hook 'kill-buffer-hook delete-window-hook t t)
722 (if (kill-buffer (current-buffer))
723 ;; If `delete-window' failed before, we rerun it to regenerate
724 ;; the error so it can be seen in the minibuffer.
725 (when (eq (selected-window) window-to-delete)
726 (delete-window))
727 (remove-hook 'kill-buffer-hook delete-window-hook t))))
b691df0c 728
3d2f23d9
RS
729(defun quit-window (&optional kill window)
730 "Quit the current buffer. Bury it, and maybe delete the selected frame.
18fde850 731\(The frame is deleted if it contains a dedicated window for the buffer.)
3d2f23d9
RS
732With a prefix argument, kill the buffer instead.
733
734Noninteractively, if KILL is non-nil, then kill the current buffer,
735otherwise bury it.
736
737If WINDOW is non-nil, it specifies a window; we delete that window,
738and the buffer that is killed or buried is the one in that window."
739 (interactive "P")
740 (let ((buffer (window-buffer window))
c81845b6 741 (frame (window-frame (or window (selected-window))))
3d2f23d9
RS
742 (window-solitary
743 (save-selected-window
744 (if window
745 (select-window window))
746 (one-window-p t)))
747 window-handled)
748
749 (save-selected-window
750 (if window
751 (select-window window))
eed1360c
RS
752 (or (window-minibuffer-p)
753 (window-dedicated-p (selected-window))
754 (switch-to-buffer (other-buffer))))
3d2f23d9
RS
755
756 ;; Get rid of the frame, if it has just one dedicated window
757 ;; and other visible frames exist.
eed1360c 758 (and (or (window-minibuffer-p) (window-dedicated-p window))
3d2f23d9
RS
759 (delq frame (visible-frame-list))
760 window-solitary
761 (if (and (eq default-minibuffer-frame frame)
762 (= 1 (length (minibuffer-frame-list))))
763 (setq window nil)
764 (delete-frame frame)
765 (setq window-handled t)))
766
767 ;; Deal with the buffer.
768 (if kill
769 (kill-buffer buffer)
770 (bury-buffer buffer))
771
772 ;; Maybe get rid of the window.
773 (and window (not window-handled) (not window-solitary)
774 (delete-window window))))
775
aa8d5134
PJ
776(defun handle-select-window (event)
777 "Handle select-window events."
778 (interactive "e")
779 (let ((window (posn-window (event-start event))))
4a4accf7 780 (if (and (window-live-p window)
66c226bf
SM
781 ;; Don't switch if we're currently in the minibuffer.
782 ;; This tries to work around problems where the minibuffer gets
783 ;; unselected unexpectedly, and where you then have to move
784 ;; your mouse all the way down to the minibuffer to select it.
785 (not (window-minibuffer-p (selected-window)))
786 ;; Don't switch to a minibuffer window unless it's active.
4a4accf7
SM
787 (or (not (window-minibuffer-p window))
788 (minibuffer-window-active-p window)))
aa8d5134
PJ
789 (select-window window))))
790
a2535589 791(define-key ctl-x-map "2" 'split-window-vertically)
492878e4 792(define-key ctl-x-map "3" 'split-window-horizontally)
a2535589
JA
793(define-key ctl-x-map "}" 'enlarge-window-horizontally)
794(define-key ctl-x-map "{" 'shrink-window-horizontally)
a0900d9f
ER
795(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
796(define-key ctl-x-map "+" 'balance-windows)
b691df0c 797(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
76d7458e 798
66c226bf 799;; arch-tag: b508dfcc-c353-4c37-89fa-e773fe10cea9
fe7a0e7d 800;;; window.el ends here