(tramp-perl-encode, tramp-perl-decode): Update copyrights.
[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,
d7a0267c 4;; 2003, 2004, 2005, 2006, 2007 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)))
114b3e94
EZ
249 (when subtree
250 (if (integerp subtree)
251 nil
252 (bw-get-tree-1 subtree)))))
614b38a9
EZ
253
254(defun bw-get-tree-1 (split)
255 (if (windowp split)
256 split
257 (let ((dir (car split))
258 (edges (car (cdr split)))
259 (childs (cdr (cdr split))))
260 (list
261 (cons 'dir (if dir 'ver 'hor))
262 (cons 'b (nth 3 edges))
263 (cons 'r (nth 2 edges))
264 (cons 't (nth 1 edges))
265 (cons 'l (nth 0 edges))
266 (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
267
268(defun bw-find-tree-sub (window-or-frame &optional get-parent)
269 (let* ((window (when (windowp window-or-frame) window-or-frame))
270 (frame (when (windowp window) (window-frame window)))
271 (wt (car (window-tree frame))))
272 (when (< 1 (length (window-list frame 0)))
273 (if window
274 (bw-find-tree-sub-1 wt window get-parent)
275 wt))))
276
277(defun bw-find-tree-sub-1 (tree win &optional get-parent)
278 (unless (windowp win) (error "Not a window: %s" win))
279 (if (memq win tree)
280 (if get-parent
281 get-parent
282 tree)
283 (let ((childs (cdr (cdr tree)))
284 child
285 subtree)
286 (while (and childs (not subtree))
287 (setq child (car childs))
288 (setq childs (cdr childs))
289 (when (and child (listp child))
290 (setq subtree (bw-find-tree-sub-1 child win get-parent))))
291 (if (integerp subtree)
292 (progn
293 (if (= 1 subtree)
294 tree
295 (1- subtree)))
296 subtree
297 ))))
298
299;;; Window or object edges
300
7017d254 301(defun bw-l (obj)
614b38a9
EZ
302 "Left edge of OBJ."
303 (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
7017d254 304(defun bw-t (obj)
614b38a9
EZ
305 "Top edge of OBJ."
306 (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
7017d254 307(defun bw-r (obj)
614b38a9
EZ
308 "Right edge of OBJ."
309 (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
7017d254 310(defun bw-b (obj)
614b38a9
EZ
311 "Bottom edge of OBJ."
312 (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
313
314;;; Split directions
315
7017d254 316(defun bw-dir (obj)
614b38a9 317 "Return window split tree direction if OBJ.
7017d254 318If OBJ is a window return 'both. If it is a window split tree
614b38a9
EZ
319then return its direction."
320 (if (symbolp obj)
321 obj
322 (if (windowp obj)
323 'both
324 (let ((dir (cdr (assq 'dir obj))))
325 (unless (memq dir '(hor ver both))
326 (error "Can't find dir in %s" obj))
327 dir))))
328
7017d254 329(defun bw-eqdir (obj1 obj2)
614b38a9
EZ
330 "Return t if window split tree directions are equal.
331OBJ1 and OBJ2 should be either windows or window split trees in
7017d254 332our format. The directions returned by `bw-dir' are compared and
614b38a9
EZ
333t is returned if they are `eq' or one of them is 'both."
334 (let ((dir1 (bw-dir obj1))
335 (dir2 (bw-dir obj2)))
336 (or (eq dir1 dir2)
337 (eq dir1 'both)
338 (eq dir2 'both))))
339
340;;; Building split tree
341
7017d254 342(defun bw-refresh-edges (obj)
614b38a9
EZ
343 "Refresh the edge information of OBJ and return OBJ."
344 (unless (windowp obj)
345 (let ((childs (cdr (assq 'childs obj)))
346 (ol 1000)
347 (ot 1000)
348 (or -1)
349 (ob -1))
350 (dolist (o childs)
351 (when (> ol (bw-l o)) (setq ol (bw-l o)))
352 (when (> ot (bw-t o)) (setq ot (bw-t o)))
353 (when (< or (bw-r o)) (setq or (bw-r o)))
354 (when (< ob (bw-b o)) (setq ob (bw-b o))))
355 (setq obj (delq 'l obj))
356 (setq obj (delq 't obj))
357 (setq obj (delq 'r obj))
358 (setq obj (delq 'b obj))
359 (add-to-list 'obj (cons 'l ol))
360 (add-to-list 'obj (cons 't ot))
361 (add-to-list 'obj (cons 'r or))
362 (add-to-list 'obj (cons 'b ob))
363 ))
364 obj)
365
366;;; Balance windows
367
7017d254 368(defun balance-windows (&optional window-or-frame)
614b38a9
EZ
369 "Make windows the same heights or widths in window split subtrees.
370
371When called non-interactively WINDOW-OR-FRAME may be either a
7017d254
JB
372window or a frame. It then balances the windows on the implied
373frame. If the parameter is a window only the corresponding window
614b38a9 374subtree is balanced."
a2535589 375 (interactive)
614b38a9
EZ
376 (let (
377 (wt (bw-get-tree window-or-frame))
378 (w)
379 (h)
380 (tried-sizes)
381 (last-sizes)
382 (windows (window-list nil 0))
383 (counter 0))
384 (when wt
385 (while (not (member last-sizes tried-sizes))
386 (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
7017d254 387 (setq last-sizes (mapcar (lambda (w)
614b38a9
EZ
388 (window-edges w))
389 windows))
390 (when (eq 'hor (bw-dir wt))
391 (setq w (- (bw-r wt) (bw-l wt))))
392 (when (eq 'ver (bw-dir wt))
393 (setq h (- (bw-b wt) (bw-t wt))))
394 (bw-balance-sub wt w h)))))
395
7017d254 396(defun bw-adjust-window (window delta horizontal)
614b38a9
EZ
397 "Wrapper around `adjust-window-trailing-edge' with error checking.
398Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
399 (condition-case err
400 (adjust-window-trailing-edge window delta horizontal)
401 (error
402 ;;(message "adjust: %s" (error-message-string err))
403 )))
404
7017d254 405(defun bw-balance-sub (wt w h)
614b38a9
EZ
406 (setq wt (bw-refresh-edges wt))
407 (unless w (setq w (- (bw-r wt) (bw-l wt))))
408 (unless h (setq h (- (bw-b wt) (bw-t wt))))
409 (if (windowp wt)
410 (progn
411 (when w
412 (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
413 (when (/= 0 dw)
414 (bw-adjust-window wt dw t))))
415 (when h
416 (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
417 (when (/= 0 dh)
418 (bw-adjust-window wt dh nil)))))
419 (let* ((childs (cdr (assq 'childs wt)))
420 (lastchild (car (last childs)))
421 (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
422 (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
423 (dolist (c childs)
424 (bw-balance-sub c cw ch)))))
425
426;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
82e6d8cb 427\f
4a4accf7 428;; I think this should be the default; I think people will prefer it--rms.
30e19aee 429(defcustom split-window-keep-point t
90dc1922
LT
430 "*If non-nil, \\[split-window-vertically] keeps the original point \
431in both children.
7162c5c4
RS
432This is often more convenient for editing.
433If nil, adjust point in each of the two windows to minimize redisplay.
90dc1922
LT
434This is convenient on slow terminals, but point can move strangely.
435
436This option applies only to `split-window-vertically' and
437functions that call it. `split-window' always keeps the original
7017d254 438point in both children."
30e19aee
RS
439 :type 'boolean
440 :group 'windows)
8e4b71d8 441
a2535589
JA
442(defun split-window-vertically (&optional arg)
443 "Split current window into two windows, one above the other.
c65c1681 444The uppermost window gets ARG lines and the other gets the rest.
90dc1922 445Negative ARG means select the size of the lowermost window instead.
c65c1681
RS
446With no argument, split equally or close to it.
447Both windows display the same buffer now current.
c65c1681 448
3e9890d1 449If the variable `split-window-keep-point' is non-nil, both new windows
8e4b71d8 450will get the same value of point as the current window. This is often
90dc1922 451more convenient for editing. The upper window is the selected window.
8e4b71d8 452
90dc1922 453Otherwise, we choose window starts so as to minimize the amount of
8e4b71d8
JB
454redisplay; this is convenient on slow terminals. The new selected
455window is the one that the current value of point appears in. The
456value of point can change if the text around point is hidden by the
90dc1922
LT
457new mode line.
458
459Regardless of the value of `split-window-keep-point', the upper
460window is the original one and the return value is the new, lower
461window."
a2535589
JA
462 (interactive "P")
463 (let ((old-w (selected-window))
c65c1681 464 (old-point (point))
ab94bf9f 465 (size (and arg (prefix-numeric-value arg)))
4464514e
RS
466 (window-full-p nil)
467 new-w bottom switch moved)
ab94bf9f
KH
468 (and size (< size 0) (setq size (+ (window-height) size)))
469 (setq new-w (split-window nil size))
7d7f1f33 470 (or split-window-keep-point
c65c1681 471 (progn
8e4b71d8
JB
472 (save-excursion
473 (set-buffer (window-buffer))
474 (goto-char (window-start))
4464514e 475 (setq moved (vertical-motion (window-height)))
8e4b71d8
JB
476 (set-window-start new-w (point))
477 (if (> (point) (window-point new-w))
478 (set-window-point new-w (point)))
4464514e
RS
479 (and (= moved (window-height))
480 (progn
481 (setq window-full-p t)
482 (vertical-motion -1)))
483 (setq bottom (point)))
484 (and window-full-p
485 (<= bottom (point))
486 (set-window-point old-w (1- bottom)))
487 (and window-full-p
488 (<= (window-start new-w) old-point)
489 (progn
490 (set-window-point new-w old-point)
491 (select-window new-w)))))
c361280d
RS
492 (split-window-save-restore-data new-w old-w)))
493
3d2f23d9
RS
494;; This is to avoid compiler warnings.
495(defvar view-return-to-alist)
496
c361280d 497(defun split-window-save-restore-data (new-w old-w)
4a4accf7 498 (with-current-buffer (window-buffer)
c361280d
RS
499 (if view-mode
500 (let ((old-info (assq old-w view-return-to-alist)))
6b3b4dbb
RS
501 (if old-info
502 (push (cons new-w (cons (car (cdr old-info)) t))
503 view-return-to-alist))))
2ed3f64c 504 new-w))
a2535589
JA
505
506(defun split-window-horizontally (&optional arg)
507 "Split current window into two windows side by side.
0ef2c2f2 508This window becomes the leftmost of the two, and gets ARG columns.
90dc1922 509Negative ARG means select the size of the rightmost window instead.
dd1455c2
RS
510The argument includes the width of the window's scroll bar; if there
511are no scroll bars, it includes the width of the divider column
90dc1922
LT
512to the window's right, if any. No ARG means split equally.
513
514The original, leftmost window remains selected.
515The return value is the new, rightmost window."
a2535589 516 (interactive "P")
c361280d
RS
517 (let ((old-w (selected-window))
518 (size (and arg (prefix-numeric-value arg))))
0ef2c2f2
KH
519 (and size (< size 0)
520 (setq size (+ (window-width) size)))
c361280d 521 (split-window-save-restore-data (split-window nil size t) old-w)))
361691dc
MB
522
523\f
361691dc
MB
524(defun set-window-text-height (window height)
525 "Sets the height in lines of the text display area of WINDOW to HEIGHT.
526This doesn't include the mode-line (or header-line if any) or any
527partial-height lines in the text display area.
528
529If WINDOW is nil, the selected window is used.
361691dc
MB
530
531Note that the current implementation of this function cannot always set
532the height exactly, but attempts to be conservative, by allocating more
533lines than are actually needed in the case where some error may be present."
534 (let ((delta (- height (window-text-height window))))
535 (unless (zerop delta)
5937a3fd
SM
536 ;; Setting window-min-height to a value like 1 can lead to very
537 ;; bizarre displays because it also allows Emacs to make *other*
538 ;; windows 1-line tall, which means that there's no more space for
539 ;; the modeline.
540 (let ((window-min-height (min 2 height))) ;One text line plus a modeline.
38f99c27
MB
541 (if (and window (not (eq window (selected-window))))
542 (save-selected-window
543 (select-window window)
544 (enlarge-window delta))
545 (enlarge-window delta))))))
361691dc 546
8075a110 547\f
a2535589
JA
548(defun enlarge-window-horizontally (arg)
549 "Make current window ARG columns wider."
550 (interactive "p")
551 (enlarge-window arg t))
552
553(defun shrink-window-horizontally (arg)
554 "Make current window ARG columns narrower."
555 (interactive "p")
556 (shrink-window arg t))
557
3b134005
RS
558(defun window-buffer-height (window)
559 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
ba96f392
SM
560 (with-current-buffer (window-buffer window)
561 (max 1
562 (count-screen-lines (point-min) (point-max)
563 ;; If buffer ends with a newline, ignore it when
564 ;; counting height unless point is after it.
565 (eobp)
566 window))))
3b134005 567
c16c855b
GM
568(defun count-screen-lines (&optional beg end count-final-newline window)
569 "Return the number of screen lines in the region.
570The number of screen lines may be different from the number of actual lines,
571due to line breaking, display table, etc.
572
573Optional arguments BEG and END default to `point-min' and `point-max'
574respectively.
575
fe7a0e7d 576If region ends with a newline, ignore it unless optional third argument
c16c855b
GM
577COUNT-FINAL-NEWLINE is non-nil.
578
579The optional fourth argument WINDOW specifies the window used for obtaining
fe7a0e7d 580parameters such as width, horizontal scrolling, and so on. The default is
c16c855b
GM
581to use the selected window's parameters.
582
583Like `vertical-motion', `count-screen-lines' always uses the current buffer,
fe7a0e7d 584regardless of which buffer is displayed in WINDOW. This makes possible to use
c16c855b
GM
585`count-screen-lines' in any buffer, whether or not it is currently displayed
586in some window."
587 (unless beg
588 (setq beg (point-min)))
589 (unless end
590 (setq end (point-max)))
591 (if (= beg end)
592 0
593 (save-excursion
594 (save-restriction
595 (widen)
596 (narrow-to-region (min beg end)
597 (if (and (not count-final-newline)
598 (= ?\n (char-before (max beg end))))
599 (1- (max beg end))
600 (max beg end)))
601 (goto-char (point-min))
602 (1+ (vertical-motion (buffer-size) window))))))
603
65e742bd 604(defun fit-window-to-buffer (&optional window max-height min-height)
1cce8267 605 "Make WINDOW the right height to display its contents exactly.
119171dd 606If WINDOW is omitted or nil, it defaults to the selected window.
65e742bd
MB
607If the optional argument MAX-HEIGHT is supplied, it is the maximum height
608 the window is allowed to be, defaulting to the frame height.
609If the optional argument MIN-HEIGHT is supplied, it is the minimum
610 height the window is allowed to be, defaulting to `window-min-height'.
611
612The heights in MAX-HEIGHT and MIN-HEIGHT include the mode-line and/or
613header-line."
614 (interactive)
615
616 (when (null window)
617 (setq window (selected-window)))
3511cde8
MB
618 (when (null max-height)
619 (setq max-height (frame-height (window-frame window))))
65e742bd 620
88f0a1eb
MB
621 (let* ((buf
622 ;; Buffer that is displayed in WINDOW
623 (window-buffer window))
624 (window-height
65e742bd
MB
625 ;; The current height of WINDOW
626 (window-height window))
88f0a1eb 627 (desired-height
65e742bd
MB
628 ;; The height necessary to show the buffer displayed by WINDOW
629 ;; (`count-screen-lines' always works on the current buffer).
88f0a1eb
MB
630 (with-current-buffer buf
631 (+ (count-screen-lines)
b1491763
KH
632 ;; If the buffer is empty, (count-screen-lines) is
633 ;; zero. But, even in that case, we need one text line
634 ;; for cursor.
635 (if (= (point-min) (point-max))
636 1 0)
88f0a1eb
MB
637 ;; For non-minibuffers, count the mode-line, if any
638 (if (and (not (window-minibuffer-p window))
639 mode-line-format)
640 1 0)
641 ;; Count the header-line, if any
642 (if header-line-format 1 0))))
65e742bd
MB
643 (delta
644 ;; Calculate how much the window height has to change to show
88f0a1eb
MB
645 ;; desired-height lines, constrained by MIN-HEIGHT and MAX-HEIGHT.
646 (- (max (min desired-height max-height)
65e742bd
MB
647 (or min-height window-min-height))
648 window-height))
649 ;; We do our own height checking, so avoid any restrictions due to
650 ;; window-min-height.
651 (window-min-height 1))
652
653 ;; Don't try to redisplay with the cursor at the end
654 ;; on its own line--that would force a scroll and spoil things.
88f0a1eb
MB
655 (when (with-current-buffer buf
656 (and (eobp) (bolp) (not (bobp))))
657 (set-window-point window (1- (window-point window))))
658
659 (save-selected-window
660 (select-window window)
661
662 ;; Adjust WINDOW to the nominally correct size (which may actually
663 ;; be slightly off because of variable height text, etc).
664 (unless (zerop delta)
665 (enlarge-window delta))
666
667 ;; Check if the last line is surely fully visible. If not,
668 ;; enlarge the window.
669 (let ((end (with-current-buffer buf
670 (save-excursion
671 (goto-char (point-max))
45450dd5
MB
672 (when (and (bolp) (not (bobp)))
673 ;; Don't include final newline
674 (backward-char 1))
675 (when truncate-lines
676 ;; If line-wrapping is turned off, test the
677 ;; beginning of the last line for visibility
678 ;; instead of the end, as the end of the line
679 ;; could be invisible by virtue of extending past
680 ;; the edge of the window.
681 (forward-line 0))
682 (point)))))
88f0a1eb
MB
683 (set-window-vscroll window 0)
684 (while (and (< desired-height max-height)
685 (= desired-height (window-height window))
df0677c3 686 (not (pos-visible-in-window-p end window)))
88f0a1eb 687 (enlarge-window 1)
edb08287 688 (setq desired-height (1+ desired-height)))))))
65e742bd 689
a0900d9f 690(defun shrink-window-if-larger-than-buffer (&optional window)
d0bee390 691 "Shrink the WINDOW to be as small as possible to display its contents.
119171dd 692If WINDOW is omitted or nil, it defaults to the selected window.
30f2e5cc 693Do not shrink to less than `window-min-height' lines.
d0bee390 694Do nothing if the buffer contains more lines than the present window height,
3eb217a0 695or if some of the window's contents are scrolled out of view,
fd8529d0 696or if shrinking this window would also shrink another window,
18fde850 697or if the window is the only window of its frame."
d0bee390 698 (interactive)
65e742bd
MB
699 (when (null window)
700 (setq window (selected-window)))
701 (let* ((frame (window-frame window))
702 (mini (frame-parameter frame 'minibuffer))
703 (edges (window-edges window)))
704 (if (and (not (eq window (frame-root-window frame)))
fe7a0e7d 705 (window-safely-shrinkable-p)
65e742bd
MB
706 (pos-visible-in-window-p (point-min) window)
707 (not (eq mini 'only))
708 (or (not mini)
f92c5e7d
GM
709 (let ((mini-window (minibuffer-window frame)))
710 (or (null mini-window)
711 (not (eq frame (window-frame mini-window)))
712 (< (nth 3 edges)
713 (nth 1 (window-edges mini-window)))
f1180544 714 (> (nth 1 edges)
f92c5e7d 715 (frame-parameter frame 'menu-bar-lines))))))
65e742bd 716 (fit-window-to-buffer window (window-height window)))))
b691df0c
RS
717
718(defun kill-buffer-and-window ()
719 "Kill the current buffer and delete the selected window."
720 (interactive)
0f790c74 721 (let ((window-to-delete (selected-window))
f5da083e 722 (buffer-to-kill (current-buffer))
0f790c74
RS
723 (delete-window-hook (lambda ()
724 (condition-case nil
725 (delete-window)
726 (error nil)))))
f5da083e
DK
727 (unwind-protect
728 (progn
729 (add-hook 'kill-buffer-hook delete-window-hook t t)
730 (if (kill-buffer (current-buffer))
731 ;; If `delete-window' failed before, we rerun it to regenerate
732 ;; the error so it can be seen in the echo area.
733 (when (eq (selected-window) window-to-delete)
734 (delete-window))))
735 ;; If the buffer is not dead for some reason (probably because
736 ;; of a `quit' signal), remove the hook again.
737 (condition-case nil
738 (with-current-buffer buffer-to-kill
739 (remove-hook 'kill-buffer-hook delete-window-hook t))
740 (error nil)))))
b691df0c 741
3d2f23d9
RS
742(defun quit-window (&optional kill window)
743 "Quit the current buffer. Bury it, and maybe delete the selected frame.
18fde850 744\(The frame is deleted if it contains a dedicated window for the buffer.)
3d2f23d9
RS
745With a prefix argument, kill the buffer instead.
746
747Noninteractively, if KILL is non-nil, then kill the current buffer,
748otherwise bury it.
749
750If WINDOW is non-nil, it specifies a window; we delete that window,
751and the buffer that is killed or buried is the one in that window."
752 (interactive "P")
753 (let ((buffer (window-buffer window))
c81845b6 754 (frame (window-frame (or window (selected-window))))
3d2f23d9
RS
755 (window-solitary
756 (save-selected-window
757 (if window
758 (select-window window))
759 (one-window-p t)))
760 window-handled)
761
762 (save-selected-window
763 (if window
764 (select-window window))
eed1360c
RS
765 (or (window-minibuffer-p)
766 (window-dedicated-p (selected-window))
767 (switch-to-buffer (other-buffer))))
3d2f23d9
RS
768
769 ;; Get rid of the frame, if it has just one dedicated window
770 ;; and other visible frames exist.
eed1360c 771 (and (or (window-minibuffer-p) (window-dedicated-p window))
3d2f23d9
RS
772 (delq frame (visible-frame-list))
773 window-solitary
774 (if (and (eq default-minibuffer-frame frame)
775 (= 1 (length (minibuffer-frame-list))))
776 (setq window nil)
777 (delete-frame frame)
778 (setq window-handled t)))
779
780 ;; Deal with the buffer.
781 (if kill
782 (kill-buffer buffer)
783 (bury-buffer buffer))
784
785 ;; Maybe get rid of the window.
786 (and window (not window-handled) (not window-solitary)
787 (delete-window window))))
612c16f1
CY
788\f
789(defvar mouse-autoselect-window-timer nil
790 "Timer used by delayed window autoselection.")
791
792(defvar mouse-autoselect-window-position nil
793 "Last mouse position recorded by delayed window autoselection.")
794
795(defvar mouse-autoselect-window-window nil
796 "Last window recorded by delayed window autoselection.")
797
6a6af58e
EZ
798(defvar mouse-autoselect-window-state nil
799 "When non-nil, special state of delayed window autoselection.
800Possible values are `suspend' \(suspend autoselection after a menu or
801scrollbar interaction\) and `select' \(the next invocation of
802'handle-select-window' shall select the window immediately\).")
612c16f1
CY
803
804(defun mouse-autoselect-window-cancel (&optional force)
805 "Cancel delayed window autoselection.
806Optional argument FORCE means cancel unconditionally."
807 (unless (and (not force)
808 ;; Don't cancel while the user drags a scroll bar.
809 (eq this-command 'scroll-bar-toolkit-scroll)
810 (memq (nth 4 (event-end last-input-event))
811 '(handle end-scroll)))
6a6af58e 812 (setq mouse-autoselect-window-state nil)
612c16f1
CY
813 (when (timerp mouse-autoselect-window-timer)
814 (cancel-timer mouse-autoselect-window-timer))
815 (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
816
6a6af58e 817(defun mouse-autoselect-window-start (mouse-position &optional window suspend)
612c16f1 818 "Start delayed window autoselection.
6a6af58e
EZ
819MOUSE-POSITION is the last position where the mouse was seen as returned
820by `mouse-position'. Optional argument WINDOW non-nil denotes the
821window where the mouse was seen. Optional argument SUSPEND non-nil
822means suspend autoselection."
823 ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
824 (setq mouse-autoselect-window-position mouse-position)
825 (when window (setq mouse-autoselect-window-window window))
826 (setq mouse-autoselect-window-state (when suspend 'suspend))
827 ;; Install timer which runs `mouse-autoselect-window-select' after
612c16f1
CY
828 ;; `mouse-autoselect-window' seconds.
829 (setq mouse-autoselect-window-timer
830 (run-at-time
6a6af58e 831 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
612c16f1
CY
832
833(defun mouse-autoselect-window-select ()
834 "Select window with delayed window autoselection.
835If the mouse position has stabilized in a non-selected window, select
836that window. The minibuffer window is selected iff the minibuffer is
837active. This function is run by `mouse-autoselect-window-timer'."
838 (condition-case nil
839 (let* ((mouse-position (mouse-position))
6a6af58e
EZ
840 (window
841 (condition-case nil
842 (window-at (cadr mouse-position) (cddr mouse-position)
843 (car mouse-position))
844 (error nil))))
612c16f1 845 (cond
6a6af58e
EZ
846 ((or (menu-or-popup-active-p)
847 (and window
848 (not (coordinates-in-window-p (cdr mouse-position) window))))
849 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
850 ;; of WINDOW, temporarily suspend delayed autoselection.
851 (mouse-autoselect-window-start mouse-position nil t))
852 ((eq mouse-autoselect-window-state 'suspend)
853 ;; Delayed autoselection was temporarily suspended, reenable it.
854 (mouse-autoselect-window-start mouse-position))
612c16f1
CY
855 ((and window (not (eq window (selected-window)))
856 (or (not (numberp mouse-autoselect-window))
857 (and (> mouse-autoselect-window 0)
858 ;; If `mouse-autoselect-window' is positive, select
859 ;; window if the window is the same as before.
860 (eq window mouse-autoselect-window-window))
861 ;; Otherwise select window iff the mouse is at the same
862 ;; position as before. Observe that the first test after
6a6af58e
EZ
863 ;; starting autoselection usually fails since the value of
864 ;; `mouse-autoselect-window-position' recorded there is the
865 ;; position where the mouse has entered the new window and
866 ;; not necessarily where the mouse has stopped moving.
612c16f1
CY
867 (equal mouse-position mouse-autoselect-window-position))
868 ;; The minibuffer is a candidate window iff it's active.
869 (or (not (window-minibuffer-p window))
870 (eq window (active-minibuffer-window))))
6a6af58e
EZ
871 ;; Mouse position has stabilized in non-selected window: Cancel
872 ;; delayed autoselection and try to select that window.
612c16f1
CY
873 (mouse-autoselect-window-cancel t)
874 ;; Select window where mouse appears unless the selected window is the
875 ;; minibuffer. Use `unread-command-events' in order to execute pre-
876 ;; and post-command hooks and trigger idle timers. To avoid delaying
6a6af58e 877 ;; autoselection again, set `mouse-autoselect-window-state'."
612c16f1 878 (unless (window-minibuffer-p (selected-window))
6a6af58e 879 (setq mouse-autoselect-window-state 'select)
612c16f1
CY
880 (setq unread-command-events
881 (cons (list 'select-window (list window))
882 unread-command-events))))
883 ((or (and window (eq window (selected-window)))
884 (not (numberp mouse-autoselect-window))
885 (equal mouse-position mouse-autoselect-window-position))
886 ;; Mouse position has either stabilized in the selected window or at
6a6af58e 887 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
612c16f1
CY
888 (mouse-autoselect-window-cancel t))
889 (t
6a6af58e
EZ
890 ;; Mouse position has not stabilized yet, resume delayed
891 ;; autoselection.
892 (mouse-autoselect-window-start mouse-position window))))
612c16f1 893 (error nil)))
3d2f23d9 894
aa8d5134
PJ
895(defun handle-select-window (event)
896 "Handle select-window events."
897 (interactive "e")
898 (let ((window (posn-window (event-start event))))
612c16f1
CY
899 (when (and (window-live-p window)
900 ;; Don't switch if we're currently in the minibuffer.
901 ;; This tries to work around problems where the minibuffer gets
902 ;; unselected unexpectedly, and where you then have to move
903 ;; your mouse all the way down to the minibuffer to select it.
904 (not (window-minibuffer-p (selected-window)))
905 ;; Don't switch to a minibuffer window unless it's active.
906 (or (not (window-minibuffer-p window))
907 (minibuffer-window-active-p window)))
908 (unless (and (numberp mouse-autoselect-window)
909 (not (zerop mouse-autoselect-window))
6a6af58e
EZ
910 (not (eq mouse-autoselect-window-state 'select))
911 (progn
912 ;; Cancel any delayed autoselection.
913 (mouse-autoselect-window-cancel t)
914 ;; Start delayed autoselection from current mouse position
915 ;; and window.
916 (mouse-autoselect-window-start (mouse-position) window)
917 ;; Executing a command cancels delayed autoselection.
918 (add-hook
919 'pre-command-hook 'mouse-autoselect-window-cancel)))
920 ;; Reset state of delayed autoselection.
921 (setq mouse-autoselect-window-state nil)
612c16f1
CY
922 (when mouse-autoselect-window
923 ;; Run `mouse-leave-buffer-hook' when autoselecting window.
924 (run-hooks 'mouse-leave-buffer-hook))
925 (select-window window)))))
aa8d5134 926
a2535589 927(define-key ctl-x-map "2" 'split-window-vertically)
492878e4 928(define-key ctl-x-map "3" 'split-window-horizontally)
a2535589
JA
929(define-key ctl-x-map "}" 'enlarge-window-horizontally)
930(define-key ctl-x-map "{" 'shrink-window-horizontally)
a0900d9f
ER
931(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
932(define-key ctl-x-map "+" 'balance-windows)
b691df0c 933(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
76d7458e 934
66c226bf 935;; arch-tag: b508dfcc-c353-4c37-89fa-e773fe10cea9
fe7a0e7d 936;;; window.el ends here