* lisp/window.el (window-valid-p): Rename from window-any-p.
[bpt/emacs.git] / lisp / window.el
1 ;;; window.el --- GNU Emacs window commands aside from those written in C
2
3 ;; Copyright (C) 1985, 1989, 1992-1994, 2000-2011
4 ;; Free Software Foundation, Inc.
5
6 ;; Maintainer: FSF
7 ;; Keywords: internal
8 ;; Package: emacs
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; Window tree functions.
28
29 ;;; Code:
30
31 (eval-when-compile (require 'cl))
32
33 (defmacro save-selected-window (&rest body)
34 "Execute BODY, then select the previously selected window.
35 The value returned is the value of the last form in BODY.
36
37 This macro saves and restores the selected window, as well as the
38 selected window in each frame. If the previously selected window
39 is no longer live, then whatever window is selected at the end of
40 BODY remains selected. If the previously selected window of some
41 frame is no longer live at the end of BODY, that frame's selected
42 window is left alone.
43
44 This macro saves and restores the current buffer, since otherwise
45 its normal operation could make a different buffer current. The
46 order of recently selected windows and the buffer list ordering
47 are not altered by this macro (unless they are altered in BODY)."
48 (declare (indent 0) (debug t))
49 `(let ((save-selected-window-window (selected-window))
50 ;; It is necessary to save all of these, because calling
51 ;; select-window changes frame-selected-window for whatever
52 ;; frame that window is in.
53 (save-selected-window-alist
54 (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
55 (frame-list))))
56 (save-current-buffer
57 (unwind-protect
58 (progn ,@body)
59 (dolist (elt save-selected-window-alist)
60 (and (frame-live-p (car elt))
61 (window-live-p (cdr elt))
62 (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
63 (when (window-live-p save-selected-window-window)
64 (select-window save-selected-window-window 'norecord))))))
65
66 ;; The following two functions are like `window-next-sibling' and
67 ;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
68 ;; they don't substitute the selected window for nil), and they return
69 ;; nil when WINDOW doesn't have a parent (like a frame's root window or
70 ;; a minibuffer window).
71 (defsubst window-right (window)
72 "Return WINDOW's right sibling.
73 Return nil if WINDOW is the root window of its frame. WINDOW can
74 be any window."
75 (and window (window-parent window) (window-next-sibling window)))
76
77 (defsubst window-left (window)
78 "Return WINDOW's left sibling.
79 Return nil if WINDOW is the root window of its frame. WINDOW can
80 be any window."
81 (and window (window-parent window) (window-prev-sibling window)))
82
83 (defsubst window-child (window)
84 "Return WINDOW's first child window."
85 (or (window-top-child window) (window-left-child window)))
86
87 (defun window-child-count (window)
88 "Return number of WINDOW's child windows."
89 (let ((count 0))
90 (when (and (windowp window) (setq window (window-child window)))
91 (while window
92 (setq count (1+ count))
93 (setq window (window-next-sibling window))))
94 count))
95
96 (defun window-last-child (window)
97 "Return last child window of WINDOW."
98 (when (and (windowp window) (setq window (window-child window)))
99 (while (window-next-sibling window)
100 (setq window (window-next-sibling window))))
101 window)
102
103 (defsubst window-valid-p (object)
104 "Return t if OBJECT denotes a live window or internal window.
105 Otherwise, return nil; this includes the case where OBJECT is a
106 deleted window."
107 (and (windowp object)
108 (or (window-buffer object) (window-child object))
109 t))
110
111 (defsubst window-normalize-buffer (buffer-or-name)
112 "Return buffer specified by BUFFER-OR-NAME.
113 BUFFER-OR-NAME must be either a buffer or a string naming a live
114 buffer and defaults to the current buffer."
115 (cond
116 ((not buffer-or-name)
117 (current-buffer))
118 ((bufferp buffer-or-name)
119 (if (buffer-live-p buffer-or-name)
120 buffer-or-name
121 (error "Buffer %s is not a live buffer" buffer-or-name)))
122 ((get-buffer buffer-or-name))
123 (t
124 (error "No such buffer %s" buffer-or-name))))
125
126 (defsubst window-normalize-frame (frame)
127 "Return frame specified by FRAME.
128 FRAME must be a live frame and defaults to the selected frame."
129 (if frame
130 (if (frame-live-p frame)
131 frame
132 (error "%s is not a live frame" frame))
133 (selected-frame)))
134
135 (defsubst window-normalize-any-window (window)
136 "Return window specified by WINDOW.
137 WINDOW must be a window that has not been deleted and defaults to
138 the selected window."
139 (if window
140 (if (window-valid-p window)
141 window
142 (error "%s is not a window" window))
143 (selected-window)))
144
145 (defsubst window-normalize-live-window (window)
146 "Return live window specified by WINDOW.
147 WINDOW must be a live window and defaults to the selected one."
148 (if window
149 (if (and (windowp window) (window-buffer window))
150 window
151 (error "%s is not a live window" window))
152 (selected-window)))
153
154 (defvar ignore-window-parameters nil
155 "If non-nil, standard functions ignore window parameters.
156 The functions currently affected by this are `split-window',
157 `delete-window', `delete-other-windows' and `other-window'.
158
159 An application may bind this to a non-nil value around calls to
160 these functions to inhibit processing of window parameters.")
161
162 (defconst window-safe-min-height 1
163 "The absolute minimum number of lines of a window.
164 Anything less might crash Emacs.")
165
166 (defcustom window-min-height 4
167 "The minimum number of lines of any window.
168 The value has to accommodate a mode- or header-line if present.
169 A value less than `window-safe-min-height' is ignored. The value
170 of this variable is honored when windows are resized or split.
171
172 Applications should never rebind this variable. To resize a
173 window to a height less than the one specified here, an
174 application should instead call `window-resize' with a non-nil
175 IGNORE argument. In order to have `split-window' make a window
176 shorter, explictly specify the SIZE argument of that function."
177 :type 'integer
178 :version "24.1"
179 :group 'windows)
180
181 (defconst window-safe-min-width 2
182 "The absolute minimum number of columns of a window.
183 Anything less might crash Emacs.")
184
185 (defcustom window-min-width 10
186 "The minimum number of columns of any window.
187 The value has to accommodate margins, fringes, or scrollbars if
188 present. A value less than `window-safe-min-width' is ignored.
189 The value of this variable is honored when windows are resized or
190 split.
191
192 Applications should never rebind this variable. To resize a
193 window to a width less than the one specified here, an
194 application should instead call `window-resize' with a non-nil
195 IGNORE argument. In order to have `split-window' make a window
196 narrower, explictly specify the SIZE argument of that function."
197 :type 'integer
198 :version "24.1"
199 :group 'windows)
200
201 (defun window-combination-p (&optional window horizontal)
202 "If WINDOW is a vertical combination return WINDOW's first child.
203 WINDOW can be any window and defaults to the selected one.
204 Optional argument HORIZONTAL non-nil means return WINDOW's first
205 child if WINDOW is a horizontal combination."
206 (setq window (window-normalize-any-window window))
207 (if horizontal
208 (window-left-child window)
209 (window-top-child window)))
210
211 (defsubst window-combined-p (&optional window horizontal)
212 "Return non-nil if and only if WINDOW is vertically combined.
213 WINDOW can be any window and defaults to the selected one.
214 Optional argument HORIZONTAL non-nil means return non-nil if and
215 only if WINDOW is horizontally combined."
216 (setq window (window-normalize-any-window window))
217 (let ((parent (window-parent window)))
218 (and parent (window-combination-p parent horizontal))))
219
220 (defun window-combinations (&optional window horizontal)
221 "Return largest number of vertically arranged subwindows of WINDOW.
222 WINDOW can be any window and defaults to the selected one.
223 Optional argument HORIZONTAL non-nil means to return the largest
224 number of horizontally arranged subwindows of WINDOW."
225 (setq window (window-normalize-any-window window))
226 (cond
227 ((window-live-p window)
228 ;; If WINDOW is live, return 1.
229 1)
230 ((window-combination-p window horizontal)
231 ;; If WINDOW is iso-combined, return the sum of the values for all
232 ;; subwindows of WINDOW.
233 (let ((child (window-child window))
234 (count 0))
235 (while child
236 (setq count
237 (+ (window-combinations child horizontal)
238 count))
239 (setq child (window-right child)))
240 count))
241 (t
242 ;; If WINDOW is not iso-combined, return the maximum value of any
243 ;; subwindow of WINDOW.
244 (let ((child (window-child window))
245 (count 1))
246 (while child
247 (setq count
248 (max (window-combinations child horizontal)
249 count))
250 (setq child (window-right child)))
251 count))))
252
253 (defun walk-window-tree-1 (proc walk-window-tree-window any &optional sub-only)
254 "Helper function for `walk-window-tree' and `walk-window-subtree'."
255 (let (walk-window-tree-buffer)
256 (while walk-window-tree-window
257 (setq walk-window-tree-buffer
258 (window-buffer walk-window-tree-window))
259 (when (or walk-window-tree-buffer any)
260 (funcall proc walk-window-tree-window))
261 (unless walk-window-tree-buffer
262 (walk-window-tree-1
263 proc (window-left-child walk-window-tree-window) any)
264 (walk-window-tree-1
265 proc (window-top-child walk-window-tree-window) any))
266 (if sub-only
267 (setq walk-window-tree-window nil)
268 (setq walk-window-tree-window
269 (window-right walk-window-tree-window))))))
270
271 (defun walk-window-tree (proc &optional frame any)
272 "Run function PROC on each live window of FRAME.
273 PROC must be a function with one argument - a window. FRAME must
274 be a live frame and defaults to the selected one. ANY, if
275 non-nil means to run PROC on all live and internal windows of
276 FRAME.
277
278 This function performs a pre-order, depth-first traversal of the
279 window tree. If PROC changes the window tree, the result is
280 unpredictable."
281 (let ((walk-window-tree-frame (window-normalize-frame frame)))
282 (walk-window-tree-1
283 proc (frame-root-window walk-window-tree-frame) any)))
284
285 (defun walk-window-subtree (proc &optional window any)
286 "Run function PROC on each live subwindow of WINDOW.
287 WINDOW defaults to the selected window. PROC must be a function
288 with one argument - a window. ANY, if non-nil means to run PROC
289 on all live and internal subwindows of WINDOW.
290
291 This function performs a pre-order, depth-first traversal of the
292 window tree rooted at WINDOW. If PROC changes that window tree,
293 the result is unpredictable."
294 (setq window (window-normalize-any-window window))
295 (walk-window-tree-1 proc window any t))
296
297 (defun windows-with-parameter (parameter &optional value frame any values)
298 "Return a list of all windows on FRAME with PARAMETER non-nil.
299 FRAME defaults to the selected frame. Optional argument VALUE
300 non-nil means only return windows whose window-parameter value of
301 PARAMETER equals VALUE \(comparison is done using `equal').
302 Optional argument ANY non-nil means consider internal windows
303 too. Optional argument VALUES non-nil means return a list of cons
304 cells whose car is the value of the parameter and whose cdr is
305 the window."
306 (let (this-value windows)
307 (walk-window-tree
308 (lambda (window)
309 (when (and (setq this-value (window-parameter window parameter))
310 (or (not value) (or (equal value this-value))))
311 (setq windows
312 (if values
313 (cons (cons this-value window) windows)
314 (cons window windows)))))
315 frame any)
316
317 (nreverse windows)))
318
319 (defun window-with-parameter (parameter &optional value frame any)
320 "Return first window on FRAME with PARAMETER non-nil.
321 FRAME defaults to the selected frame. Optional argument VALUE
322 non-nil means only return a window whose window-parameter value
323 for PARAMETER equals VALUE \(comparison is done with `equal').
324 Optional argument ANY non-nil means consider internal windows
325 too."
326 (let (this-value windows)
327 (catch 'found
328 (walk-window-tree
329 (lambda (window)
330 (when (and (setq this-value (window-parameter window parameter))
331 (or (not value) (equal value this-value)))
332 (throw 'found window)))
333 frame any))))
334
335 ;;; Atomic windows.
336 (defun window-atom-root (&optional window)
337 "Return root of atomic window WINDOW is a part of.
338 WINDOW can be any window and defaults to the selected one.
339 Return nil if WINDOW is not part of a atomic window."
340 (setq window (window-normalize-any-window window))
341 (let (root)
342 (while (and window (window-parameter window 'window-atom))
343 (setq root window)
344 (setq window (window-parent window)))
345 root))
346
347 (defun window-make-atom (window)
348 "Make WINDOW an atomic window.
349 WINDOW must be an internal window. Return WINDOW."
350 (if (not (window-child window))
351 (error "Window %s is not an internal window" window)
352 (walk-window-subtree
353 (lambda (window)
354 (set-window-parameter window 'window-atom t))
355 window t)
356 window))
357
358 (defun window-atom-check-1 (window)
359 "Subroutine of `window-atom-check'."
360 (when window
361 (if (window-parameter window 'window-atom)
362 (let ((count 0))
363 (when (or (catch 'reset
364 (walk-window-subtree
365 (lambda (window)
366 (if (window-parameter window 'window-atom)
367 (setq count (1+ count))
368 (throw 'reset t)))
369 window t))
370 ;; count >= 1 must hold here. If there's no other
371 ;; window around dissolve this atomic window.
372 (= count 1))
373 ;; Dissolve atomic window.
374 (walk-window-subtree
375 (lambda (window)
376 (set-window-parameter window 'window-atom nil))
377 window t)))
378 ;; Check children.
379 (unless (window-buffer window)
380 (window-atom-check-1 (window-left-child window))
381 (window-atom-check-1 (window-top-child window))))
382 ;; Check right sibling
383 (window-atom-check-1 (window-right window))))
384
385 (defun window-atom-check (&optional frame)
386 "Check atomicity of all windows on FRAME.
387 FRAME defaults to the selected frame. If an atomic window is
388 wrongly configured, reset the atomicity of all its subwindows to
389 nil. An atomic window is wrongly configured if it has no
390 subwindows or one of its subwindows is not atomic."
391 (window-atom-check-1 (frame-root-window frame)))
392
393 ;; Side windows.
394 (defvar window-sides '(left top right bottom)
395 "Window sides.")
396
397 (defcustom window-sides-vertical nil
398 "If non-nil, left and right side windows are full height.
399 Otherwise, top and bottom side windows are full width."
400 :type 'boolean
401 :group 'windows
402 :version "24.1")
403
404 (defcustom window-sides-slots '(nil nil nil nil)
405 "Maximum number of side window slots.
406 The value is a list of four elements specifying the number of
407 side window slots on \(in this order) the left, top, right and
408 bottom side of each frame. If an element is a number, this means
409 to display at most that many side windows on the corresponding
410 side. If an element is nil, this means there's no bound on the
411 number of slots on that side."
412 :risky t
413 :type
414 '(list
415 :value (nil nil nil nil)
416 (choice
417 :tag "Left"
418 :help-echo "Maximum slots of left side window."
419 :value nil
420 :format "%[Left%] %v\n"
421 (const :tag "Unlimited" :format "%t" nil)
422 (integer :tag "Number" :value 2 :size 5))
423 (choice
424 :tag "Top"
425 :help-echo "Maximum slots of top side window."
426 :value nil
427 :format "%[Top%] %v\n"
428 (const :tag "Unlimited" :format "%t" nil)
429 (integer :tag "Number" :value 3 :size 5))
430 (choice
431 :tag "Right"
432 :help-echo "Maximum slots of right side window."
433 :value nil
434 :format "%[Right%] %v\n"
435 (const :tag "Unlimited" :format "%t" nil)
436 (integer :tag "Number" :value 2 :size 5))
437 (choice
438 :tag "Bottom"
439 :help-echo "Maximum slots of bottom side window."
440 :value nil
441 :format "%[Bottom%] %v\n"
442 (const :tag "Unlimited" :format "%t" nil)
443 (integer :tag "Number" :value 3 :size 5)))
444 :group 'windows)
445
446 (defun window-side-check (&optional frame)
447 "Check the window-side parameter of all windows on FRAME.
448 FRAME defaults to the selected frame. If the configuration is
449 invalid, reset all window-side parameters to nil.
450
451 A valid configuration has to preserve the following invariant:
452
453 - If a window has a non-nil window-side parameter, it must have a
454 parent window and the parent window's window-side parameter
455 must be either nil or the same as for window.
456
457 - If windows with non-nil window-side parameters exist, there
458 must be at most one window of each side and non-side with a
459 parent whose window-side parameter is nil and there must be no
460 leaf window whose window-side parameter is nil."
461 (let (normal none left top right bottom
462 side parent parent-side code)
463 (when (or (catch 'reset
464 (walk-window-tree
465 (lambda (window)
466 (setq side (window-parameter window 'window-side))
467 (setq parent (window-parent window))
468 (setq parent-side
469 (and parent (window-parameter parent 'window-side)))
470 ;; The following `cond' seems a bit tedious, but I'd
471 ;; rather stick to using just the stack.
472 (cond
473 (parent-side
474 (when (not (eq parent-side side))
475 ;; A parent whose window-side is non-nil must
476 ;; have a child with the same window-side.
477 (throw 'reset t)))
478 ;; Now check that there's more than one main window
479 ;; for any of none, left, top, right and bottom.
480 ((eq side 'none)
481 (if none
482 (throw 'reset t)
483 (setq none t)))
484 ((eq side 'left)
485 (if left
486 (throw 'reset t)
487 (setq left t)))
488 ((eq side 'top)
489 (if top
490 (throw 'reset t)
491 (setq top t)))
492 ((eq side 'right)
493 (if right
494 (throw 'reset t)
495 (setq right t)))
496 ((eq side 'bottom)
497 (if bottom
498 (throw 'reset t)
499 (setq bottom t)))
500 ((window-buffer window)
501 ;; A leaf window without window-side parameter,
502 ;; record its existence.
503 (setq normal t))))
504 frame t))
505 (if none
506 ;; At least one non-side window exists, so there must
507 ;; be at least one side-window and no normal window.
508 (or (not (or left top right bottom)) normal)
509 ;; No non-side window exists, so there must be no side
510 ;; window either.
511 (or left top right bottom)))
512 (walk-window-tree
513 (lambda (window)
514 (set-window-parameter window 'window-side nil))
515 frame t))))
516
517 (defun window-check (&optional frame)
518 "Check atomic and side windows on FRAME.
519 FRAME defaults to the selected frame."
520 (window-side-check frame)
521 (window-atom-check frame))
522
523 ;;; Window sizes.
524 (defvar window-size-fixed nil
525 "Non-nil in a buffer means windows displaying the buffer are fixed-size.
526 If the value is `height', then only the window's height is fixed.
527 If the value is `width', then only the window's width is fixed.
528 Any other non-nil value fixes both the width and the height.
529
530 Emacs won't change the size of any window displaying that buffer,
531 unless it has no other choice \(like when deleting a neighboring
532 window).")
533 (make-variable-buffer-local 'window-size-fixed)
534
535 (defsubst window-size-ignore (window ignore)
536 "Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
537 (if (window-valid-p ignore) (eq window ignore) ignore))
538
539 (defun window-min-size (&optional window horizontal ignore)
540 "Return the minimum number of lines of WINDOW.
541 WINDOW can be an arbitrary window and defaults to the selected
542 one. Optional argument HORIZONTAL non-nil means return the
543 minimum number of columns of WINDOW.
544
545 Optional argument IGNORE non-nil means ignore any restrictions
546 imposed by fixed size windows, `window-min-height' or
547 `window-min-width' settings. IGNORE equal `safe' means live
548 windows may get as small as `window-safe-min-height' lines and
549 `window-safe-min-width' columns. IGNORE a window means ignore
550 restrictions for that window only."
551 (window-min-size-1
552 (window-normalize-any-window window) horizontal ignore))
553
554 (defun window-min-size-1 (window horizontal ignore)
555 "Internal function of `window-min-size'."
556 (let ((sub (window-child window)))
557 (if sub
558 (let ((value 0))
559 ;; WINDOW is an internal window.
560 (if (window-combined-p sub horizontal)
561 ;; The minimum size of an iso-combination is the sum of
562 ;; the minimum sizes of its subwindows.
563 (while sub
564 (setq value (+ value
565 (window-min-size-1 sub horizontal ignore)))
566 (setq sub (window-right sub)))
567 ;; The minimum size of an ortho-combination is the maximum of
568 ;; the minimum sizes of its subwindows.
569 (while sub
570 (setq value (max value
571 (window-min-size-1 sub horizontal ignore)))
572 (setq sub (window-right sub))))
573 value)
574 (with-current-buffer (window-buffer window)
575 (cond
576 ((and (not (window-size-ignore window ignore))
577 (window-size-fixed-p window horizontal))
578 ;; The minimum size of a fixed size window is its size.
579 (window-total-size window horizontal))
580 ((or (eq ignore 'safe) (eq ignore window))
581 ;; If IGNORE equals `safe' or WINDOW return the safe values.
582 (if horizontal window-safe-min-width window-safe-min-height))
583 (horizontal
584 ;; For the minimum width of a window take fringes and
585 ;; scroll-bars into account. This is questionable and should
586 ;; be removed as soon as we are able to split (and resize)
587 ;; windows such that the new (or resized) windows can get a
588 ;; size less than the user-specified `window-min-height' and
589 ;; `window-min-width'.
590 (let ((frame (window-frame window))
591 (fringes (window-fringes window))
592 (scroll-bars (window-scroll-bars window)))
593 (max
594 (+ window-safe-min-width
595 (ceiling (car fringes) (frame-char-width frame))
596 (ceiling (cadr fringes) (frame-char-width frame))
597 (cond
598 ((memq (nth 2 scroll-bars) '(left right))
599 (nth 1 scroll-bars))
600 ((memq (frame-parameter frame 'vertical-scroll-bars)
601 '(left right))
602 (ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
603 (frame-char-width)))
604 (t 0)))
605 (if (and (not (window-size-ignore window ignore))
606 (numberp window-min-width))
607 window-min-width
608 0))))
609 (t
610 ;; For the minimum height of a window take any mode- or
611 ;; header-line into account.
612 (max (+ window-safe-min-height
613 (if header-line-format 1 0)
614 (if mode-line-format 1 0))
615 (if (and (not (window-size-ignore window ignore))
616 (numberp window-min-height))
617 window-min-height
618 0))))))))
619
620 (defun window-sizable (window delta &optional horizontal ignore)
621 "Return DELTA if DELTA lines can be added to WINDOW.
622 Optional argument HORIZONTAL non-nil means return DELTA if DELTA
623 columns can be added to WINDOW. A return value of zero means
624 that no lines (or columns) can be added to WINDOW.
625
626 This function looks only at WINDOW and its subwindows. The
627 function `window-resizable' looks at other windows as well.
628
629 DELTA positive means WINDOW shall be enlarged by DELTA lines or
630 columns. If WINDOW cannot be enlarged by DELTA lines or columns
631 return the maximum value in the range 0..DELTA by which WINDOW
632 can be enlarged.
633
634 DELTA negative means WINDOW shall be shrunk by -DELTA lines or
635 columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
636 return the minimum value in the range DELTA..0 by which WINDOW
637 can be shrunk.
638
639 Optional argument IGNORE non-nil means ignore any restrictions
640 imposed by fixed size windows, `window-min-height' or
641 `window-min-width' settings. IGNORE equal `safe' means live
642 windows may get as small as `window-safe-min-height' lines and
643 `window-safe-min-width' columns. IGNORE any window means ignore
644 restrictions for that window only."
645 (setq window (window-normalize-any-window window))
646 (cond
647 ((< delta 0)
648 (max (- (window-min-size window horizontal ignore)
649 (window-total-size window horizontal))
650 delta))
651 ((window-size-ignore window ignore)
652 delta)
653 ((> delta 0)
654 (if (window-size-fixed-p window horizontal)
655 0
656 delta))
657 (t 0)))
658
659 (defsubst window-sizable-p (window delta &optional horizontal ignore)
660 "Return t if WINDOW can be resized by DELTA lines.
661 For the meaning of the arguments of this function see the
662 doc-string of `window-sizable'."
663 (setq window (window-normalize-any-window window))
664 (if (> delta 0)
665 (>= (window-sizable window delta horizontal ignore) delta)
666 (<= (window-sizable window delta horizontal ignore) delta)))
667
668 (defun window-size-fixed-1 (window horizontal)
669 "Internal function for `window-size-fixed-p'."
670 (let ((sub (window-child window)))
671 (catch 'fixed
672 (if sub
673 ;; WINDOW is an internal window.
674 (if (window-combined-p sub horizontal)
675 ;; An iso-combination is fixed size if all its subwindows
676 ;; are fixed-size.
677 (progn
678 (while sub
679 (unless (window-size-fixed-1 sub horizontal)
680 ;; We found a non-fixed-size subwindow, so WINDOW's
681 ;; size is not fixed.
682 (throw 'fixed nil))
683 (setq sub (window-right sub)))
684 ;; All subwindows are fixed-size, so WINDOW's size is
685 ;; fixed.
686 (throw 'fixed t))
687 ;; An ortho-combination is fixed-size if at least one of its
688 ;; subwindows is fixed-size.
689 (while sub
690 (when (window-size-fixed-1 sub horizontal)
691 ;; We found a fixed-size subwindow, so WINDOW's size is
692 ;; fixed.
693 (throw 'fixed t))
694 (setq sub (window-right sub))))
695 ;; WINDOW is a live window.
696 (with-current-buffer (window-buffer window)
697 (if horizontal
698 (memq window-size-fixed '(width t))
699 (memq window-size-fixed '(height t))))))))
700
701 (defun window-size-fixed-p (&optional window horizontal)
702 "Return non-nil if WINDOW's height is fixed.
703 WINDOW can be an arbitrary window and defaults to the selected
704 window. Optional argument HORIZONTAL non-nil means return
705 non-nil if WINDOW's width is fixed.
706
707 If this function returns nil, this does not necessarily mean that
708 WINDOW can be resized in the desired direction. The functions
709 `window-resizable' and `window-resizable-p' will tell that."
710 (window-size-fixed-1
711 (window-normalize-any-window window) horizontal))
712
713 (defun window-min-delta-1 (window delta &optional horizontal ignore trail noup)
714 "Internal function for `window-min-delta'."
715 (if (not (window-parent window))
716 ;; If we can't go up, return zero.
717 0
718 ;; Else try to find a non-fixed-size sibling of WINDOW.
719 (let* ((parent (window-parent window))
720 (sub (window-child parent)))
721 (catch 'done
722 (if (window-combined-p sub horizontal)
723 ;; In an iso-combination throw DELTA if we find at least one
724 ;; subwindow and that subwindow is either not of fixed-size
725 ;; or we can ignore fixed-sizeness.
726 (let ((skip (eq trail 'after)))
727 (while sub
728 (cond
729 ((eq sub window)
730 (setq skip (eq trail 'before)))
731 (skip)
732 ((and (not (window-size-ignore window ignore))
733 (window-size-fixed-p sub horizontal)))
734 (t
735 ;; We found a non-fixed-size subwindow.
736 (throw 'done delta)))
737 (setq sub (window-right sub))))
738 ;; In an ortho-combination set DELTA to the minimum value by
739 ;; which other subwindows can shrink.
740 (while sub
741 (unless (eq sub window)
742 (setq delta
743 (min delta
744 (- (window-total-size sub horizontal)
745 (window-min-size sub horizontal ignore)))))
746 (setq sub (window-right sub))))
747 (if noup
748 delta
749 (window-min-delta-1 parent delta horizontal ignore trail))))))
750
751 (defun window-min-delta (&optional window horizontal ignore trail noup nodown)
752 "Return number of lines by which WINDOW can be shrunk.
753 WINDOW can be an arbitrary window and defaults to the selected
754 window. Return zero if WINDOW cannot be shrunk.
755
756 Optional argument HORIZONTAL non-nil means return number of
757 columns by which WINDOW can be shrunk.
758
759 Optional argument IGNORE non-nil means ignore any restrictions
760 imposed by fixed size windows, `window-min-height' or
761 `window-min-width' settings. IGNORE a window means ignore
762 restrictions for that window only. IGNORE equal `safe' means
763 live windows may get as small as `window-safe-min-height' lines
764 and `window-safe-min-width' columns.
765
766 Optional argument TRAIL `before' means only windows to the left
767 of or above WINDOW can be enlarged. Optional argument TRAIL
768 `after' means only windows to the right of or below WINDOW can be
769 enlarged.
770
771 Optional argument NOUP non-nil means don't go up in the window
772 tree but try to enlarge windows within WINDOW's combination only.
773
774 Optional argument NODOWN non-nil means don't check whether WINDOW
775 itself \(and its subwindows) can be shrunk; check only whether at
776 least one other windows can be enlarged appropriately."
777 (setq window (window-normalize-any-window window))
778 (let ((size (window-total-size window horizontal))
779 (minimum (window-min-size window horizontal ignore)))
780 (cond
781 (nodown
782 ;; If NODOWN is t, try to recover the entire size of WINDOW.
783 (window-min-delta-1 window size horizontal ignore trail noup))
784 ((= size minimum)
785 ;; If NODOWN is nil and WINDOW's size is already at its minimum,
786 ;; there's nothing to recover.
787 0)
788 (t
789 ;; Otherwise, try to recover whatever WINDOW is larger than its
790 ;; minimum size.
791 (window-min-delta-1
792 window (- size minimum) horizontal ignore trail noup)))))
793
794 (defun window-max-delta-1 (window delta &optional horizontal ignore trail noup)
795 "Internal function of `window-max-delta'."
796 (if (not (window-parent window))
797 ;; Can't go up. Return DELTA.
798 delta
799 (let* ((parent (window-parent window))
800 (sub (window-child parent)))
801 (catch 'fixed
802 (if (window-combined-p sub horizontal)
803 ;; For an iso-combination calculate how much we can get from
804 ;; other subwindows.
805 (let ((skip (eq trail 'after)))
806 (while sub
807 (cond
808 ((eq sub window)
809 (setq skip (eq trail 'before)))
810 (skip)
811 (t
812 (setq delta
813 (+ delta
814 (- (window-total-size sub horizontal)
815 (window-min-size sub horizontal ignore))))))
816 (setq sub (window-right sub))))
817 ;; For an ortho-combination throw DELTA when at least one
818 ;; subwindow is fixed-size.
819 (while sub
820 (when (and (not (eq sub window))
821 (not (window-size-ignore sub ignore))
822 (window-size-fixed-p sub horizontal))
823 (throw 'fixed delta))
824 (setq sub (window-right sub))))
825 (if noup
826 ;; When NOUP is nil, DELTA is all we can get.
827 delta
828 ;; Else try with parent of WINDOW, passing the DELTA we
829 ;; recovered so far.
830 (window-max-delta-1 parent delta horizontal ignore trail))))))
831
832 (defun window-max-delta (&optional window horizontal ignore trail noup nodown)
833 "Return maximum number of lines WINDOW by which WINDOW can be enlarged.
834 WINDOW can be an arbitrary window and defaults to the selected
835 window. The return value is zero if WINDOW cannot be enlarged.
836
837 Optional argument HORIZONTAL non-nil means return maximum number
838 of columns by which WINDOW can be enlarged.
839
840 Optional argument IGNORE non-nil means ignore any restrictions
841 imposed by fixed size windows, `window-min-height' or
842 `window-min-width' settings. IGNORE a window means ignore
843 restrictions for that window only. IGNORE equal `safe' means
844 live windows may get as small as `window-safe-min-height' lines
845 and `window-safe-min-width' columns.
846
847 Optional argument TRAIL `before' means only windows to the left
848 of or below WINDOW can be shrunk. Optional argument TRAIL
849 `after' means only windows to the right of or above WINDOW can be
850 shrunk.
851
852 Optional argument NOUP non-nil means don't go up in the window
853 tree but try to obtain the entire space from windows within
854 WINDOW's combination.
855
856 Optional argument NODOWN non-nil means do not check whether
857 WINDOW itself \(and its subwindows) can be enlarged; check only
858 whether other windows can be shrunk appropriately."
859 (setq window (window-normalize-any-window window))
860 (if (and (not (window-size-ignore window ignore))
861 (not nodown) (window-size-fixed-p window horizontal))
862 ;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
863 ;; size.
864 0
865 ;; WINDOW has no fixed size.
866 (window-max-delta-1 window 0 horizontal ignore trail noup)))
867
868 ;; Make NOUP also inhibit the min-size check.
869 (defun window-resizable (window delta &optional horizontal ignore trail noup nodown)
870 "Return DELTA if WINDOW can be resized vertically by DELTA lines.
871 Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
872 can be resized horizontally by DELTA columns. A return value of
873 zero means that WINDOW is not resizable.
874
875 DELTA positive means WINDOW shall be enlarged by DELTA lines or
876 columns. If WINDOW cannot be enlarged by DELTA lines or columns
877 return the maximum value in the range 0..DELTA by which WINDOW
878 can be enlarged.
879
880 DELTA negative means WINDOW shall be shrunk by -DELTA lines or
881 columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
882 return the minimum value in the range DELTA..0 that can be used
883 for shrinking WINDOW.
884
885 Optional argument IGNORE non-nil means ignore any restrictions
886 imposed by fixed size windows, `window-min-height' or
887 `window-min-width' settings. IGNORE a window means ignore
888 restrictions for that window only. IGNORE equal `safe' means
889 live windows may get as small as `window-safe-min-height' lines
890 and `window-safe-min-width' columns.
891
892 Optional argument TRAIL `before' means only windows to the left
893 of or below WINDOW can be shrunk. Optional argument TRAIL
894 `after' means only windows to the right of or above WINDOW can be
895 shrunk.
896
897 Optional argument NOUP non-nil means don't go up in the window
898 tree but try to distribute the space among the other windows
899 within WINDOW's combination.
900
901 Optional argument NODOWN non-nil means don't check whether WINDOW
902 and its subwindows can be resized."
903 (setq window (window-normalize-any-window window))
904 (cond
905 ((< delta 0)
906 (max (- (window-min-delta window horizontal ignore trail noup nodown))
907 delta))
908 ((> delta 0)
909 (min (window-max-delta window horizontal ignore trail noup nodown)
910 delta))
911 (t 0)))
912
913 (defun window-resizable-p (window delta &optional horizontal ignore trail noup nodown)
914 "Return t if WINDOW can be resized vertically by DELTA lines.
915 For the meaning of the arguments of this function see the
916 doc-string of `window-resizable'."
917 (setq window (window-normalize-any-window window))
918 (if (> delta 0)
919 (>= (window-resizable window delta horizontal ignore trail noup nodown)
920 delta)
921 (<= (window-resizable window delta horizontal ignore trail noup nodown)
922 delta)))
923
924 (defsubst window-total-height (&optional window)
925 "Return the total number of lines of WINDOW.
926 WINDOW can be any window and defaults to the selected one. The
927 return value includes WINDOW's mode line and header line, if any.
928 If WINDOW is internal the return value is the sum of the total
929 number of lines of WINDOW's child windows if these are vertically
930 combined and the height of WINDOW's first child otherwise.
931
932 Note: This function does not take into account the value of
933 `line-spacing' when calculating the number of lines in WINDOW."
934 (window-total-size window))
935
936 ;; Eventually we should make `window-height' obsolete.
937 (defalias 'window-height 'window-total-height)
938
939 ;; See discussion in bug#4543.
940 (defsubst window-full-height-p (&optional window)
941 "Return t if WINDOW is as high as the containing frame.
942 More precisely, return t if and only if the total height of
943 WINDOW equals the total height of the root window of WINDOW's
944 frame. WINDOW can be any window and defaults to the selected
945 one."
946 (setq window (window-normalize-any-window window))
947 (= (window-total-size window)
948 (window-total-size (frame-root-window window))))
949
950 (defsubst window-total-width (&optional window)
951 "Return the total number of columns of WINDOW.
952 WINDOW can be any window and defaults to the selected one. The
953 return value includes any vertical dividers or scrollbars of
954 WINDOW. If WINDOW is internal, the return value is the sum of
955 the total number of columns of WINDOW's child windows if these
956 are horizontally combined and the width of WINDOW's first child
957 otherwise."
958 (window-total-size window t))
959
960 (defsubst window-full-width-p (&optional window)
961 "Return t if WINDOW is as wide as the containing frame.
962 More precisely, return t if and only if the total width of WINDOW
963 equals the total width of the root window of WINDOW's frame.
964 WINDOW can be any window and defaults to the selected one."
965 (setq window (window-normalize-any-window window))
966 (= (window-total-size window t)
967 (window-total-size (frame-root-window window) t)))
968
969 (defsubst window-body-height (&optional window)
970 "Return the number of lines of WINDOW's body.
971 WINDOW must be a live window and defaults to the selected one.
972
973 The return value does not include WINDOW's mode line and header
974 line, if any. If a line at the bottom of the window is only
975 partially visible, that line is included in the return value. If
976 you do not want to include a partially visible bottom line in the
977 return value, use `window-text-height' instead.
978
979 Note that the return value is measured in canonical units, i.e. for
980 the default frame's face. If the window shows some characters with
981 non-default face, e.g., if the font of some characters is larger or
982 smaller than the default font, the value returned by this function
983 will not match the actual number of lines shown in the window. To
984 get the actual number of lines, use `posn-at-point'."
985 (window-body-size window))
986
987 (defsubst window-body-width (&optional window)
988 "Return the number of columns of WINDOW's body.
989 WINDOW must be a live window and defaults to the selected one.
990
991 The return value does not include any vertical dividers or scroll
992 bars owned by WINDOW. On a window-system the return value does
993 not include the number of columns used for WINDOW's fringes or
994 display margins either.
995
996 Note that the return value is measured in canonical units, i.e. for
997 the default frame's face. If the window shows some characters with
998 non-default face, e.g., if the font of some characters is larger or
999 smaller than the default font, the value returned by this function
1000 will not match the actual number of characters per line shown in the
1001 window. To get the actual number of columns, use `posn-at-point'."
1002 (window-body-size window t))
1003
1004 ;; Eventually we should make `window-height' obsolete.
1005 (defalias 'window-width 'window-body-width)
1006
1007 (defun window-current-scroll-bars (&optional window)
1008 "Return the current scroll bar settings for WINDOW.
1009 WINDOW must be a live window and defaults to the selected one.
1010
1011 The return value is a cons cell (VERTICAL . HORIZONTAL) where
1012 VERTICAL specifies the current location of the vertical scroll
1013 bars (`left', `right', or nil), and HORIZONTAL specifies the
1014 current location of the horizontal scroll bars (`top', `bottom',
1015 or nil).
1016
1017 Unlike `window-scroll-bars', this function reports the scroll bar
1018 type actually used, once frame defaults and `scroll-bar-mode' are
1019 taken into account."
1020 (setq window (window-normalize-live-window window))
1021 (let ((vert (nth 2 (window-scroll-bars window)))
1022 (hor nil))
1023 (when (or (eq vert t) (eq hor t))
1024 (let ((fcsb (frame-current-scroll-bars (window-frame window))))
1025 (if (eq vert t)
1026 (setq vert (car fcsb)))
1027 (if (eq hor t)
1028 (setq hor (cdr fcsb)))))
1029 (cons vert hor)))
1030
1031 (defun walk-windows (proc &optional minibuf all-frames)
1032 "Cycle through all live windows, calling PROC for each one.
1033 PROC must specify a function with a window as its sole argument.
1034 The optional arguments MINIBUF and ALL-FRAMES specify the set of
1035 windows to include in the walk.
1036
1037 MINIBUF t means include the minibuffer window even if the
1038 minibuffer is not active. MINIBUF nil or omitted means include
1039 the minibuffer window only if the minibuffer is active. Any
1040 other value means do not include the minibuffer window even if
1041 the minibuffer is active.
1042
1043 ALL-FRAMES nil or omitted means consider all windows on the
1044 selected frame, plus the minibuffer window if specified by the
1045 MINIBUF argument. If the minibuffer counts, consider all windows
1046 on all frames that share that minibuffer too. The following
1047 non-nil values of ALL-FRAMES have special meanings:
1048
1049 - t means consider all windows on all existing frames.
1050
1051 - `visible' means consider all windows on all visible frames on
1052 the current terminal.
1053
1054 - 0 (the number zero) means consider all windows on all visible
1055 and iconified frames on the current terminal.
1056
1057 - A frame means consider all windows on that frame only.
1058
1059 Anything else means consider all windows on the selected frame
1060 and no others.
1061
1062 This function changes neither the order of recently selected
1063 windows nor the buffer list."
1064 ;; If we start from the minibuffer window, don't fail to come
1065 ;; back to it.
1066 (when (window-minibuffer-p (selected-window))
1067 (setq minibuf t))
1068 ;; Make sure to not mess up the order of recently selected
1069 ;; windows. Use `save-selected-window' and `select-window'
1070 ;; with second argument non-nil for this purpose.
1071 (save-selected-window
1072 (when (framep all-frames)
1073 (select-window (frame-first-window all-frames) 'norecord))
1074 (dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
1075 (funcall proc walk-windows-window))))
1076
1077 (defun window-point-1 (&optional window)
1078 "Return value of WINDOW's point.
1079 WINDOW can be any live window and defaults to the selected one.
1080
1081 This function is like `window-point' with one exception: If
1082 WINDOW is selected, it returns the value of `point' of WINDOW's
1083 buffer regardless of whether that buffer is current or not."
1084 (setq window (window-normalize-live-window window))
1085 (if (eq window (selected-window))
1086 (with-current-buffer (window-buffer window)
1087 (point))
1088 (window-point window)))
1089
1090 (defun set-window-point-1 (window pos)
1091 "Set value of WINDOW's point to POS.
1092 WINDOW can be any live window and defaults to the selected one.
1093
1094 This function is like `set-window-point' with one exception: If
1095 WINDOW is selected, it moves `point' of WINDOW's buffer to POS
1096 regardless of whether that buffer is current or not."
1097 (setq window (window-normalize-live-window window))
1098 (if (eq window (selected-window))
1099 (with-current-buffer (window-buffer window)
1100 (goto-char pos))
1101 (set-window-point window pos)))
1102
1103 (defun window-at-side-p (&optional window side)
1104 "Return t if WINDOW is at SIDE of its containing frame.
1105 WINDOW can be any window and defaults to the selected one. SIDE
1106 can be any of the symbols `left', `top', `right' or `bottom'.
1107 The default value nil is handled like `bottom'."
1108 (setq window (window-normalize-any-window window))
1109 (let ((edge
1110 (cond
1111 ((eq side 'left) 0)
1112 ((eq side 'top) 1)
1113 ((eq side 'right) 2)
1114 ((memq side '(bottom nil)) 3))))
1115 (= (nth edge (window-edges window))
1116 (nth edge (window-edges (frame-root-window window))))))
1117
1118 (defun windows-at-side (&optional frame side)
1119 "Return list of all windows on SIDE of FRAME.
1120 FRAME must be a live frame and defaults to the selected frame.
1121 SIDE can be any of the symbols `left', `top', `right' or
1122 `bottom'. The default value nil is handled like `bottom'."
1123 (setq frame (window-normalize-frame frame))
1124 (let (windows)
1125 (walk-window-tree
1126 (lambda (window)
1127 (when (window-at-side-p window side)
1128 (setq windows (cons window windows))))
1129 frame)
1130 (nreverse windows)))
1131
1132 (defun window-in-direction-2 (window posn &optional horizontal)
1133 "Support function for `window-in-direction'."
1134 (if horizontal
1135 (let ((top (window-top-line window)))
1136 (if (> top posn)
1137 (- top posn)
1138 (- posn top (window-total-height window))))
1139 (let ((left (window-left-column window)))
1140 (if (> left posn)
1141 (- left posn)
1142 (- posn left (window-total-width window))))))
1143
1144 (defun window-in-direction (direction &optional window ignore)
1145 "Return window in DIRECTION as seen from WINDOW.
1146 DIRECTION must be one of `above', `below', `left' or `right'.
1147 WINDOW must be a live window and defaults to the selected one.
1148 IGNORE, when non-nil means a window can be returned even if its
1149 `no-other-window' parameter is non-nil."
1150 (setq window (window-normalize-live-window window))
1151 (unless (memq direction '(above below left right))
1152 (error "Wrong direction %s" direction))
1153 (let* ((frame (window-frame window))
1154 (hor (memq direction '(left right)))
1155 (first (if hor
1156 (window-left-column window)
1157 (window-top-line window)))
1158 (last (+ first (if hor
1159 (window-total-width window)
1160 (window-total-height window))))
1161 (posn-cons (nth 6 (posn-at-point (window-point-1 window) window)))
1162 ;; The column / row value of `posn-at-point' can be nil for the
1163 ;; mini-window, guard against that.
1164 (posn (if hor
1165 (+ (or (cdr posn-cons) 1) (window-top-line window))
1166 (+ (or (car posn-cons) 1) (window-left-column window))))
1167 (best-edge
1168 (cond
1169 ((eq direction 'below) (frame-height frame))
1170 ((eq direction 'right) (frame-width frame))
1171 (t -1)))
1172 (best-edge-2 best-edge)
1173 (best-diff-2 (if hor (frame-height frame) (frame-width frame)))
1174 best best-2 best-diff-2-new)
1175 (walk-window-tree
1176 (lambda (w)
1177 (let* ((w-top (window-top-line w))
1178 (w-left (window-left-column w)))
1179 (cond
1180 ((or (eq window w)
1181 ;; Ignore ourselves.
1182 (and (window-parameter w 'no-other-window)
1183 ;; Ignore W unless IGNORE is non-nil.
1184 (not ignore))))
1185 (hor
1186 (cond
1187 ((and (<= w-top posn)
1188 (< posn (+ w-top (window-total-height w))))
1189 ;; W is to the left or right of WINDOW and covers POSN.
1190 (when (or (and (eq direction 'left)
1191 (<= w-left first) (> w-left best-edge))
1192 (and (eq direction 'right)
1193 (>= w-left last) (< w-left best-edge)))
1194 (setq best-edge w-left)
1195 (setq best w)))
1196 ((and (or (and (eq direction 'left)
1197 (<= (+ w-left (window-total-width w)) first))
1198 (and (eq direction 'right) (<= last w-left)))
1199 ;; W is to the left or right of WINDOW but does not
1200 ;; cover POSN.
1201 (setq best-diff-2-new
1202 (window-in-direction-2 w posn hor))
1203 (or (< best-diff-2-new best-diff-2)
1204 (and (= best-diff-2-new best-diff-2)
1205 (if (eq direction 'left)
1206 (> w-left best-edge-2)
1207 (< w-left best-edge-2)))))
1208 (setq best-edge-2 w-left)
1209 (setq best-diff-2 best-diff-2-new)
1210 (setq best-2 w))))
1211 (t
1212 (cond
1213 ((and (<= w-left posn)
1214 (< posn (+ w-left (window-total-width w))))
1215 ;; W is above or below WINDOW and covers POSN.
1216 (when (or (and (eq direction 'above)
1217 (<= w-top first) (> w-top best-edge))
1218 (and (eq direction 'below)
1219 (>= w-top first) (< w-top best-edge)))
1220 (setq best-edge w-top)
1221 (setq best w)))
1222 ((and (or (and (eq direction 'above)
1223 (<= (+ w-top (window-total-height w)) first))
1224 (and (eq direction 'below) (<= last w-top)))
1225 ;; W is above or below WINDOW but does not cover POSN.
1226 (setq best-diff-2-new
1227 (window-in-direction-2 w posn hor))
1228 (or (< best-diff-2-new best-diff-2)
1229 (and (= best-diff-2-new best-diff-2)
1230 (if (eq direction 'above)
1231 (> w-top best-edge-2)
1232 (< w-top best-edge-2)))))
1233 (setq best-edge-2 w-top)
1234 (setq best-diff-2 best-diff-2-new)
1235 (setq best-2 w)))))))
1236 (window-frame window))
1237 (or best best-2)))
1238
1239 (defun get-window-with-predicate (predicate &optional minibuf all-frames default)
1240 "Return a live window satisfying PREDICATE.
1241 More precisely, cycle through all windows calling the function
1242 PREDICATE on each one of them with the window as its sole
1243 argument. Return the first window for which PREDICATE returns
1244 non-nil. Windows are scanned starting with the window following
1245 the selcted window. If no window satisfies PREDICATE, return
1246 DEFAULT.
1247
1248 MINIBUF t means include the minibuffer window even if the
1249 minibuffer is not active. MINIBUF nil or omitted means include
1250 the minibuffer window only if the minibuffer is active. Any
1251 other value means do not include the minibuffer window even if
1252 the minibuffer is active.
1253
1254 ALL-FRAMES nil or omitted means consider all windows on the selected
1255 frame, plus the minibuffer window if specified by the MINIBUF
1256 argument. If the minibuffer counts, consider all windows on all
1257 frames that share that minibuffer too. The following non-nil
1258 values of ALL-FRAMES have special meanings:
1259
1260 - t means consider all windows on all existing frames.
1261
1262 - `visible' means consider all windows on all visible frames on
1263 the current terminal.
1264
1265 - 0 (the number zero) means consider all windows on all visible
1266 and iconified frames on the current terminal.
1267
1268 - A frame means consider all windows on that frame only.
1269
1270 Anything else means consider all windows on the selected frame
1271 and no others."
1272 (catch 'found
1273 (dolist (window (window-list-1
1274 (next-window nil minibuf all-frames)
1275 minibuf all-frames))
1276 (when (funcall predicate window)
1277 (throw 'found window)))
1278 default))
1279
1280 (defalias 'some-window 'get-window-with-predicate)
1281
1282 (defun get-lru-window (&optional all-frames dedicated)
1283 "Return the least recently used window on frames specified by ALL-FRAMES.
1284 Return a full-width window if possible. A minibuffer window is
1285 never a candidate. A dedicated window is never a candidate
1286 unless DEDICATED is non-nil, so if all windows are dedicated, the
1287 value is nil. Avoid returning the selected window if possible.
1288
1289 The following non-nil values of the optional argument ALL-FRAMES
1290 have special meanings:
1291
1292 - t means consider all windows on all existing frames.
1293
1294 - `visible' means consider all windows on all visible frames on
1295 the current terminal.
1296
1297 - 0 (the number zero) means consider all windows on all visible
1298 and iconified frames on the current terminal.
1299
1300 - A frame means consider all windows on that frame only.
1301
1302 Any other value of ALL-FRAMES means consider all windows on the
1303 selected frame and no others."
1304 (let (best-window best-time second-best-window second-best-time time)
1305 (dolist (window (window-list-1 nil 'nomini all-frames))
1306 (when (or dedicated (not (window-dedicated-p window)))
1307 (setq time (window-use-time window))
1308 (if (or (eq window (selected-window))
1309 (not (window-full-width-p window)))
1310 (when (or (not second-best-time) (< time second-best-time))
1311 (setq second-best-time time)
1312 (setq second-best-window window))
1313 (when (or (not best-time) (< time best-time))
1314 (setq best-time time)
1315 (setq best-window window)))))
1316 (or best-window second-best-window)))
1317
1318 (defun get-mru-window (&optional all-frames)
1319 "Return the most recently used window on frames specified by ALL-FRAMES.
1320 Do not return a minibuffer window.
1321
1322 The following non-nil values of the optional argument ALL-FRAMES
1323 have special meanings:
1324
1325 - t means consider all windows on all existing frames.
1326
1327 - `visible' means consider all windows on all visible frames on
1328 the current terminal.
1329
1330 - 0 (the number zero) means consider all windows on all visible
1331 and iconified frames on the current terminal.
1332
1333 - A frame means consider all windows on that frame only.
1334
1335 Any other value of ALL-FRAMES means consider all windows on the
1336 selected frame and no others."
1337 (let (best-window best-time time)
1338 (dolist (window (window-list-1 nil 'nomini all-frames))
1339 (setq time (window-use-time window))
1340 (when (or (not best-time) (> time best-time))
1341 (setq best-time time)
1342 (setq best-window window)))
1343 best-window))
1344
1345 (defun get-largest-window (&optional all-frames dedicated)
1346 "Return the largest window on frames specified by ALL-FRAMES.
1347 A minibuffer window is never a candidate. A dedicated window is
1348 never a candidate unless DEDICATED is non-nil, so if all windows
1349 are dedicated, the value is nil.
1350
1351 The following non-nil values of the optional argument ALL-FRAMES
1352 have special meanings:
1353
1354 - t means consider all windows on all existing frames.
1355
1356 - `visible' means consider all windows on all visible frames on
1357 the current terminal.
1358
1359 - 0 (the number zero) means consider all windows on all visible
1360 and iconified frames on the current terminal.
1361
1362 - A frame means consider all windows on that frame only.
1363
1364 Any other value of ALL-FRAMES means consider all windows on the
1365 selected frame and no others."
1366 (let ((best-size 0)
1367 best-window size)
1368 (dolist (window (window-list-1 nil 'nomini all-frames))
1369 (when (or dedicated (not (window-dedicated-p window)))
1370 (setq size (* (window-total-size window)
1371 (window-total-size window t)))
1372 (when (> size best-size)
1373 (setq best-size size)
1374 (setq best-window window))))
1375 best-window))
1376
1377 (defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
1378 "Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
1379 BUFFER-OR-NAME may be a buffer or the name of an existing buffer
1380 and defaults to the current buffer. Windows are scanned starting
1381 with the selected window.
1382
1383 MINIBUF t means include the minibuffer window even if the
1384 minibuffer is not active. MINIBUF nil or omitted means include
1385 the minibuffer window only if the minibuffer is active. Any
1386 other value means do not include the minibuffer window even if
1387 the minibuffer is active.
1388
1389 ALL-FRAMES nil or omitted means consider all windows on the
1390 selected frame, plus the minibuffer window if specified by the
1391 MINIBUF argument. If the minibuffer counts, consider all windows
1392 on all frames that share that minibuffer too. The following
1393 non-nil values of ALL-FRAMES have special meanings:
1394
1395 - t means consider all windows on all existing frames.
1396
1397 - `visible' means consider all windows on all visible frames on
1398 the current terminal.
1399
1400 - 0 (the number zero) means consider all windows on all visible
1401 and iconified frames on the current terminal.
1402
1403 - A frame means consider all windows on that frame only.
1404
1405 Anything else means consider all windows on the selected frame
1406 and no others."
1407 (let ((buffer (window-normalize-buffer buffer-or-name))
1408 windows)
1409 (dolist (window (window-list-1 (selected-window) minibuf all-frames))
1410 (when (eq (window-buffer window) buffer)
1411 (setq windows (cons window windows))))
1412 (nreverse windows)))
1413
1414 (defun minibuffer-window-active-p (window)
1415 "Return t if WINDOW is the currently active minibuffer window."
1416 (eq window (active-minibuffer-window)))
1417
1418 (defun count-windows (&optional minibuf)
1419 "Return the number of live windows on the selected frame.
1420 The optional argument MINIBUF specifies whether the minibuffer
1421 window shall be counted. See `walk-windows' for the precise
1422 meaning of this argument."
1423 (length (window-list-1 nil minibuf)))
1424 \f
1425 ;;; Resizing windows.
1426 (defun window--resize-reset (&optional frame horizontal)
1427 "Reset resize values for all windows on FRAME.
1428 FRAME defaults to the selected frame.
1429
1430 This function stores the current value of `window-total-size' applied
1431 with argument HORIZONTAL in the new total size of all windows on
1432 FRAME. It also resets the new normal size of each of these
1433 windows."
1434 (window--resize-reset-1
1435 (frame-root-window (window-normalize-frame frame)) horizontal))
1436
1437 (defun window--resize-reset-1 (window horizontal)
1438 "Internal function of `window--resize-reset'."
1439 ;; Register old size in the new total size.
1440 (set-window-new-total window (window-total-size window horizontal))
1441 ;; Reset new normal size.
1442 (set-window-new-normal window)
1443 (when (window-child window)
1444 (window--resize-reset-1 (window-child window) horizontal))
1445 (when (window-right window)
1446 (window--resize-reset-1 (window-right window) horizontal)))
1447
1448 ;; The following routine is used to manually resize the minibuffer
1449 ;; window and is currently used, for example, by ispell.el.
1450 (defun window--resize-mini-window (window delta)
1451 "Resize minibuffer window WINDOW by DELTA lines.
1452 If WINDOW cannot be resized by DELTA lines make it as large \(or
1453 as small) as possible but don't signal an error."
1454 (when (window-minibuffer-p window)
1455 (let* ((frame (window-frame window))
1456 (root (frame-root-window frame))
1457 (height (window-total-size window))
1458 (min-delta
1459 (- (window-total-size root)
1460 (window-min-size root))))
1461 ;; Sanitize DELTA.
1462 (cond
1463 ((<= (+ height delta) 0)
1464 (setq delta (- (- height 1))))
1465 ((> delta min-delta)
1466 (setq delta min-delta)))
1467
1468 ;; Resize now.
1469 (window--resize-reset frame)
1470 ;; Ideally we should be able to resize just the last subwindow of
1471 ;; root here. See the comment in `resize-root-window-vertically'
1472 ;; for why we do not do that.
1473 (window--resize-this-window root (- delta) nil nil t)
1474 (set-window-new-total window (+ height delta))
1475 ;; The following routine catches the case where we want to resize
1476 ;; a minibuffer-only frame.
1477 (resize-mini-window-internal window))))
1478
1479 (defun window-resize (window delta &optional horizontal ignore)
1480 "Resize WINDOW vertically by DELTA lines.
1481 WINDOW can be an arbitrary window and defaults to the selected
1482 one. An attempt to resize the root window of a frame will raise
1483 an error though.
1484
1485 DELTA a positive number means WINDOW shall be enlarged by DELTA
1486 lines. DELTA negative means WINDOW shall be shrunk by -DELTA
1487 lines.
1488
1489 Optional argument HORIZONTAL non-nil means resize WINDOW
1490 horizontally by DELTA columns. In this case a positive DELTA
1491 means enlarge WINDOW by DELTA columns. DELTA negative means
1492 WINDOW shall be shrunk by -DELTA columns.
1493
1494 Optional argument IGNORE non-nil means ignore any restrictions
1495 imposed by fixed size windows, `window-min-height' or
1496 `window-min-width' settings. IGNORE any window means ignore
1497 restrictions for that window only. IGNORE equal `safe' means
1498 live windows may get as small as `window-safe-min-height' lines
1499 and `window-safe-min-width' columns.
1500
1501 This function resizes other windows proportionally and never
1502 deletes any windows. If you want to move only the low (right)
1503 edge of WINDOW consider using `adjust-window-trailing-edge'
1504 instead."
1505 (setq window (window-normalize-any-window window))
1506 (let* ((frame (window-frame window))
1507 sibling)
1508 (cond
1509 ((eq window (frame-root-window frame))
1510 (error "Cannot resize the root window of a frame"))
1511 ((window-minibuffer-p window)
1512 (window--resize-mini-window window delta))
1513 ((window-resizable-p window delta horizontal ignore)
1514 (window--resize-reset frame horizontal)
1515 (window--resize-this-window window delta horizontal ignore t)
1516 (if (and (not (window-splits window))
1517 (window-combined-p window horizontal)
1518 (setq sibling (or (window-right window) (window-left window)))
1519 (window-sizable-p sibling (- delta) horizontal ignore))
1520 ;; If window-splits returns nil for WINDOW, WINDOW is part of
1521 ;; an iso-combination, and WINDOW's neighboring right or left
1522 ;; sibling can be resized as requested, resize that sibling.
1523 (let ((normal-delta
1524 (/ (float delta)
1525 (window-total-size (window-parent window) horizontal))))
1526 (window--resize-this-window sibling (- delta) horizontal nil t)
1527 (set-window-new-normal
1528 window (+ (window-normal-size window horizontal)
1529 normal-delta))
1530 (set-window-new-normal
1531 sibling (- (window-normal-size sibling horizontal)
1532 normal-delta)))
1533 ;; Otherwise, resize all other windows in the same combination.
1534 (window--resize-siblings window delta horizontal ignore))
1535 (window-resize-apply frame horizontal))
1536 (t
1537 (error "Cannot resize window %s" window)))))
1538
1539 (defsubst window--resize-subwindows-skip-p (window)
1540 "Return non-nil if WINDOW shall be skipped by resizing routines."
1541 (memq (window-new-normal window) '(ignore stuck skip)))
1542
1543 (defun window--resize-subwindows-normal (parent horizontal window this-delta &optional trail other-delta)
1544 "Set the new normal height of subwindows of window PARENT.
1545 HORIZONTAL non-nil means set the new normal width of these
1546 windows. WINDOW specifies a subwindow of PARENT that has been
1547 resized by THIS-DELTA lines \(columns).
1548
1549 Optional argument TRAIL either 'before or 'after means set values
1550 for windows before or after WINDOW only. Optional argument
1551 OTHER-DELTA a number specifies that this many lines \(columns)
1552 have been obtained from \(or returned to) an ancestor window of
1553 PARENT in order to resize WINDOW."
1554 (let* ((delta-normal
1555 (if (and (= (- this-delta) (window-total-size window horizontal))
1556 (zerop other-delta))
1557 ;; When WINDOW gets deleted and we can return its entire
1558 ;; space to its siblings, use WINDOW's normal size as the
1559 ;; normal delta.
1560 (- (window-normal-size window horizontal))
1561 ;; In any other case calculate the normal delta from the
1562 ;; relation of THIS-DELTA to the total size of PARENT.
1563 (/ (float this-delta) (window-total-size parent horizontal))))
1564 (sub (window-child parent))
1565 (parent-normal 0.0)
1566 (skip (eq trail 'after)))
1567
1568 ;; Set parent-normal to the sum of the normal sizes of all
1569 ;; subwindows of PARENT that shall be resized, excluding only WINDOW
1570 ;; and any windows specified by the optional TRAIL argument.
1571 (while sub
1572 (cond
1573 ((eq sub window)
1574 (setq skip (eq trail 'before)))
1575 (skip)
1576 (t
1577 (setq parent-normal
1578 (+ parent-normal (window-normal-size sub horizontal)))))
1579 (setq sub (window-right sub)))
1580
1581 ;; Set the new normal size of all subwindows of PARENT from what
1582 ;; they should have contributed for recovering THIS-DELTA lines
1583 ;; (columns).
1584 (setq sub (window-child parent))
1585 (setq skip (eq trail 'after))
1586 (while sub
1587 (cond
1588 ((eq sub window)
1589 (setq skip (eq trail 'before)))
1590 (skip)
1591 (t
1592 (let ((old-normal (window-normal-size sub horizontal)))
1593 (set-window-new-normal
1594 sub (min 1.0 ; Don't get larger than 1.
1595 (max (- old-normal
1596 (* (/ old-normal parent-normal)
1597 delta-normal))
1598 ;; Don't drop below 0.
1599 0.0))))))
1600 (setq sub (window-right sub)))
1601
1602 (when (numberp other-delta)
1603 ;; Set the new normal size of windows from what they should have
1604 ;; contributed for recovering OTHER-DELTA lines (columns).
1605 (setq delta-normal (/ (float (window-total-size parent horizontal))
1606 (+ (window-total-size parent horizontal)
1607 other-delta)))
1608 (setq sub (window-child parent))
1609 (setq skip (eq trail 'after))
1610 (while sub
1611 (cond
1612 ((eq sub window)
1613 (setq skip (eq trail 'before)))
1614 (skip)
1615 (t
1616 (set-window-new-normal
1617 sub (min 1.0 ; Don't get larger than 1.
1618 (max (* (window-new-normal sub) delta-normal)
1619 ;; Don't drop below 0.
1620 0.0)))))
1621 (setq sub (window-right sub))))
1622
1623 ;; Set the new normal size of WINDOW to what is left by the sum of
1624 ;; the normal sizes of its siblings.
1625 (set-window-new-normal
1626 window
1627 (let ((sum 0))
1628 (setq sub (window-child parent))
1629 (while sub
1630 (cond
1631 ((eq sub window))
1632 ((not (numberp (window-new-normal sub)))
1633 (setq sum (+ sum (window-normal-size sub horizontal))))
1634 (t
1635 (setq sum (+ sum (window-new-normal sub)))))
1636 (setq sub (window-right sub)))
1637 ;; Don't get larger than 1 or smaller than 0.
1638 (min 1.0 (max (- 1.0 sum) 0.0))))))
1639
1640 (defun window--resize-subwindows (parent delta &optional horizontal window ignore trail edge)
1641 "Resize subwindows of window PARENT vertically by DELTA lines.
1642 PARENT must be a vertically combined internal window.
1643
1644 Optional argument HORIZONTAL non-nil means resize subwindows of
1645 PARENT horizontally by DELTA columns. In this case PARENT must
1646 be a horizontally combined internal window.
1647
1648 WINDOW, if specified, must denote a child window of PARENT that
1649 is resized by DELTA lines.
1650
1651 Optional argument IGNORE non-nil means ignore any restrictions
1652 imposed by fixed size windows, `window-min-height' or
1653 `window-min-width' settings. IGNORE equal `safe' means live
1654 windows may get as small as `window-safe-min-height' lines and
1655 `window-safe-min-width' columns. IGNORE any window means ignore
1656 restrictions for that window only.
1657
1658 Optional arguments TRAIL and EDGE, when non-nil, restrict the set
1659 of windows that shall be resized. If TRAIL equals `before',
1660 resize only windows on the left or above EDGE. If TRAIL equals
1661 `after', resize only windows on the right or below EDGE. Also,
1662 preferably only resize windows adjacent to EDGE.
1663
1664 Return the symbol `normalized' if new normal sizes have been
1665 already set by this routine."
1666 (let* ((first (window-child parent))
1667 (sub first)
1668 (parent-total (+ (window-total-size parent horizontal) delta))
1669 best-window best-value)
1670
1671 (if (and edge (memq trail '(before after))
1672 (progn
1673 (setq sub first)
1674 (while (and (window-right sub)
1675 (or (and (eq trail 'before)
1676 (not (window--resize-subwindows-skip-p
1677 (window-right sub))))
1678 (and (eq trail 'after)
1679 (window--resize-subwindows-skip-p sub))))
1680 (setq sub (window-right sub)))
1681 sub)
1682 (if horizontal
1683 (if (eq trail 'before)
1684 (= (+ (window-left-column sub)
1685 (window-total-size sub t))
1686 edge)
1687 (= (window-left-column sub) edge))
1688 (if (eq trail 'before)
1689 (= (+ (window-top-line sub)
1690 (window-total-size sub))
1691 edge)
1692 (= (window-top-line sub) edge)))
1693 (window-sizable-p sub delta horizontal ignore))
1694 ;; Resize only windows adjacent to EDGE.
1695 (progn
1696 (window--resize-this-window
1697 sub delta horizontal ignore t trail edge)
1698 (if (and window (eq (window-parent sub) parent))
1699 (progn
1700 ;; Assign new normal sizes.
1701 (set-window-new-normal
1702 sub (/ (float (window-new-total sub)) parent-total))
1703 (set-window-new-normal
1704 window (- (window-normal-size window horizontal)
1705 (- (window-new-normal sub)
1706 (window-normal-size sub horizontal)))))
1707 (window--resize-subwindows-normal
1708 parent horizontal sub 0 trail delta))
1709 ;; Return 'normalized to notify `window--resize-siblings' that
1710 ;; normal sizes have been already set.
1711 'normalized)
1712 ;; Resize all windows proportionally.
1713 (setq sub first)
1714 (while sub
1715 (cond
1716 ((or (window--resize-subwindows-skip-p sub)
1717 ;; Ignore windows to skip and fixed-size subwindows - in
1718 ;; the latter case make it a window to skip.
1719 (and (not ignore)
1720 (window-size-fixed-p sub horizontal)
1721 (set-window-new-normal sub 'ignore))))
1722 ((< delta 0)
1723 ;; When shrinking store the number of lines/cols we can get
1724 ;; from this window here together with the total/normal size
1725 ;; factor.
1726 (set-window-new-normal
1727 sub
1728 (cons
1729 ;; We used to call this with NODOWN t, "fixed" 2011-05-11.
1730 (window-min-delta sub horizontal ignore trail t) ; t)
1731 (- (/ (float (window-total-size sub horizontal))
1732 parent-total)
1733 (window-normal-size sub horizontal)))))
1734 ((> delta 0)
1735 ;; When enlarging store the total/normal size factor only
1736 (set-window-new-normal
1737 sub
1738 (- (/ (float (window-total-size sub horizontal))
1739 parent-total)
1740 (window-normal-size sub horizontal)))))
1741
1742 (setq sub (window-right sub)))
1743
1744 (cond
1745 ((< delta 0)
1746 ;; Shrink windows by delta.
1747 (setq best-window t)
1748 (while (and best-window (not (zerop delta)))
1749 (setq sub first)
1750 (setq best-window nil)
1751 (setq best-value most-negative-fixnum)
1752 (while sub
1753 (when (and (consp (window-new-normal sub))
1754 (not (zerop (car (window-new-normal sub))))
1755 (> (cdr (window-new-normal sub)) best-value))
1756 (setq best-window sub)
1757 (setq best-value (cdr (window-new-normal sub))))
1758
1759 (setq sub (window-right sub)))
1760
1761 (when best-window
1762 (setq delta (1+ delta)))
1763 (set-window-new-total best-window -1 t)
1764 (set-window-new-normal
1765 best-window
1766 (if (= (car (window-new-normal best-window)) 1)
1767 'skip ; We can't shrink best-window any further.
1768 (cons (1- (car (window-new-normal best-window)))
1769 (- (/ (float (window-new-total best-window))
1770 parent-total)
1771 (window-normal-size best-window horizontal)))))))
1772 ((> delta 0)
1773 ;; Enlarge windows by delta.
1774 (setq best-window t)
1775 (while (and best-window (not (zerop delta)))
1776 (setq sub first)
1777 (setq best-window nil)
1778 (setq best-value most-positive-fixnum)
1779 (while sub
1780 (when (and (numberp (window-new-normal sub))
1781 (< (window-new-normal sub) best-value))
1782 (setq best-window sub)
1783 (setq best-value (window-new-normal sub)))
1784
1785 (setq sub (window-right sub)))
1786
1787 (when best-window
1788 (setq delta (1- delta)))
1789 (set-window-new-total best-window 1 t)
1790 (set-window-new-normal
1791 best-window
1792 (- (/ (float (window-new-total best-window))
1793 parent-total)
1794 (window-normal-size best-window horizontal))))))
1795
1796 (when best-window
1797 (setq sub first)
1798 (while sub
1799 (when (or (consp (window-new-normal sub))
1800 (numberp (window-new-normal sub)))
1801 ;; Reset new normal size fields so `window-resize-apply'
1802 ;; won't use them to apply new sizes.
1803 (set-window-new-normal sub))
1804
1805 (unless (eq (window-new-normal sub) 'ignore)
1806 ;; Resize this subwindow's subwindows (back-engineering
1807 ;; delta from sub's old and new total sizes).
1808 (let ((delta (- (window-new-total sub)
1809 (window-total-size sub horizontal))))
1810 (unless (and (zerop delta) (not trail))
1811 ;; For the TRAIL non-nil case we have to resize SUB
1812 ;; recursively even if it's size does not change.
1813 (window--resize-this-window
1814 sub delta horizontal ignore nil trail edge))))
1815 (setq sub (window-right sub)))))))
1816
1817 (defun window--resize-siblings (window delta &optional horizontal ignore trail edge)
1818 "Resize other windows when WINDOW is resized vertically by DELTA lines.
1819 Optional argument HORIZONTAL non-nil means resize other windows
1820 when WINDOW is resized horizontally by DELTA columns. WINDOW
1821 itself is not resized by this function.
1822
1823 Optional argument IGNORE non-nil means ignore any restrictions
1824 imposed by fixed size windows, `window-min-height' or
1825 `window-min-width' settings. IGNORE equal `safe' means live
1826 windows may get as small as `window-safe-min-height' lines and
1827 `window-safe-min-width' columns. IGNORE any window means ignore
1828 restrictions for that window only.
1829
1830 Optional arguments TRAIL and EDGE, when non-nil, refine the set
1831 of windows that shall be resized. If TRAIL equals `before',
1832 resize only windows on the left or above EDGE. If TRAIL equals
1833 `after', resize only windows on the right or below EDGE. Also,
1834 preferably only resize windows adjacent to EDGE."
1835 (when (window-parent window)
1836 (let* ((parent (window-parent window))
1837 (sub (window-child parent)))
1838 (if (window-combined-p sub horizontal)
1839 ;; In an iso-combination try to extract DELTA from WINDOW's
1840 ;; siblings.
1841 (let ((first sub)
1842 (skip (eq trail 'after))
1843 this-delta other-delta)
1844 ;; Decide which windows shall be left alone.
1845 (while sub
1846 (cond
1847 ((eq sub window)
1848 ;; Make sure WINDOW is left alone when
1849 ;; resizing its siblings.
1850 (set-window-new-normal sub 'ignore)
1851 (setq skip (eq trail 'before)))
1852 (skip
1853 ;; Make sure this sibling is left alone when
1854 ;; resizing its siblings.
1855 (set-window-new-normal sub 'ignore))
1856 ((or (window-size-ignore sub ignore)
1857 (not (window-size-fixed-p sub horizontal)))
1858 ;; Set this-delta to t to signal that we found a sibling
1859 ;; of WINDOW whose size is not fixed.
1860 (setq this-delta t)))
1861
1862 (setq sub (window-right sub)))
1863
1864 ;; Set this-delta to what we can get from WINDOW's siblings.
1865 (if (= (- delta) (window-total-size window horizontal))
1866 ;; A deletion, presumably. We must handle this case
1867 ;; specially since `window-resizable' can't be used.
1868 (if this-delta
1869 ;; There's at least one resizable sibling we can
1870 ;; give WINDOW's size to.
1871 (setq this-delta delta)
1872 ;; No resizable sibling exists.
1873 (setq this-delta 0))
1874 ;; Any other form of resizing.
1875 (setq this-delta
1876 (window-resizable window delta horizontal ignore trail t)))
1877
1878 ;; Set other-delta to what we still have to get from
1879 ;; ancestor windows of parent.
1880 (setq other-delta (- delta this-delta))
1881 (unless (zerop other-delta)
1882 ;; Unless we got everything from WINDOW's siblings, PARENT
1883 ;; must be resized by other-delta lines or columns.
1884 (set-window-new-total parent other-delta 'add))
1885
1886 (if (zerop this-delta)
1887 ;; We haven't got anything from WINDOW's siblings but we
1888 ;; must update the normal sizes to respect other-delta.
1889 (window--resize-subwindows-normal
1890 parent horizontal window this-delta trail other-delta)
1891 ;; We did get something from WINDOW's siblings which means
1892 ;; we have to resize their subwindows.
1893 (unless (eq (window--resize-subwindows
1894 parent (- this-delta) horizontal
1895 window ignore trail edge)
1896 ;; If `window--resize-subwindows' returns
1897 ;; 'normalized, this means it has set the
1898 ;; normal sizes already.
1899 'normalized)
1900 ;; Set the normal sizes.
1901 (window--resize-subwindows-normal
1902 parent horizontal window this-delta trail other-delta))
1903 ;; Set DELTA to what we still have to get from ancestor
1904 ;; windows.
1905 (setq delta other-delta)))
1906
1907 ;; In an ortho-combination all siblings of WINDOW must be
1908 ;; resized by DELTA.
1909 (set-window-new-total parent delta 'add)
1910 (while sub
1911 (unless (eq sub window)
1912 (window--resize-this-window sub delta horizontal ignore t))
1913 (setq sub (window-right sub))))
1914
1915 (unless (zerop delta)
1916 ;; "Go up."
1917 (window--resize-siblings
1918 parent delta horizontal ignore trail edge)))))
1919
1920 (defun window--resize-this-window (window delta &optional horizontal ignore add trail edge)
1921 "Resize WINDOW vertically by DELTA lines.
1922 Optional argument HORIZONTAL non-nil means resize WINDOW
1923 horizontally by DELTA columns.
1924
1925 Optional argument IGNORE non-nil means ignore any restrictions
1926 imposed by fixed size windows, `window-min-height' or
1927 `window-min-width' settings. IGNORE equal `safe' means live
1928 windows may get as small as `window-safe-min-height' lines and
1929 `window-safe-min-width' columns. IGNORE any window means ignore
1930 restrictions for that window only.
1931
1932 Optional argument ADD non-nil means add DELTA to the new total
1933 size of WINDOW.
1934
1935 Optional arguments TRAIL and EDGE, when non-nil, refine the set
1936 of windows that shall be resized. If TRAIL equals `before',
1937 resize only windows on the left or above EDGE. If TRAIL equals
1938 `after', resize only windows on the right or below EDGE. Also,
1939 preferably only resize windows adjacent to EDGE.
1940
1941 This function recursively resizes WINDOW's subwindows to fit the
1942 new size. Make sure that WINDOW is `window-resizable' before
1943 calling this function. Note that this function does not resize
1944 siblings of WINDOW or WINDOW's parent window. You have to
1945 eventually call `window-resize-apply' in order to make resizing
1946 actually take effect."
1947 (when add
1948 ;; Add DELTA to the new total size of WINDOW.
1949 (set-window-new-total window delta t))
1950
1951 (let ((sub (window-child window)))
1952 (cond
1953 ((not sub))
1954 ((window-combined-p sub horizontal)
1955 ;; In an iso-combination resize subwindows according to their
1956 ;; normal sizes.
1957 (window--resize-subwindows
1958 window delta horizontal nil ignore trail edge))
1959 ;; In an ortho-combination resize each subwindow by DELTA.
1960 (t
1961 (while sub
1962 (window--resize-this-window
1963 sub delta horizontal ignore t trail edge)
1964 (setq sub (window-right sub)))))))
1965
1966 (defun window--resize-root-window (window delta horizontal ignore)
1967 "Resize root window WINDOW vertically by DELTA lines.
1968 HORIZONTAL non-nil means resize root window WINDOW horizontally
1969 by DELTA columns.
1970
1971 IGNORE non-nil means ignore any restrictions imposed by fixed
1972 size windows, `window-min-height' or `window-min-width' settings.
1973
1974 This function is only called by the frame resizing routines. It
1975 resizes windows proportionally and never deletes any windows."
1976 (when (and (windowp window) (numberp delta)
1977 (window-sizable-p window delta horizontal ignore))
1978 (window--resize-reset (window-frame window) horizontal)
1979 (window--resize-this-window window delta horizontal ignore t)))
1980
1981 (defun window--resize-root-window-vertically (window delta)
1982 "Resize root window WINDOW vertically by DELTA lines.
1983 If DELTA is less than zero and we can't shrink WINDOW by DELTA
1984 lines, shrink it as much as possible. If DELTA is greater than
1985 zero, this function can resize fixed-size subwindows in order to
1986 recover the necessary lines.
1987
1988 Return the number of lines that were recovered.
1989
1990 This function is only called by the minibuffer window resizing
1991 routines. It resizes windows proportionally and never deletes
1992 any windows."
1993 (when (numberp delta)
1994 (let (ignore)
1995 (cond
1996 ((< delta 0)
1997 (setq delta (window-sizable window delta)))
1998 ((> delta 0)
1999 (unless (window-sizable window delta)
2000 (setq ignore t))))
2001
2002 (window--resize-reset (window-frame window))
2003 ;; Ideally, we would resize just the last window in a combination
2004 ;; but that's not feasible for the following reason: If we grow
2005 ;; the minibuffer window and the last window cannot be shrunk any
2006 ;; more, we shrink another window instead. But if we then shrink
2007 ;; the minibuffer window again, the last window might get enlarged
2008 ;; and the state after shrinking is not the state before growing.
2009 ;; So, in practice, we'd need a history variable to record how to
2010 ;; proceed. But I'm not sure how such a variable could work with
2011 ;; repeated minibuffer window growing steps.
2012 (window--resize-this-window window delta nil ignore t)
2013 delta)))
2014
2015 (defun adjust-window-trailing-edge (window delta &optional horizontal)
2016 "Move WINDOW's bottom edge by DELTA lines.
2017 Optional argument HORIZONTAL non-nil means move WINDOW's right
2018 edge by DELTA columns. WINDOW defaults to the selected window.
2019
2020 If DELTA is greater zero, then move the edge downwards or to the
2021 right. If DELTA is less than zero, move the edge upwards or to
2022 the left. If the edge can't be moved by DELTA lines or columns,
2023 move it as far as possible in the desired direction."
2024 (setq window (window-normalize-any-window window))
2025 (let ((frame (window-frame window))
2026 (right window)
2027 left this-delta min-delta max-delta failed)
2028 ;; Find the edge we want to move.
2029 (while (and (or (not (window-combined-p right horizontal))
2030 (not (window-right right)))
2031 (setq right (window-parent right))))
2032 (cond
2033 ((and (not right) (not horizontal) (not resize-mini-windows)
2034 (eq (window-frame (minibuffer-window frame)) frame))
2035 (window--resize-mini-window (minibuffer-window frame) (- delta)))
2036 ((or (not (setq left right)) (not (setq right (window-right right))))
2037 (if horizontal
2038 (error "No window on the right of this one")
2039 (error "No window below this one")))
2040 (t
2041 ;; Set LEFT to the first resizable window on the left. This step is
2042 ;; needed to handle fixed-size windows.
2043 (while (and left (window-size-fixed-p left horizontal))
2044 (setq left
2045 (or (window-left left)
2046 (progn
2047 (while (and (setq left (window-parent left))
2048 (not (window-combined-p left horizontal))))
2049 (window-left left)))))
2050 (unless left
2051 (if horizontal
2052 (error "No resizable window on the left of this one")
2053 (error "No resizable window above this one")))
2054
2055 ;; Set RIGHT to the first resizable window on the right. This step
2056 ;; is needed to handle fixed-size windows.
2057 (while (and right (window-size-fixed-p right horizontal))
2058 (setq right
2059 (or (window-right right)
2060 (progn
2061 (while (and (setq right (window-parent right))
2062 (not (window-combined-p right horizontal))))
2063 (window-right right)))))
2064 (unless right
2065 (if horizontal
2066 (error "No resizable window on the right of this one")
2067 (error "No resizable window below this one")))
2068
2069 ;; LEFT and RIGHT (which might be both internal windows) are now the
2070 ;; two windows we want to resize.
2071 (cond
2072 ((> delta 0)
2073 (setq max-delta (window-max-delta-1 left 0 horizontal nil 'after))
2074 (setq min-delta (window-min-delta-1 right (- delta) horizontal nil 'before))
2075 (when (or (< max-delta delta) (> min-delta (- delta)))
2076 ;; We can't get the whole DELTA - move as far as possible.
2077 (setq delta (min max-delta (- min-delta))))
2078 (unless (zerop delta)
2079 ;; Start resizing.
2080 (window--resize-reset frame horizontal)
2081 ;; Try to enlarge LEFT first.
2082 (setq this-delta (window-resizable left delta horizontal))
2083 (unless (zerop this-delta)
2084 (window--resize-this-window
2085 left this-delta horizontal nil t 'before
2086 (if horizontal
2087 (+ (window-left-column left) (window-total-size left t))
2088 (+ (window-top-line left) (window-total-size left)))))
2089 ;; Shrink windows on right of LEFT.
2090 (window--resize-siblings
2091 left delta horizontal nil 'after
2092 (if horizontal
2093 (window-left-column right)
2094 (window-top-line right)))))
2095 ((< delta 0)
2096 (setq max-delta (window-max-delta-1 right 0 horizontal nil 'before))
2097 (setq min-delta (window-min-delta-1 left delta horizontal nil 'after))
2098 (when (or (< max-delta (- delta)) (> min-delta delta))
2099 ;; We can't get the whole DELTA - move as far as possible.
2100 (setq delta (max (- max-delta) min-delta)))
2101 (unless (zerop delta)
2102 ;; Start resizing.
2103 (window--resize-reset frame horizontal)
2104 ;; Try to enlarge RIGHT.
2105 (setq this-delta (window-resizable right (- delta) horizontal))
2106 (unless (zerop this-delta)
2107 (window--resize-this-window
2108 right this-delta horizontal nil t 'after
2109 (if horizontal
2110 (window-left-column right)
2111 (window-top-line right))))
2112 ;; Shrink windows on left of RIGHT.
2113 (window--resize-siblings
2114 right (- delta) horizontal nil 'before
2115 (if horizontal
2116 (+ (window-left-column left) (window-total-size left t))
2117 (+ (window-top-line left) (window-total-size left)))))))
2118 (unless (zerop delta)
2119 ;; Don't report an error in the standard case.
2120 (unless (window-resize-apply frame horizontal)
2121 ;; But do report an error if applying the changes fails.
2122 (error "Failed adjusting window %s" window)))))))
2123
2124 (defun enlarge-window (delta &optional horizontal)
2125 "Make selected window DELTA lines taller.
2126 Interactively, if no argument is given, make the selected window
2127 one line taller. If optional argument HORIZONTAL is non-nil,
2128 make selected window wider by DELTA columns. If DELTA is
2129 negative, shrink selected window by -DELTA lines or columns.
2130 Return nil."
2131 (interactive "p")
2132 (cond
2133 ((zerop delta))
2134 ((window-size-fixed-p nil horizontal)
2135 (error "Selected window has fixed size"))
2136 ((window-resizable-p nil delta horizontal)
2137 (window-resize nil delta horizontal))
2138 (t
2139 (window-resize
2140 nil (if (> delta 0)
2141 (window-max-delta nil horizontal)
2142 (- (window-min-delta nil horizontal)))
2143 horizontal))))
2144
2145 (defun shrink-window (delta &optional horizontal)
2146 "Make selected window DELTA lines smaller.
2147 Interactively, if no argument is given, make the selected window
2148 one line smaller. If optional argument HORIZONTAL is non-nil,
2149 make selected window narrower by DELTA columns. If DELTA is
2150 negative, enlarge selected window by -DELTA lines or columns.
2151 Return nil."
2152 (interactive "p")
2153 (cond
2154 ((zerop delta))
2155 ((window-size-fixed-p nil horizontal)
2156 (error "Selected window has fixed size"))
2157 ((window-resizable-p nil (- delta) horizontal)
2158 (window-resize nil (- delta) horizontal))
2159 (t
2160 (window-resize
2161 nil (if (> delta 0)
2162 (- (window-min-delta nil horizontal))
2163 (window-max-delta nil horizontal))
2164 horizontal))))
2165
2166 (defun maximize-window (&optional window)
2167 "Maximize WINDOW.
2168 Make WINDOW as large as possible without deleting any windows.
2169 WINDOW can be any window and defaults to the selected window."
2170 (interactive)
2171 (setq window (window-normalize-any-window window))
2172 (window-resize window (window-max-delta window))
2173 (window-resize window (window-max-delta window t) t))
2174
2175 (defun minimize-window (&optional window)
2176 "Minimize WINDOW.
2177 Make WINDOW as small as possible without deleting any windows.
2178 WINDOW can be any window and defaults to the selected window."
2179 (interactive)
2180 (setq window (window-normalize-any-window window))
2181 (window-resize window (- (window-min-delta window)))
2182 (window-resize window (- (window-min-delta window t)) t))
2183 \f
2184 (defsubst frame-root-window-p (window)
2185 "Return non-nil if WINDOW is the root window of its frame."
2186 (eq window (frame-root-window window)))
2187
2188 (defun window-tree-1 (window &optional next)
2189 "Return window tree rooted at WINDOW.
2190 Optional argument NEXT non-nil means include windows right
2191 siblings in the return value.
2192
2193 See the documentation of `window-tree' for a description of the
2194 return value."
2195 (let (list)
2196 (while window
2197 (setq list
2198 (cons
2199 (cond
2200 ((window-top-child window)
2201 (cons t (cons (window-edges window)
2202 (window-tree-1 (window-top-child window) t))))
2203 ((window-left-child window)
2204 (cons nil (cons (window-edges window)
2205 (window-tree-1 (window-left-child window) t))))
2206 (t window))
2207 list))
2208 (setq window (when next (window-next-sibling window))))
2209 (nreverse list)))
2210
2211 (defun window-tree (&optional frame)
2212 "Return the window tree of frame FRAME.
2213 FRAME must be a live frame and defaults to the selected frame.
2214 The return value is a list of the form (ROOT MINI), where ROOT
2215 represents the window tree of the frame's root window, and MINI
2216 is the frame's minibuffer window.
2217
2218 If the root window is not split, ROOT is the root window itself.
2219 Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil
2220 for a horizontal split, and t for a vertical split. EDGES gives
2221 the combined size and position of the subwindows in the split,
2222 and the rest of the elements are the subwindows in the split.
2223 Each of the subwindows may again be a window or a list
2224 representing a window split, and so on. EDGES is a list \(LEFT
2225 TOP RIGHT BOTTOM) as returned by `window-edges'."
2226 (setq frame (window-normalize-frame frame))
2227 (window-tree-1 (frame-root-window frame) t))
2228 \f
2229 (defun other-window (count &optional all-frames)
2230 "Select another window in cyclic ordering of windows.
2231 COUNT specifies the number of windows to skip, starting with the
2232 selected window, before making the selection. If COUNT is
2233 positive, skip COUNT windows forwards. If COUNT is negative,
2234 skip -COUNT windows backwards. COUNT zero means do not skip any
2235 window, so select the selected window. In an interactive call,
2236 COUNT is the numeric prefix argument. Return nil.
2237
2238 If the `other-window' parameter of WINDOW is a function and
2239 `ignore-window-parameters' is nil, call that function with the
2240 arguments COUNT and ALL-FRAMES.
2241
2242 This function does not select a window whose `no-other-window'
2243 window parameter is non-nil.
2244
2245 This function uses `next-window' for finding the window to
2246 select. The argument ALL-FRAMES has the same meaning as in
2247 `next-window', but the MINIBUF argument of `next-window' is
2248 always effectively nil."
2249 (interactive "p")
2250 (let* ((window (selected-window))
2251 (function (and (not ignore-window-parameters)
2252 (window-parameter window 'other-window)))
2253 old-window old-count)
2254 (if (functionp function)
2255 (funcall function count all-frames)
2256 ;; `next-window' and `previous-window' may return a window we are
2257 ;; not allowed to select. Hence we need an exit strategy in case
2258 ;; all windows are non-selectable.
2259 (catch 'exit
2260 (while (> count 0)
2261 (setq window (next-window window nil all-frames))
2262 (cond
2263 ((eq window old-window)
2264 (when (= count old-count)
2265 ;; Keep out of infinite loops. When COUNT has not changed
2266 ;; since we last looked at `window' we're probably in one.
2267 (throw 'exit nil)))
2268 ((window-parameter window 'no-other-window)
2269 (unless old-window
2270 ;; The first non-selectable window `next-window' got us:
2271 ;; Remember it and the current value of COUNT.
2272 (setq old-window window)
2273 (setq old-count count)))
2274 (t
2275 (setq count (1- count)))))
2276 (while (< count 0)
2277 (setq window (previous-window window nil all-frames))
2278 (cond
2279 ((eq window old-window)
2280 (when (= count old-count)
2281 ;; Keep out of infinite loops. When COUNT has not changed
2282 ;; since we last looked at `window' we're probably in one.
2283 (throw 'exit nil)))
2284 ((window-parameter window 'no-other-window)
2285 (unless old-window
2286 ;; The first non-selectable window `previous-window' got
2287 ;; us: Remember it and the current value of COUNT.
2288 (setq old-window window)
2289 (setq old-count count)))
2290 (t
2291 (setq count (1+ count)))))
2292
2293 (select-window window)
2294 ;; Always return nil.
2295 nil))))
2296
2297 ;; This should probably return non-nil when the selected window is part
2298 ;; of an atomic window whose root is the frame's root window.
2299 (defun one-window-p (&optional nomini all-frames)
2300 "Return non-nil if the selected window is the only window.
2301 Optional arg NOMINI non-nil means don't count the minibuffer
2302 even if it is active. Otherwise, the minibuffer is counted
2303 when it is active.
2304
2305 Optional argument ALL-FRAMES specifies the set of frames to
2306 consider, see also `next-window'. ALL-FRAMES nil or omitted
2307 means consider windows on the selected frame only, plus the
2308 minibuffer window if specified by the NOMINI argument. If the
2309 minibuffer counts, consider all windows on all frames that share
2310 that minibuffer too. The remaining non-nil values of ALL-FRAMES
2311 with a special meaning are:
2312
2313 - t means consider all windows on all existing frames.
2314
2315 - `visible' means consider all windows on all visible frames on
2316 the current terminal.
2317
2318 - 0 (the number zero) means consider all windows on all visible
2319 and iconified frames on the current terminal.
2320
2321 - A frame means consider all windows on that frame only.
2322
2323 Anything else means consider all windows on the selected frame
2324 and no others."
2325 (let ((base-window (selected-window)))
2326 (if (and nomini (eq base-window (minibuffer-window)))
2327 (setq base-window (next-window base-window)))
2328 (eq base-window
2329 (next-window base-window (if nomini 'arg) all-frames))))
2330 \f
2331 ;;; Deleting windows.
2332 (defun window-deletable-p (&optional window)
2333 "Return t if WINDOW can be safely deleted from its frame.
2334 Return `frame' if deleting WINDOW should also delete its
2335 frame."
2336 (setq window (window-normalize-any-window window))
2337
2338 (unless ignore-window-parameters
2339 ;; Handle atomicity.
2340 (when (window-parameter window 'window-atom)
2341 (setq window (window-atom-root window))))
2342
2343 (let* ((parent (window-parent window))
2344 (frame (window-frame window))
2345 (buffer (window-buffer window)))
2346 (cond
2347 ((frame-root-window-p window)
2348 ;; WINDOW's frame can be deleted only if there are other frames
2349 ;; on the same terminal.
2350 (unless (eq frame (next-frame frame 0))
2351 'frame))
2352 ((or ignore-window-parameters
2353 (not (eq (window-parameter window 'window-side) 'none))
2354 (and parent (eq (window-parameter parent 'window-side) 'none)))
2355 ;; WINDOW can be deleted unless it is the main window of its
2356 ;; frame.
2357 t))))
2358
2359 (defun window-or-subwindow-p (subwindow window)
2360 "Return t if SUBWINDOW is either WINDOW or a subwindow of WINDOW."
2361 (or (eq subwindow window)
2362 (let ((parent (window-parent subwindow)))
2363 (catch 'done
2364 (while parent
2365 (if (eq parent window)
2366 (throw 'done t)
2367 (setq parent (window-parent parent))))))))
2368
2369 (defun delete-window (&optional window)
2370 "Delete WINDOW.
2371 WINDOW can be an arbitrary window and defaults to the selected
2372 one. Return nil.
2373
2374 If the variable `ignore-window-parameters' is non-nil or the
2375 `delete-window' parameter of WINDOW equals t, do not process any
2376 parameters of WINDOW. Otherwise, if the `delete-window'
2377 parameter of WINDOW specifies a function, call that function with
2378 WINDOW as its sole argument and return the value returned by that
2379 function.
2380
2381 Otherwise, if WINDOW is part of an atomic window, call
2382 `delete-window' with the root of the atomic window as its
2383 argument. If WINDOW is the only window on its frame or the last
2384 non-side window, signal an error."
2385 (interactive)
2386 (setq window (window-normalize-any-window window))
2387 (let* ((frame (window-frame window))
2388 (function (window-parameter window 'delete-window))
2389 (parent (window-parent window))
2390 atom-root)
2391 (window-check frame)
2392 (catch 'done
2393 ;; Handle window parameters.
2394 (cond
2395 ;; Ignore window parameters if `ignore-window-parameters' tells
2396 ;; us so or `delete-window' equals t.
2397 ((or ignore-window-parameters (eq function t)))
2398 ((functionp function)
2399 ;; The `delete-window' parameter specifies the function to call.
2400 ;; If that function is `ignore' nothing is done. It's up to the
2401 ;; function called here to avoid infinite recursion.
2402 (throw 'done (funcall function window)))
2403 ((and (window-parameter window 'window-atom)
2404 (setq atom-root (window-atom-root window))
2405 (not (eq atom-root window)))
2406 (throw 'done (delete-window atom-root)))
2407 ((and (eq (window-parameter window 'window-side) 'none)
2408 (or (not parent)
2409 (not (eq (window-parameter parent 'window-side) 'none))))
2410 (error "Attempt to delete last non-side window"))
2411 ((not parent)
2412 (error "Attempt to delete minibuffer or sole ordinary window")))
2413
2414 (let* ((horizontal (window-left-child parent))
2415 (size (window-total-size window horizontal))
2416 (frame-selected
2417 (window-or-subwindow-p (frame-selected-window frame) window))
2418 ;; Emacs 23 preferably gives WINDOW's space to its left
2419 ;; sibling.
2420 (sibling (or (window-left window) (window-right window))))
2421 (window--resize-reset frame horizontal)
2422 (cond
2423 ((and (not (window-splits window))
2424 sibling (window-sizable-p sibling size))
2425 ;; Resize WINDOW's sibling.
2426 (window--resize-this-window sibling size horizontal nil t)
2427 (set-window-new-normal
2428 sibling (+ (window-normal-size sibling horizontal)
2429 (window-normal-size window horizontal))))
2430 ((window-resizable-p window (- size) horizontal nil nil nil t)
2431 ;; Can do without resizing fixed-size windows.
2432 (window--resize-siblings window (- size) horizontal))
2433 (t
2434 ;; Can't do without resizing fixed-size windows.
2435 (window--resize-siblings window (- size) horizontal t)))
2436 ;; Actually delete WINDOW.
2437 (delete-window-internal window)
2438 (when (and frame-selected
2439 (window-parameter
2440 (frame-selected-window frame) 'no-other-window))
2441 ;; `delete-window-internal' has selected a window that should
2442 ;; not be selected, fix this here.
2443 (other-window -1 frame))
2444 (run-window-configuration-change-hook frame)
2445 (window-check frame)
2446 ;; Always return nil.
2447 nil))))
2448
2449 (defun delete-other-windows (&optional window)
2450 "Make WINDOW fill its frame.
2451 WINDOW may be any window and defaults to the selected one.
2452 Return nil.
2453
2454 If the variable `ignore-window-parameters' is non-nil or the
2455 `delete-other-windows' parameter of WINDOW equals t, do not
2456 process any parameters of WINDOW. Otherwise, if the
2457 `delete-other-windows' parameter of WINDOW specifies a function,
2458 call that function with WINDOW as its sole argument and return
2459 the value returned by that function.
2460
2461 Otherwise, if WINDOW is part of an atomic window, call this
2462 function with the root of the atomic window as its argument. If
2463 WINDOW is a non-side window, make WINDOW the only non-side window
2464 on the frame. Side windows are not deleted. If WINDOW is a side
2465 window signal an error."
2466 (interactive)
2467 (setq window (window-normalize-any-window window))
2468 (let* ((frame (window-frame window))
2469 (function (window-parameter window 'delete-other-windows))
2470 (window-side (window-parameter window 'window-side))
2471 atom-root side-main)
2472 (window-check frame)
2473 (catch 'done
2474 (cond
2475 ;; Ignore window parameters if `ignore-window-parameters' is t or
2476 ;; `delete-other-windows' is t.
2477 ((or ignore-window-parameters (eq function t)))
2478 ((functionp function)
2479 ;; The `delete-other-windows' parameter specifies the function
2480 ;; to call. If the function is `ignore' no windows are deleted.
2481 ;; It's up to the function called to avoid infinite recursion.
2482 (throw 'done (funcall function window)))
2483 ((and (window-parameter window 'window-atom)
2484 (setq atom-root (window-atom-root window))
2485 (not (eq atom-root window)))
2486 (throw 'done (delete-other-windows atom-root)))
2487 ((eq window-side 'none)
2488 ;; Set side-main to the major non-side window.
2489 (setq side-main (window-with-parameter 'window-side 'none nil t)))
2490 ((memq window-side window-sides)
2491 (error "Cannot make side window the only window")))
2492 ;; If WINDOW is the main non-side window, do nothing.
2493 (unless (eq window side-main)
2494 (delete-other-windows-internal window side-main)
2495 (run-window-configuration-change-hook frame)
2496 (window-check frame))
2497 ;; Always return nil.
2498 nil)))
2499
2500 (defun delete-other-windows-vertically (&optional window)
2501 "Delete the windows in the same column with WINDOW, but not WINDOW itself.
2502 This may be a useful alternative binding for \\[delete-other-windows]
2503 if you often split windows horizontally."
2504 (interactive)
2505 (let* ((window (or window (selected-window)))
2506 (edges (window-edges window))
2507 (w window) delenda)
2508 (while (not (eq (setq w (next-window w 1)) window))
2509 (let ((e (window-edges w)))
2510 (when (and (= (car e) (car edges))
2511 (= (caddr e) (caddr edges)))
2512 (push w delenda))))
2513 (mapc 'delete-window delenda)))
2514
2515 ;;; Windows and buffers.
2516
2517 ;; `prev-buffers' and `next-buffers' are two reserved window slots used
2518 ;; for (1) determining which buffer to show in the window when its
2519 ;; buffer shall be buried or killed and (2) which buffer to show for
2520 ;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
2521
2522 ;; `prev-buffers' consists of <buffer, window-start, window-point>
2523 ;; triples. The entries on this list are ordered by the time their
2524 ;; buffer has been removed from the window, the most recently removed
2525 ;; buffer's entry being first. The window-start and window-point
2526 ;; components are `window-start' and `window-point' at the time the
2527 ;; buffer was removed from the window which implies that the entry must
2528 ;; be added when `set-window-buffer' removes the buffer from the window.
2529
2530 ;; `next-buffers' is the list of buffers that have been replaced
2531 ;; recently by `switch-to-prev-buffer'. These buffers are the least
2532 ;; preferred candidates of `switch-to-prev-buffer' and the preferred
2533 ;; candidates of `switch-to-next-buffer' to switch to. This list is
2534 ;; reset to nil by any action changing the window's buffer with the
2535 ;; exception of `switch-to-prev-buffer' and `switch-to-next-buffer'.
2536 ;; `switch-to-prev-buffer' pushes the buffer it just replaced on it,
2537 ;; `switch-to-next-buffer' pops the last pushed buffer from it.
2538
2539 ;; Both `prev-buffers' and `next-buffers' may reference killed buffers
2540 ;; if such a buffer was killed while the window was hidden within a
2541 ;; window configuration. Such killed buffers get removed whenever
2542 ;; `switch-to-prev-buffer' or `switch-to-next-buffer' encounter them.
2543
2544 ;; The following function is called by `set-window-buffer' _before_ it
2545 ;; replaces the buffer of the argument window with the new buffer.
2546 (defun record-window-buffer (&optional window)
2547 "Record WINDOW's buffer.
2548 WINDOW must be a live window and defaults to the selected one."
2549 (let* ((window (window-normalize-live-window window))
2550 (buffer (window-buffer window))
2551 (entry (assq buffer (window-prev-buffers window))))
2552 ;; Reset WINDOW's next buffers. If needed, they are resurrected by
2553 ;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
2554 (set-window-next-buffers window nil)
2555
2556 (when entry
2557 ;; Remove all entries for BUFFER from WINDOW's previous buffers.
2558 (set-window-prev-buffers
2559 window (assq-delete-all buffer (window-prev-buffers window))))
2560
2561 ;; Don't record insignificant buffers.
2562 (unless (eq (aref (buffer-name buffer) 0) ?\s)
2563 ;; Add an entry for buffer to WINDOW's previous buffers.
2564 (with-current-buffer buffer
2565 (let ((start (window-start window))
2566 (point (window-point-1 window)))
2567 (setq entry
2568 (cons buffer
2569 (if entry
2570 ;; We have an entry, update marker positions.
2571 (list (set-marker (nth 1 entry) start)
2572 (set-marker (nth 2 entry) point))
2573 ;; Make new markers.
2574 (list (copy-marker start)
2575 (copy-marker point)))))
2576
2577 (set-window-prev-buffers
2578 window (cons entry (window-prev-buffers window))))))))
2579
2580 (defun unrecord-window-buffer (&optional window buffer)
2581 "Unrecord BUFFER in WINDOW.
2582 WINDOW must be a live window and defaults to the selected one.
2583 BUFFER must be a live buffer and defaults to the buffer of
2584 WINDOW."
2585 (let* ((window (window-normalize-live-window window))
2586 (buffer (or buffer (window-buffer window))))
2587 (set-window-prev-buffers
2588 window (assq-delete-all buffer (window-prev-buffers window)))
2589 (set-window-next-buffers
2590 window (delq buffer (window-next-buffers window)))))
2591
2592 (defun set-window-buffer-start-and-point (window buffer &optional start point)
2593 "Set WINDOW's buffer to BUFFER.
2594 Optional argument START non-nil means set WINDOW's start position
2595 to START. Optional argument POINT non-nil means set WINDOW's
2596 point to POINT. If WINDOW is selected this also sets BUFFER's
2597 `point' to POINT. If WINDOW is selected and the buffer it showed
2598 before was current this also makes BUFFER the current buffer."
2599 (let ((selected (eq window (selected-window)))
2600 (current (eq (window-buffer window) (current-buffer))))
2601 (set-window-buffer window buffer)
2602 (when (and selected current)
2603 (set-buffer buffer))
2604 (when start
2605 ;; Don't force window-start here (even if POINT is nil).
2606 (set-window-start window start t))
2607 (when point
2608 (set-window-point-1 window point))))
2609
2610 (defun switch-to-prev-buffer (&optional window bury-or-kill)
2611 "In WINDOW switch to previous buffer.
2612 WINDOW must be a live window and defaults to the selected one.
2613
2614 Optional argument BURY-OR-KILL non-nil means the buffer currently
2615 shown in WINDOW is about to be buried or killed and consequently
2616 shall not be switched to in future invocations of this command."
2617 (interactive)
2618 (let* ((window (window-normalize-live-window window))
2619 (old-buffer (window-buffer window))
2620 ;; Save this since it's destroyed by `set-window-buffer'.
2621 (next-buffers (window-next-buffers window))
2622 entry new-buffer killed-buffers visible)
2623 (when (window-dedicated-p window)
2624 (error "Window %s is dedicated to buffer %s" window old-buffer))
2625
2626 (catch 'found
2627 ;; Scan WINDOW's previous buffers first, skipping entries of next
2628 ;; buffers.
2629 (dolist (entry (window-prev-buffers window))
2630 (when (and (setq new-buffer (car entry))
2631 (or (buffer-live-p new-buffer)
2632 (not (setq killed-buffers
2633 (cons new-buffer killed-buffers))))
2634 (not (eq new-buffer old-buffer))
2635 (or bury-or-kill
2636 (not (memq new-buffer next-buffers))))
2637 (set-window-buffer-start-and-point
2638 window new-buffer (nth 1 entry) (nth 2 entry))
2639 (throw 'found t)))
2640 ;; Scan reverted buffer list of WINDOW's frame next, skipping
2641 ;; entries of next buffers. Note that when we bury or kill a
2642 ;; buffer we don't reverse the global buffer list to avoid showing
2643 ;; a buried buffer instead. Otherwise, we must reverse the global
2644 ;; buffer list in order to make sure that switching to the
2645 ;; previous/next buffer traverse it in opposite directions.
2646 (dolist (buffer (if bury-or-kill
2647 (buffer-list (window-frame window))
2648 (nreverse (buffer-list (window-frame window)))))
2649 (when (and (buffer-live-p buffer)
2650 (not (eq buffer old-buffer))
2651 (not (eq (aref (buffer-name buffer) 0) ?\s))
2652 (or bury-or-kill (not (memq buffer next-buffers))))
2653 (if (get-buffer-window buffer)
2654 ;; Try to avoid showing a buffer visible in some other window.
2655 (setq visible buffer)
2656 (setq new-buffer buffer)
2657 (set-window-buffer-start-and-point window new-buffer)
2658 (throw 'found t))))
2659 (unless bury-or-kill
2660 ;; Scan reverted next buffers last (must not use nreverse
2661 ;; here!).
2662 (dolist (buffer (reverse next-buffers))
2663 ;; Actually, buffer _must_ be live here since otherwise it
2664 ;; would have been caught in the scan of previous buffers.
2665 (when (and (or (buffer-live-p buffer)
2666 (not (setq killed-buffers
2667 (cons buffer killed-buffers))))
2668 (not (eq buffer old-buffer))
2669 (setq entry (assq buffer (window-prev-buffers window))))
2670 (setq new-buffer buffer)
2671 (set-window-buffer-start-and-point
2672 window new-buffer (nth 1 entry) (nth 2 entry))
2673 (throw 'found t))))
2674
2675 ;; Show a buffer visible in another window.
2676 (when visible
2677 (setq new-buffer visible)
2678 (set-window-buffer-start-and-point window new-buffer)))
2679
2680 (if bury-or-kill
2681 ;; Remove `old-buffer' from WINDOW's previous and (restored list
2682 ;; of) next buffers.
2683 (progn
2684 (set-window-prev-buffers
2685 window (assq-delete-all old-buffer (window-prev-buffers window)))
2686 (set-window-next-buffers window (delq old-buffer next-buffers)))
2687 ;; Move `old-buffer' to head of WINDOW's restored list of next
2688 ;; buffers.
2689 (set-window-next-buffers
2690 window (cons old-buffer (delq old-buffer next-buffers))))
2691
2692 ;; Remove killed buffers from WINDOW's previous and next buffers.
2693 (when killed-buffers
2694 (dolist (buffer killed-buffers)
2695 (set-window-prev-buffers
2696 window (assq-delete-all buffer (window-prev-buffers window)))
2697 (set-window-next-buffers
2698 window (delq buffer (window-next-buffers window)))))
2699
2700 ;; Return new-buffer.
2701 new-buffer))
2702
2703 (defun switch-to-next-buffer (&optional window)
2704 "In WINDOW switch to next buffer.
2705 WINDOW must be a live window and defaults to the selected one."
2706 (interactive)
2707 (let* ((window (window-normalize-live-window window))
2708 (old-buffer (window-buffer window))
2709 (next-buffers (window-next-buffers window))
2710 new-buffer entry killed-buffers visible)
2711 (when (window-dedicated-p window)
2712 (error "Window %s is dedicated to buffer %s" window old-buffer))
2713
2714 (catch 'found
2715 ;; Scan WINDOW's next buffers first.
2716 (dolist (buffer next-buffers)
2717 (when (and (or (buffer-live-p buffer)
2718 (not (setq killed-buffers
2719 (cons buffer killed-buffers))))
2720 (not (eq buffer old-buffer))
2721 (setq entry (assq buffer (window-prev-buffers window))))
2722 (setq new-buffer buffer)
2723 (set-window-buffer-start-and-point
2724 window new-buffer (nth 1 entry) (nth 2 entry))
2725 (throw 'found t)))
2726 ;; Scan the buffer list of WINDOW's frame next, skipping previous
2727 ;; buffers entries.
2728 (dolist (buffer (buffer-list (window-frame window)))
2729 (when (and (buffer-live-p buffer) (not (eq buffer old-buffer))
2730 (not (eq (aref (buffer-name buffer) 0) ?\s))
2731 (not (assq buffer (window-prev-buffers window))))
2732 (if (get-buffer-window buffer)
2733 ;; Try to avoid showing a buffer visible in some other window.
2734 (setq visible buffer)
2735 (setq new-buffer buffer)
2736 (set-window-buffer-start-and-point window new-buffer)
2737 (throw 'found t))))
2738 ;; Scan WINDOW's reverted previous buffers last (must not use
2739 ;; nreverse here!)
2740 (dolist (entry (reverse (window-prev-buffers window)))
2741 (when (and (setq new-buffer (car entry))
2742 (or (buffer-live-p new-buffer)
2743 (not (setq killed-buffers
2744 (cons new-buffer killed-buffers))))
2745 (not (eq new-buffer old-buffer)))
2746 (set-window-buffer-start-and-point
2747 window new-buffer (nth 1 entry) (nth 2 entry))
2748 (throw 'found t)))
2749
2750 ;; Show a buffer visible in another window.
2751 (when visible
2752 (setq new-buffer visible)
2753 (set-window-buffer-start-and-point window new-buffer)))
2754
2755 ;; Remove `new-buffer' from and restore WINDOW's next buffers.
2756 (set-window-next-buffers window (delq new-buffer next-buffers))
2757
2758 ;; Remove killed buffers from WINDOW's previous and next buffers.
2759 (when killed-buffers
2760 (dolist (buffer killed-buffers)
2761 (set-window-prev-buffers
2762 window (assq-delete-all buffer (window-prev-buffers window)))
2763 (set-window-next-buffers
2764 window (delq buffer (window-next-buffers window)))))
2765
2766 ;; Return new-buffer.
2767 new-buffer))
2768
2769 (defun get-next-valid-buffer (list &optional buffer visible-ok frame)
2770 "Search LIST for a valid buffer to display in FRAME.
2771 Return nil when all buffers in LIST are undesirable for display,
2772 otherwise return the first suitable buffer in LIST.
2773
2774 Buffers not visible in windows are preferred to visible buffers,
2775 unless VISIBLE-OK is non-nil.
2776 If the optional argument FRAME is nil, it defaults to the selected frame.
2777 If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
2778 ;; This logic is more or less copied from other-buffer.
2779 (setq frame (or frame (selected-frame)))
2780 (let ((pred (frame-parameter frame 'buffer-predicate))
2781 found buf)
2782 (while (and (not found) list)
2783 (setq buf (car list))
2784 (if (and (not (eq buffer buf))
2785 (buffer-live-p buf)
2786 (or (null pred) (funcall pred buf))
2787 (not (eq (aref (buffer-name buf) 0) ?\s))
2788 (or visible-ok (null (get-buffer-window buf 'visible))))
2789 (setq found buf)
2790 (setq list (cdr list))))
2791 (car list)))
2792
2793 (defun last-buffer (&optional buffer visible-ok frame)
2794 "Return the last buffer in FRAME's buffer list.
2795 If BUFFER is the last buffer, return the preceding buffer
2796 instead. Buffers not visible in windows are preferred to visible
2797 buffers, unless optional argument VISIBLE-OK is non-nil.
2798 Optional third argument FRAME nil or omitted means use the
2799 selected frame's buffer list. If no such buffer exists, return
2800 the buffer `*scratch*', creating it if necessary."
2801 (setq frame (or frame (selected-frame)))
2802 (or (get-next-valid-buffer (nreverse (buffer-list frame))
2803 buffer visible-ok frame)
2804 (get-buffer "*scratch*")
2805 (let ((scratch (get-buffer-create "*scratch*")))
2806 (set-buffer-major-mode scratch)
2807 scratch)))
2808
2809 (defcustom frame-auto-hide-function #'iconify-frame
2810 "Function called to automatically hide frames.
2811 The function is called with one argument - a frame.
2812
2813 Functions affected by this option are those that bury a buffer
2814 shown in a separate frame like `quit-window' and `bury-buffer'."
2815 :type '(choice (const :tag "Iconify" iconify-frame)
2816 (const :tag "Delete" delete-frame)
2817 (const :tag "Do nothing" ignore)
2818 function)
2819 :group 'windows
2820 :group 'frames
2821 :version "24.1")
2822
2823 (defun window--delete (&optional window dedicated-only kill)
2824 "Delete WINDOW if possible.
2825 WINDOW must be a live window and defaults to the selected one.
2826 Optional argument DEDICATED-ONLY non-nil means to delete WINDOW
2827 only if it's dedicated to its buffer. Optional argument KILL
2828 means the buffer shown in window will be killed. Return non-nil
2829 if WINDOW gets deleted or its frame is auto-hidden."
2830 (setq window (window-normalize-live-window window))
2831 (unless (and dedicated-only (not (window-dedicated-p window)))
2832 (let* ((buffer (window-buffer window))
2833 (deletable (window-deletable-p window)))
2834 (cond
2835 ((eq deletable 'frame)
2836 (let ((frame (window-frame window)))
2837 (cond
2838 (kill
2839 (delete-frame frame))
2840 ((functionp frame-auto-hide-function)
2841 (funcall frame-auto-hide-function frame))))
2842 'frame)
2843 (deletable
2844 (delete-window window)
2845 t)))))
2846
2847 (defun bury-buffer (&optional buffer-or-name)
2848 "Put BUFFER-OR-NAME at the end of the list of all buffers.
2849 There it is the least likely candidate for `other-buffer' to
2850 return; thus, the least likely buffer for \\[switch-to-buffer] to
2851 select by default.
2852
2853 You can specify a buffer name as BUFFER-OR-NAME, or an actual
2854 buffer object. If BUFFER-OR-NAME is nil or omitted, bury the
2855 current buffer. Also, if BUFFER-OR-NAME is nil or omitted,
2856 remove the current buffer from the selected window if it is
2857 displayed there."
2858 (interactive)
2859 (let* ((buffer (window-normalize-buffer buffer-or-name)))
2860 ;; If `buffer-or-name' is not on the selected frame we unrecord it
2861 ;; although it's not "here" (call it a feature).
2862 (bury-buffer-internal buffer)
2863 ;; Handle case where `buffer-or-name' is nil and the current buffer
2864 ;; is shown in the selected window.
2865 (cond
2866 ((or buffer-or-name (not (eq buffer (window-buffer)))))
2867 ((window--delete nil t))
2868 (t
2869 ;; Switch to another buffer in window.
2870 (set-window-dedicated-p nil nil)
2871 (switch-to-prev-buffer nil 'bury)))
2872
2873 ;; Always return nil.
2874 nil))
2875
2876 (defun unbury-buffer ()
2877 "Switch to the last buffer in the buffer list."
2878 (interactive)
2879 (switch-to-buffer (last-buffer)))
2880
2881 (defun next-buffer ()
2882 "In selected window switch to next buffer."
2883 (interactive)
2884 (if (window-minibuffer-p)
2885 (error "Cannot switch buffers in minibuffer window"))
2886 (switch-to-next-buffer))
2887
2888 (defun previous-buffer ()
2889 "In selected window switch to previous buffer."
2890 (interactive)
2891 (if (window-minibuffer-p)
2892 (error "Cannot switch buffers in minibuffer window"))
2893 (switch-to-prev-buffer))
2894
2895 (defun delete-windows-on (&optional buffer-or-name frame)
2896 "Delete all windows showing BUFFER-OR-NAME.
2897 BUFFER-OR-NAME may be a buffer or the name of an existing buffer
2898 and defaults to the current buffer.
2899
2900 The following non-nil values of the optional argument FRAME
2901 have special meanings:
2902
2903 - t means consider all windows on the selected frame only.
2904
2905 - `visible' means consider all windows on all visible frames on
2906 the current terminal.
2907
2908 - 0 (the number zero) means consider all windows on all visible
2909 and iconified frames on the current terminal.
2910
2911 - A frame means consider all windows on that frame only.
2912
2913 Any other value of FRAME means consider all windows on all
2914 frames.
2915
2916 When a window showing BUFFER-OR-NAME is dedicated and the only
2917 window of its frame, that frame is deleted when there are other
2918 frames left."
2919 (interactive "BDelete windows on (buffer):\nP")
2920 (let ((buffer (window-normalize-buffer buffer-or-name))
2921 ;; Handle the "inverted" meaning of the FRAME argument wrt other
2922 ;; `window-list-1' based function.
2923 (all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
2924 (dolist (window (window-list-1 nil nil all-frames))
2925 (if (eq (window-buffer window) buffer)
2926 (let ((deletable (window-deletable-p window)))
2927 (cond
2928 ((and (eq deletable 'frame) (window-dedicated-p window))
2929 ;; Delete frame if and only if window is dedicated.
2930 (delete-frame (window-frame window)))
2931 ((eq deletable t)
2932 ;; Delete window.
2933 (delete-window window))
2934 (t
2935 ;; In window switch to previous buffer.
2936 (set-window-dedicated-p window nil)
2937 (switch-to-prev-buffer window 'bury))))
2938 ;; If a window doesn't show BUFFER, unrecord BUFFER in it.
2939 (unrecord-window-buffer window buffer)))))
2940
2941 (defun replace-buffer-in-windows (&optional buffer-or-name)
2942 "Replace BUFFER-OR-NAME with some other buffer in all windows showing it.
2943 BUFFER-OR-NAME may be a buffer or the name of an existing buffer
2944 and defaults to the current buffer.
2945
2946 When a window showing BUFFER-OR-NAME is dedicated, that window is
2947 deleted. If that window is the only window on its frame, the
2948 frame is deleted too when there are other frames left. If there
2949 are no other frames left, some other buffer is displayed in that
2950 window.
2951
2952 This function removes the buffer denoted by BUFFER-OR-NAME from
2953 all window-local buffer lists."
2954 (let ((buffer (window-normalize-buffer buffer-or-name)))
2955 (dolist (window (window-list-1 nil nil t))
2956 (if (eq (window-buffer window) buffer)
2957 (unless (window--delete window t t)
2958 ;; Switch to another buffer in window.
2959 (set-window-dedicated-p window nil)
2960 (switch-to-prev-buffer window 'kill))
2961 ;; Unrecord BUFFER in WINDOW.
2962 (unrecord-window-buffer window buffer)))))
2963
2964 (defun quit-window (&optional kill window)
2965 "Quit WINDOW and bury its buffer.
2966 WINDOW must be a live window and defaults to the selected one.
2967 With prefix argument KILL non-nil, kill the buffer instead of
2968 burying it.
2969
2970 According to information stored in WINDOW's `quit-restore' window
2971 parameter either \(1) delete WINDOW and its frame, \(2) delete
2972 WINDOW, \(3) restore the buffer previously displayed in WINDOW,
2973 or \(4) make WINDOW display some other buffer than the present
2974 one. If non-nil, reset `quit-restore' parameter to nil."
2975 (interactive "P")
2976 (setq window (window-normalize-live-window window))
2977 (let* ((buffer (window-buffer window))
2978 (quit-restore (window-parameter window 'quit-restore))
2979 (prev-buffer
2980 (let* ((prev-buffers (window-prev-buffers window))
2981 (prev-buffer (caar prev-buffers)))
2982 (and (or (not (eq prev-buffer buffer))
2983 (and (cdr prev-buffers)
2984 (not (eq (setq prev-buffer (cadr prev-buffers))
2985 buffer))))
2986 prev-buffer)))
2987 quad resize)
2988 (cond
2989 ((and (not prev-buffer)
2990 (memq (nth 1 quit-restore) '(window frame))
2991 (eq (nth 3 quit-restore) buffer)
2992 ;; Delete WINDOW if possible.
2993 (window--delete window nil kill))
2994 ;; If the previously selected window is still alive, select it.
2995 (when (window-live-p (nth 2 quit-restore))
2996 (select-window (nth 2 quit-restore))))
2997 ((and (listp (setq quad (nth 1 quit-restore)))
2998 (buffer-live-p (car quad))
2999 (eq (nth 3 quit-restore) buffer))
3000 ;; Show another buffer stored in quit-restore parameter.
3001 (setq resize (with-current-buffer buffer
3002 (and temp-buffer-resize-mode
3003 (/= (nth 3 quad) (window-total-size window)))))
3004 (set-window-dedicated-p window nil)
3005 (when resize
3006 ;; Try to resize WINDOW to its old height but don't signal an
3007 ;; error.
3008 (condition-case nil
3009 (window-resize window (- (nth 3 quad) (window-total-size window)))
3010 (error nil)))
3011 ;; Restore WINDOW's previous buffer, start and point position.
3012 (set-window-buffer-start-and-point
3013 window (nth 0 quad) (nth 1 quad) (nth 2 quad))
3014 ;; Unrecord WINDOW's buffer here (Bug#9937) to make sure it's not
3015 ;; re-recorded by `set-window-buffer'.
3016 (unrecord-window-buffer window buffer)
3017 ;; Reset the quit-restore parameter.
3018 (set-window-parameter window 'quit-restore nil)
3019 ;; Select old window.
3020 (when (window-live-p (nth 2 quit-restore))
3021 (select-window (nth 2 quit-restore))))
3022 (t
3023 ;; Show some other buffer in WINDOW and reset the quit-restore
3024 ;; parameter.
3025 (set-window-parameter window 'quit-restore nil)
3026 ;; Make sure that WINDOW is no more dedicated.
3027 (set-window-dedicated-p window nil)
3028 (switch-to-prev-buffer window 'bury-or-kill)))
3029
3030 ;; Kill WINDOW's old-buffer if requested
3031 (if kill
3032 (kill-buffer buffer)
3033 (bury-buffer-internal buffer))))
3034
3035 (defun quit-windows-on (&optional buffer-or-name kill frame)
3036 "Quit all windows showing BUFFER-OR-NAME.
3037 BUFFER-OR-NAME may be a buffer or the name of an existing buffer
3038 and defaults to the current buffer. Optional argument KILL
3039 non-nil means to kill BUFFER-OR-NAME. KILL nil means to bury
3040 BUFFER-OR-NAME. Optional argument FRAME is handled as by
3041 `delete-windows-on'.
3042
3043 This function calls `quit-window' on all candidate windows
3044 showing BUFFER-OR-NAME."
3045 (interactive "BQuit windows on (buffer):\nP")
3046 (let ((buffer (window-normalize-buffer buffer-or-name))
3047 ;; Handle the "inverted" meaning of the FRAME argument wrt other
3048 ;; `window-list-1' based function.
3049 (all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
3050 (dolist (window (window-list-1 nil nil all-frames))
3051 (if (eq (window-buffer window) buffer)
3052 (quit-window kill window)
3053 ;; If a window doesn't show BUFFER, unrecord BUFFER in it.
3054 (unrecord-window-buffer window buffer)))))
3055 \f
3056 ;;; Splitting windows.
3057 (defsubst window-split-min-size (&optional horizontal)
3058 "Return minimum height of any window when splitting windows.
3059 Optional argument HORIZONTAL non-nil means return minimum width."
3060 (if horizontal
3061 (max window-min-width window-safe-min-width)
3062 (max window-min-height window-safe-min-height)))
3063
3064 (defun split-window (&optional window size side)
3065 "Make a new window adjacent to WINDOW.
3066 WINDOW can be any window and defaults to the selected one.
3067 Return the new window which is always a live window.
3068
3069 Optional argument SIZE a positive number means make WINDOW SIZE
3070 lines or columns tall. If SIZE is negative, make the new window
3071 -SIZE lines or columns tall. If and only if SIZE is non-nil, its
3072 absolute value can be less than `window-min-height' or
3073 `window-min-width'; so this command can make a new window as
3074 small as one line or two columns. SIZE defaults to half of
3075 WINDOW's size. Interactively, SIZE is the prefix argument.
3076
3077 Optional third argument SIDE nil (or `below') specifies that the
3078 new window shall be located below WINDOW. SIDE `above' means the
3079 new window shall be located above WINDOW. In both cases SIZE
3080 specifies the new number of lines for WINDOW \(or the new window
3081 if SIZE is negative) including space reserved for the mode and/or
3082 header line.
3083
3084 SIDE t (or `right') specifies that the new window shall be
3085 located on the right side of WINDOW. SIDE `left' means the new
3086 window shall be located on the left of WINDOW. In both cases
3087 SIZE specifies the new number of columns for WINDOW \(or the new
3088 window provided SIZE is negative) including space reserved for
3089 fringes and the scrollbar or a divider column. Any other non-nil
3090 value for SIDE is currently handled like t (or `right').
3091
3092 If the variable `ignore-window-parameters' is non-nil or the
3093 `split-window' parameter of WINDOW equals t, do not process any
3094 parameters of WINDOW. Otherwise, if the `split-window' parameter
3095 of WINDOW specifies a function, call that function with all three
3096 arguments and return the value returned by that function.
3097
3098 Otherwise, if WINDOW is part of an atomic window, \"split\" the
3099 root of that atomic window. The new window does not become a
3100 member of that atomic window.
3101
3102 If WINDOW is live, properties of the new window like margins and
3103 scrollbars are inherited from WINDOW. If WINDOW is an internal
3104 window, these properties as well as the buffer displayed in the
3105 new window are inherited from the window selected on WINDOW's
3106 frame. The selected window is not changed by this function."
3107 (interactive "i")
3108 (setq window (window-normalize-any-window window))
3109 (let* ((side (cond
3110 ((not side) 'below)
3111 ((memq side '(below above right left)) side)
3112 (t 'right)))
3113 (horizontal (not (memq side '(nil below above))))
3114 (frame (window-frame window))
3115 (parent (window-parent window))
3116 (function (window-parameter window 'split-window))
3117 (window-side (window-parameter window 'window-side))
3118 ;; Rebind `window-nest' since in some cases we may have to
3119 ;; override its value.
3120 (window-nest window-nest)
3121 atom-root)
3122
3123 (window-check frame)
3124 (catch 'done
3125 (cond
3126 ;; Ignore window parameters if either `ignore-window-parameters'
3127 ;; is t or the `split-window' parameter equals t.
3128 ((or ignore-window-parameters (eq function t)))
3129 ((functionp function)
3130 ;; The `split-window' parameter specifies the function to call.
3131 ;; If that function is `ignore', do nothing.
3132 (throw 'done (funcall function window size side)))
3133 ;; If WINDOW is a subwindow of an atomic window, split the root
3134 ;; window of that atomic window instead.
3135 ((and (window-parameter window 'window-atom)
3136 (setq atom-root (window-atom-root window))
3137 (not (eq atom-root window)))
3138 (throw 'done (split-window atom-root size side))))
3139
3140 (when (and window-side
3141 (or (not parent)
3142 (not (window-parameter parent 'window-side))))
3143 ;; WINDOW is a side root window. To make sure that a new parent
3144 ;; window gets created set `window-nest' to t.
3145 (setq window-nest t))
3146
3147 (when (and window-splits size (> size 0))
3148 ;; If `window-splits' is non-nil and SIZE is a non-negative
3149 ;; integer, we cannot reasonably resize other windows. Rather
3150 ;; bind `window-nest' to t to make sure that subsequent window
3151 ;; deletions are handled correctly.
3152 (setq window-nest t))
3153
3154 (let* ((parent-size
3155 ;; `parent-size' is the size of WINDOW's parent, provided
3156 ;; it has one.
3157 (when parent (window-total-size parent horizontal)))
3158 ;; `resize' non-nil means we are supposed to resize other
3159 ;; windows in WINDOW's combination.
3160 (resize
3161 (and window-splits (not window-nest)
3162 ;; Resize makes sense in iso-combinations only.
3163 (window-combined-p window horizontal)))
3164 ;; `old-size' is the current size of WINDOW.
3165 (old-size (window-total-size window horizontal))
3166 ;; `new-size' is the specified or calculated size of the
3167 ;; new window.
3168 (new-size
3169 (cond
3170 ((not size)
3171 (max (window-split-min-size horizontal)
3172 (if resize
3173 ;; When resizing try to give the new window the
3174 ;; average size of a window in its combination.
3175 (min (- parent-size
3176 (window-min-size parent horizontal))
3177 (/ parent-size
3178 (1+ (window-combinations
3179 parent horizontal))))
3180 ;; Else try to give the new window half the size
3181 ;; of WINDOW (plus an eventual odd line).
3182 (+ (/ old-size 2) (% old-size 2)))))
3183 ((>= size 0)
3184 ;; SIZE non-negative specifies the new size of WINDOW.
3185
3186 ;; Note: Specifying a non-negative SIZE is practically
3187 ;; always done as workaround for making the new window
3188 ;; appear above or on the left of the new window (the
3189 ;; ispell window is a typical example of that). In all
3190 ;; these cases the SIDE argument should be set to 'above
3191 ;; or 'left in order to support the 'resize option.
3192 ;; Here we have to nest the windows instead, see above.
3193 (- old-size size))
3194 (t
3195 ;; SIZE negative specifies the size of the new window.
3196 (- size))))
3197 new-parent new-normal)
3198
3199 ;; Check SIZE.
3200 (cond
3201 ((not size)
3202 (cond
3203 (resize
3204 ;; SIZE unspecified, resizing.
3205 (when (and (not (window-sizable-p parent (- new-size) horizontal))
3206 ;; Try again with minimum split size.
3207 (setq new-size
3208 (max new-size (window-split-min-size horizontal)))
3209 (not (window-sizable-p parent (- new-size) horizontal)))
3210 (error "Window %s too small for splitting" parent)))
3211 ((> (+ new-size (window-min-size window horizontal)) old-size)
3212 ;; SIZE unspecified, no resizing.
3213 (error "Window %s too small for splitting" window))))
3214 ((and (>= size 0)
3215 (or (>= size old-size)
3216 (< new-size (if horizontal
3217 window-safe-min-width
3218 window-safe-min-width))))
3219 ;; SIZE specified as new size of old window. If the new size
3220 ;; is larger than the old size or the size of the new window
3221 ;; would be less than the safe minimum, signal an error.
3222 (error "Window %s too small for splitting" window))
3223 (resize
3224 ;; SIZE specified, resizing.
3225 (unless (window-sizable-p parent (- new-size) horizontal)
3226 ;; If we cannot resize the parent give up.
3227 (error "Window %s too small for splitting" parent)))
3228 ((or (< new-size
3229 (if horizontal window-safe-min-width window-safe-min-height))
3230 (< (- old-size new-size)
3231 (if horizontal window-safe-min-width window-safe-min-height)))
3232 ;; SIZE specification violates minimum size restrictions.
3233 (error "Window %s too small for splitting" window)))
3234
3235 (window--resize-reset frame horizontal)
3236
3237 (setq new-parent
3238 ;; Make new-parent non-nil if we need a new parent window;
3239 ;; either because we want to nest or because WINDOW is not
3240 ;; iso-combined.
3241 (or window-nest (not (window-combined-p window horizontal))))
3242 (setq new-normal
3243 ;; Make new-normal the normal size of the new window.
3244 (cond
3245 (size (/ (float new-size) (if new-parent old-size parent-size)))
3246 (new-parent 0.5)
3247 (resize (/ 1.0 (1+ (window-combinations parent horizontal))))
3248 (t (/ (window-normal-size window horizontal) 2.0))))
3249
3250 (if resize
3251 ;; Try to get space from OLD's siblings. We could go "up" and
3252 ;; try getting additional space from surrounding windows but
3253 ;; we won't be able to return space to those windows when we
3254 ;; delete the one we create here. Hence we do not go up.
3255 (progn
3256 (window--resize-subwindows parent (- new-size) horizontal)
3257 (let* ((normal (- 1.0 new-normal))
3258 (sub (window-child parent)))
3259 (while sub
3260 (set-window-new-normal
3261 sub (* (window-normal-size sub horizontal) normal))
3262 (setq sub (window-right sub)))))
3263 ;; Get entire space from WINDOW.
3264 (set-window-new-total window (- old-size new-size))
3265 (window--resize-this-window window (- new-size) horizontal)
3266 (set-window-new-normal
3267 window (- (if new-parent 1.0 (window-normal-size window horizontal))
3268 new-normal)))
3269
3270 (let* ((new (split-window-internal window new-size side new-normal)))
3271 ;; Inherit window-side parameters, if any.
3272 (when (and window-side new-parent)
3273 (set-window-parameter (window-parent new) 'window-side window-side)
3274 (set-window-parameter new 'window-side window-side))
3275
3276 (run-window-configuration-change-hook frame)
3277 (window-check frame)
3278 ;; Always return the new window.
3279 new)))))
3280
3281 ;; I think this should be the default; I think people will prefer it--rms.
3282 (defcustom split-window-keep-point t
3283 "If non-nil, \\[split-window-below] preserves point in the new window.
3284 If nil, adjust point in the two windows to minimize redisplay.
3285 This option applies only to `split-window-below' and functions
3286 that call it. The low-level `split-window' function always keeps
3287 the original point in both windows."
3288 :type 'boolean
3289 :group 'windows)
3290
3291 (defun split-window-below (&optional size)
3292 "Split the selected window into two windows, one above the other.
3293 The selected window is above. The newly split-off window is
3294 below, and displays the same buffer. Return the new window.
3295
3296 If optional argument SIZE is omitted or nil, both windows get the
3297 same height, or close to it. If SIZE is positive, the upper
3298 \(selected) window gets SIZE lines. If SIZE is negative, the
3299 lower (new) window gets -SIZE lines.
3300
3301 If the variable `split-window-keep-point' is non-nil, both
3302 windows get the same value of point as the selected window.
3303 Otherwise, the window starts are chosen so as to minimize the
3304 amount of redisplay; this is convenient on slow terminals."
3305 (interactive "P")
3306 (let ((old-window (selected-window))
3307 (old-point (point))
3308 (size (and size (prefix-numeric-value size)))
3309 moved-by-window-height moved new-window bottom)
3310 (when (and size (< size 0) (< (- size) window-min-height))
3311 ;; `split-window' would not signal an error here.
3312 (error "Size of new window too small"))
3313 (setq new-window (split-window nil size))
3314 (unless split-window-keep-point
3315 (with-current-buffer (window-buffer)
3316 (goto-char (window-start))
3317 (setq moved (vertical-motion (window-height)))
3318 (set-window-start new-window (point))
3319 (when (> (point) (window-point new-window))
3320 (set-window-point new-window (point)))
3321 (when (= moved (window-height))
3322 (setq moved-by-window-height t)
3323 (vertical-motion -1))
3324 (setq bottom (point)))
3325 (and moved-by-window-height
3326 (<= bottom (point))
3327 (set-window-point old-window (1- bottom)))
3328 (and moved-by-window-height
3329 (<= (window-start new-window) old-point)
3330 (set-window-point new-window old-point)
3331 (select-window new-window)))
3332 ;; Always copy quit-restore parameter in interactive use.
3333 (let ((quit-restore (window-parameter old-window 'quit-restore)))
3334 (when quit-restore
3335 (set-window-parameter new-window 'quit-restore quit-restore)))
3336 new-window))
3337
3338 (defalias 'split-window-vertically 'split-window-below)
3339
3340 (defun split-window-right (&optional size)
3341 "Split the selected window into two side-by-side windows.
3342 The selected window is on the left. The newly split-off window
3343 is on the right, and displays the same buffer. Return the new
3344 window.
3345
3346 If optional argument SIZE is omitted or nil, both windows get the
3347 same width, or close to it. If SIZE is positive, the left-hand
3348 \(selected) window gets SIZE columns. If SIZE is negative, the
3349 right-hand (new) window gets -SIZE columns. Here, SIZE includes
3350 the width of the window's scroll bar; if there are no scroll
3351 bars, it includes the width of the divider column to the window's
3352 right, if any."
3353 (interactive "P")
3354 (let ((old-window (selected-window))
3355 (size (and size (prefix-numeric-value size)))
3356 new-window)
3357 (when (and size (< size 0) (< (- size) window-min-width))
3358 ;; `split-window' would not signal an error here.
3359 (error "Size of new window too small"))
3360 (setq new-window (split-window nil size t))
3361 ;; Always copy quit-restore parameter in interactive use.
3362 (let ((quit-restore (window-parameter old-window 'quit-restore)))
3363 (when quit-restore
3364 (set-window-parameter new-window 'quit-restore quit-restore)))
3365 new-window))
3366
3367 (defalias 'split-window-horizontally 'split-window-right)
3368 \f
3369 ;;; Balancing windows.
3370
3371 ;; The following routine uses the recycled code from an old version of
3372 ;; `window--resize-subwindows'. It's not very pretty, but coding it the way the
3373 ;; new `window--resize-subwindows' code does would hardly make it any shorter or
3374 ;; more readable (FWIW we'd need three loops - one to calculate the
3375 ;; minimum sizes per window, one to enlarge or shrink windows until the
3376 ;; new parent-size matches, and one where we shrink the largest/enlarge
3377 ;; the smallest window).
3378 (defun balance-windows-2 (window horizontal)
3379 "Subroutine of `balance-windows-1'.
3380 WINDOW must be a vertical combination (horizontal if HORIZONTAL
3381 is non-nil."
3382 (let* ((first (window-child window))
3383 (sub first)
3384 (number-of-children 0)
3385 (parent-size (window-new-total window))
3386 (total-sum parent-size)
3387 found failed size sub-total sub-delta sub-amount rest)
3388 (while sub
3389 (setq number-of-children (1+ number-of-children))
3390 (when (window-size-fixed-p sub horizontal)
3391 (setq total-sum
3392 (- total-sum (window-total-size sub horizontal)))
3393 (set-window-new-normal sub 'ignore))
3394 (setq sub (window-right sub)))
3395
3396 (setq failed t)
3397 (while (and failed (> number-of-children 0))
3398 (setq size (/ total-sum number-of-children))
3399 (setq failed nil)
3400 (setq sub first)
3401 (while (and sub (not failed))
3402 ;; Ignore subwindows that should be ignored or are stuck.
3403 (unless (window--resize-subwindows-skip-p sub)
3404 (setq found t)
3405 (setq sub-total (window-total-size sub horizontal))
3406 (setq sub-delta (- size sub-total))
3407 (setq sub-amount
3408 (window-sizable sub sub-delta horizontal))
3409 ;; Register the new total size for this subwindow.
3410 (set-window-new-total sub (+ sub-total sub-amount))
3411 (unless (= sub-amount sub-delta)
3412 (setq total-sum (- total-sum sub-total sub-amount))
3413 (setq number-of-children (1- number-of-children))
3414 ;; We failed and need a new round.
3415 (setq failed t)
3416 (set-window-new-normal sub 'skip)))
3417 (setq sub (window-right sub))))
3418
3419 (setq rest (% total-sum number-of-children))
3420 ;; Fix rounding by trying to enlarge non-stuck windows by one line
3421 ;; (column) until `rest' is zero.
3422 (setq sub first)
3423 (while (and sub (> rest 0))
3424 (unless (window--resize-subwindows-skip-p window)
3425 (set-window-new-total sub 1 t)
3426 (setq rest (1- rest)))
3427 (setq sub (window-right sub)))
3428
3429 ;; Fix rounding by trying to enlarge stuck windows by one line
3430 ;; (column) until `rest' equals zero.
3431 (setq sub first)
3432 (while (and sub (> rest 0))
3433 (unless (eq (window-new-normal sub) 'ignore)
3434 (set-window-new-total sub 1 t)
3435 (setq rest (1- rest)))
3436 (setq sub (window-right sub)))
3437
3438 (setq sub first)
3439 (while sub
3440 ;; Record new normal sizes.
3441 (set-window-new-normal
3442 sub (/ (if (eq (window-new-normal sub) 'ignore)
3443 (window-total-size sub horizontal)
3444 (window-new-total sub))
3445 (float parent-size)))
3446 ;; Recursively balance each subwindow's subwindows.
3447 (balance-windows-1 sub horizontal)
3448 (setq sub (window-right sub)))))
3449
3450 (defun balance-windows-1 (window &optional horizontal)
3451 "Subroutine of `balance-windows'."
3452 (if (window-child window)
3453 (let ((sub (window-child window)))
3454 (if (window-combined-p sub horizontal)
3455 (balance-windows-2 window horizontal)
3456 (let ((size (window-new-total window)))
3457 (while sub
3458 (set-window-new-total sub size)
3459 (balance-windows-1 sub horizontal)
3460 (setq sub (window-right sub))))))))
3461
3462 (defun balance-windows (&optional window-or-frame)
3463 "Balance the sizes of subwindows of WINDOW-OR-FRAME.
3464 WINDOW-OR-FRAME is optional and defaults to the selected frame.
3465 If WINDOW-OR-FRAME denotes a frame, balance the sizes of all
3466 subwindows of that frame's root window. If WINDOW-OR-FRAME
3467 denots a window, balance the sizes of all subwindows of that
3468 window."
3469 (interactive)
3470 (let* ((window
3471 (cond
3472 ((or (not window-or-frame)
3473 (frame-live-p window-or-frame))
3474 (frame-root-window window-or-frame))
3475 ((or (window-live-p window-or-frame)
3476 (window-child window-or-frame))
3477 window-or-frame)
3478 (t
3479 (error "Not a window or frame %s" window-or-frame))))
3480 (frame (window-frame window)))
3481 ;; Balance vertically.
3482 (window--resize-reset (window-frame window))
3483 (balance-windows-1 window)
3484 (window-resize-apply frame)
3485 ;; Balance horizontally.
3486 (window--resize-reset (window-frame window) t)
3487 (balance-windows-1 window t)
3488 (window-resize-apply frame t)))
3489
3490 (defun window-fixed-size-p (&optional window direction)
3491 "Return t if WINDOW cannot be resized in DIRECTION.
3492 WINDOW defaults to the selected window. DIRECTION can be
3493 nil (i.e. any), `height' or `width'."
3494 (with-current-buffer (window-buffer window)
3495 (when (and (boundp 'window-size-fixed) window-size-fixed)
3496 (not (and direction
3497 (member (cons direction window-size-fixed)
3498 '((height . width) (width . height))))))))
3499
3500 ;;; A different solution to balance-windows.
3501 (defvar window-area-factor 1
3502 "Factor by which the window area should be over-estimated.
3503 This is used by `balance-windows-area'.
3504 Changing this globally has no effect.")
3505 (make-variable-buffer-local 'window-area-factor)
3506
3507 (defun balance-windows-area-adjust (window delta horizontal)
3508 "Wrapper around `window-resize' with error checking.
3509 Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
3510 ;; `window-resize' may fail if delta is too large.
3511 (while (>= (abs delta) 1)
3512 (condition-case nil
3513 (progn
3514 (window-resize window delta horizontal)
3515 (setq delta 0))
3516 (error
3517 ;;(message "adjust: %s" (error-message-string err))
3518 (setq delta (/ delta 2))))))
3519
3520 (defun balance-windows-area ()
3521 "Make all visible windows the same area (approximately).
3522 See also `window-area-factor' to change the relative size of
3523 specific buffers."
3524 (interactive)
3525 (let* ((unchanged 0) (carry 0) (round 0)
3526 ;; Remove fixed-size windows.
3527 (wins (delq nil (mapcar (lambda (win)
3528 (if (not (window-fixed-size-p win)) win))
3529 (window-list nil 'nomini))))
3530 (changelog nil)
3531 next)
3532 ;; Resizing a window changes the size of surrounding windows in complex
3533 ;; ways, so it's difficult to balance them all. The introduction of
3534 ;; `adjust-window-trailing-edge' made it a bit easier, but it is still
3535 ;; very difficult to do. `balance-window' above takes an off-line
3536 ;; approach: get the whole window tree, then balance it, then try to
3537 ;; adjust the windows so they fit the result.
3538 ;; Here, instead, we take a "local optimization" approach, where we just
3539 ;; go through all the windows several times until nothing needs to be
3540 ;; changed. The main problem with this approach is that it's difficult
3541 ;; to make sure it terminates, so we use some heuristic to try and break
3542 ;; off infinite loops.
3543 ;; After a round without any change, we allow a second, to give a chance
3544 ;; to the carry to propagate a minor imbalance from the end back to
3545 ;; the beginning.
3546 (while (< unchanged 2)
3547 ;; (message "New round")
3548 (setq unchanged (1+ unchanged) round (1+ round))
3549 (dolist (win wins)
3550 (setq next win)
3551 (while (progn (setq next (next-window next))
3552 (window-fixed-size-p next)))
3553 ;; (assert (eq next (or (cadr (member win wins)) (car wins))))
3554 (let* ((horiz
3555 (< (car (window-edges win)) (car (window-edges next))))
3556 (areadiff (/ (- (* (window-height next) (window-width next)
3557 (buffer-local-value 'window-area-factor
3558 (window-buffer next)))
3559 (* (window-height win) (window-width win)
3560 (buffer-local-value 'window-area-factor
3561 (window-buffer win))))
3562 (max (buffer-local-value 'window-area-factor
3563 (window-buffer win))
3564 (buffer-local-value 'window-area-factor
3565 (window-buffer next)))))
3566 (edgesize (if horiz
3567 (+ (window-height win) (window-height next))
3568 (+ (window-width win) (window-width next))))
3569 (diff (/ areadiff edgesize)))
3570 (when (zerop diff)
3571 ;; Maybe diff is actually closer to 1 than to 0.
3572 (setq diff (/ (* 3 areadiff) (* 2 edgesize))))
3573 (when (and (zerop diff) (not (zerop areadiff)))
3574 (setq diff (/ (+ areadiff carry) edgesize))
3575 ;; Change things smoothly.
3576 (if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
3577 (if (zerop diff)
3578 ;; Make sure negligible differences don't accumulate to
3579 ;; become significant.
3580 (setq carry (+ carry areadiff))
3581 ;; This used `adjust-window-trailing-edge' before and uses
3582 ;; `window-resize' now. Error wrapping is still needed.
3583 (balance-windows-area-adjust win diff horiz)
3584 ;; (sit-for 0.5)
3585 (let ((change (cons win (window-edges win))))
3586 ;; If the same change has been seen already for this window,
3587 ;; we're most likely in an endless loop, so don't count it as
3588 ;; a change.
3589 (unless (member change changelog)
3590 (push change changelog)
3591 (setq unchanged 0 carry 0)))))))
3592 ;; We've now basically balanced all the windows.
3593 ;; But there may be some minor off-by-one imbalance left over,
3594 ;; so let's do some fine tuning.
3595 ;; (bw-finetune wins)
3596 ;; (message "Done in %d rounds" round)
3597 ))
3598
3599 ;;; Window states, how to get them and how to put them in a window.
3600 (defsubst window-list-no-nils (&rest args)
3601 "Like LIST but do not add nil elements of ARGS."
3602 (delq nil (apply 'list args)))
3603
3604 (defvar window-state-ignored-parameters '(quit-restore)
3605 "List of window parameters ignored by `window-state-get'.")
3606
3607 (defun window-state-get-1 (window &optional markers)
3608 "Helper function for `window-state-get'."
3609 (let* ((type
3610 (cond
3611 ((window-top-child window) 'vc)
3612 ((window-left-child window) 'hc)
3613 (t 'leaf)))
3614 (buffer (window-buffer window))
3615 (selected (eq window (selected-window)))
3616 (head
3617 (window-list-no-nils
3618 type
3619 (unless (window-next-sibling window) (cons 'last t))
3620 (cons 'total-height (window-total-size window))
3621 (cons 'total-width (window-total-size window t))
3622 (cons 'normal-height (window-normal-size window))
3623 (cons 'normal-width (window-normal-size window t))
3624 (cons 'splits (window-splits window))
3625 (cons 'nest (window-nest window))
3626 (let (list)
3627 (dolist (parameter (window-parameters window))
3628 (unless (memq (car parameter)
3629 window-state-ignored-parameters)
3630 (setq list (cons parameter list))))
3631 (unless (window-parameter window 'clone-of)
3632 ;; Make a clone-of parameter.
3633 (setq list (cons (cons 'clone-of window) list)))
3634 (when list
3635 (cons 'parameters list)))
3636 (when buffer
3637 ;; All buffer related things go in here - make the buffer
3638 ;; current when retrieving `point' and `mark'.
3639 (with-current-buffer (window-buffer window)
3640 (let ((point (window-point-1 window))
3641 (start (window-start window))
3642 (mark (mark)))
3643 (window-list-no-nils
3644 'buffer (buffer-name buffer)
3645 (cons 'selected selected)
3646 (when window-size-fixed (cons 'size-fixed window-size-fixed))
3647 (cons 'hscroll (window-hscroll window))
3648 (cons 'fringes (window-fringes window))
3649 (cons 'margins (window-margins window))
3650 (cons 'scroll-bars (window-scroll-bars window))
3651 (cons 'vscroll (window-vscroll window))
3652 (cons 'dedicated (window-dedicated-p window))
3653 (cons 'point (if markers (copy-marker point) point))
3654 (cons 'start (if markers (copy-marker start) start))
3655 (when mark
3656 (cons 'mark (if markers (copy-marker mark) mark)))))))))
3657 (tail
3658 (when (memq type '(vc hc))
3659 (let (list)
3660 (setq window (window-child window))
3661 (while window
3662 (setq list (cons (window-state-get-1 window markers) list))
3663 (setq window (window-right window)))
3664 (nreverse list)))))
3665 (append head tail)))
3666
3667 (defun window-state-get (&optional window markers)
3668 "Return state of WINDOW as a Lisp object.
3669 WINDOW can be any window and defaults to the root window of the
3670 selected frame.
3671
3672 Optional argument MARKERS non-nil means use markers for sampling
3673 positions like `window-point' or `window-start'. MARKERS should
3674 be non-nil only if the value is used for putting the state back
3675 in the same session (note that markers slow down processing).
3676
3677 The return value can be used as argument for `window-state-put'
3678 to put the state recorded here into an arbitrary window. The
3679 value can be also stored on disk and read back in a new session."
3680 (setq window
3681 (if window
3682 (if (window-valid-p window)
3683 window
3684 (error "%s is not a live or internal window" window))
3685 (frame-root-window)))
3686 ;; The return value is a cons whose car specifies some constraints on
3687 ;; the size of WINDOW. The cdr lists the states of the subwindows of
3688 ;; WINDOW.
3689 (cons
3690 ;; Frame related things would go into a function, say `frame-state',
3691 ;; calling `window-state-get' to insert the frame's root window.
3692 (window-list-no-nils
3693 (cons 'min-height (window-min-size window))
3694 (cons 'min-width (window-min-size window t))
3695 (cons 'min-height-ignore (window-min-size window nil t))
3696 (cons 'min-width-ignore (window-min-size window t t))
3697 (cons 'min-height-safe (window-min-size window nil 'safe))
3698 (cons 'min-width-safe (window-min-size window t 'safe))
3699 ;; These are probably not needed.
3700 (when (window-size-fixed-p window) (cons 'fixed-height t))
3701 (when (window-size-fixed-p window t) (cons 'fixed-width t)))
3702 (window-state-get-1 window markers)))
3703
3704 (defvar window-state-put-list nil
3705 "Helper variable for `window-state-put'.")
3706
3707 (defun window-state-put-1 (state &optional window ignore totals)
3708 "Helper function for `window-state-put'."
3709 (let ((type (car state)))
3710 (setq state (cdr state))
3711 (cond
3712 ((eq type 'leaf)
3713 ;; For a leaf window just add unprocessed entries to
3714 ;; `window-state-put-list'.
3715 (setq window-state-put-list
3716 (cons (cons window state) window-state-put-list)))
3717 ((memq type '(vc hc))
3718 (let* ((horizontal (eq type 'hc))
3719 (total (window-total-size window horizontal))
3720 (first t)
3721 size new)
3722 (dolist (item state)
3723 ;; Find the next child window. WINDOW always points to the
3724 ;; real window that we want to fill with what we find here.
3725 (when (memq (car item) '(leaf vc hc))
3726 (if (assq 'last item)
3727 ;; The last child window. Below `window-state-put-1'
3728 ;; will put into it whatever ITEM has in store.
3729 (setq new nil)
3730 ;; Not the last child window, prepare for splitting
3731 ;; WINDOW. SIZE is the new (and final) size of the old
3732 ;; window.
3733 (setq size
3734 (if totals
3735 ;; Use total size.
3736 (cdr (assq (if horizontal 'total-width 'total-height) item))
3737 ;; Use normalized size and round.
3738 (round (* total
3739 (cdr (assq
3740 (if horizontal 'normal-width 'normal-height)
3741 item))))))
3742
3743 ;; Use safe sizes, we try to resize later.
3744 (setq size (max size (if horizontal
3745 window-safe-min-height
3746 window-safe-min-width)))
3747
3748 (if (window-sizable-p window (- size) horizontal 'safe)
3749 (let* ((window-nest (assq 'nest item)))
3750 ;; We must inherit the nesting, otherwise we might mess
3751 ;; up handling of atomic and side window.
3752 (setq new (split-window window size horizontal)))
3753 ;; Give up if we can't resize window down to safe sizes.
3754 (error "Cannot resize window %s" window))
3755
3756 (when first
3757 (setq first nil)
3758 ;; When creating the first child window add for parent
3759 ;; unprocessed entries to `window-state-put-list'.
3760 (setq window-state-put-list
3761 (cons (cons (window-parent window) state)
3762 window-state-put-list))))
3763
3764 ;; Now process the current window (either the one we've just
3765 ;; split or the last child of its parent).
3766 (window-state-put-1 item window ignore totals)
3767 ;; Continue with the last window split off.
3768 (setq window new))))))))
3769
3770 (defun window-state-put-2 (ignore)
3771 "Helper function for `window-state-put'."
3772 (dolist (item window-state-put-list)
3773 (let ((window (car item))
3774 (splits (cdr (assq 'splits item)))
3775 (nest (cdr (assq 'nest item)))
3776 (parameters (cdr (assq 'parameters item)))
3777 (state (cdr (assq 'buffer item))))
3778 (when splits (set-window-splits window splits))
3779 (when nest (set-window-nest window nest))
3780 ;; Process parameters.
3781 (when parameters
3782 (dolist (parameter parameters)
3783 (set-window-parameter window (car parameter) (cdr parameter))))
3784 ;; Process buffer related state.
3785 (when state
3786 ;; We don't want to raise an error here so we create a buffer if
3787 ;; there's none.
3788 (set-window-buffer window (get-buffer-create (car state)))
3789 (with-current-buffer (window-buffer window)
3790 (set-window-hscroll window (cdr (assq 'hscroll state)))
3791 (apply 'set-window-fringes
3792 (cons window (cdr (assq 'fringes state))))
3793 (let ((margins (cdr (assq 'margins state))))
3794 (set-window-margins window (car margins) (cdr margins)))
3795 (let ((scroll-bars (cdr (assq 'scroll-bars state))))
3796 (set-window-scroll-bars
3797 window (car scroll-bars) (nth 2 scroll-bars) (nth 3 scroll-bars)))
3798 (set-window-vscroll window (cdr (assq 'vscroll state)))
3799 ;; Adjust vertically.
3800 (if (memq window-size-fixed '(t height))
3801 ;; A fixed height window, try to restore the original size.
3802 (let ((delta (- (cdr (assq 'total-height item))
3803 (window-total-height window)))
3804 window-size-fixed)
3805 (when (window-resizable-p window delta)
3806 (window-resize window delta)))
3807 ;; Else check whether the window is not high enough.
3808 (let* ((min-size (window-min-size window nil ignore))
3809 (delta (- min-size (window-total-size window))))
3810 (when (and (> delta 0)
3811 (window-resizable-p window delta nil ignore))
3812 (window-resize window delta nil ignore))))
3813 ;; Adjust horizontally.
3814 (if (memq window-size-fixed '(t width))
3815 ;; A fixed width window, try to restore the original size.
3816 (let ((delta (- (cdr (assq 'total-width item))
3817 (window-total-width window)))
3818 window-size-fixed)
3819 (when (window-resizable-p window delta)
3820 (window-resize window delta)))
3821 ;; Else check whether the window is not wide enough.
3822 (let* ((min-size (window-min-size window t ignore))
3823 (delta (- min-size (window-total-size window t))))
3824 (when (and (> delta 0)
3825 (window-resizable-p window delta t ignore))
3826 (window-resize window delta t ignore))))
3827 ;; Set dedicated status.
3828 (set-window-dedicated-p window (cdr (assq 'dedicated state)))
3829 ;; Install positions (maybe we should do this after all windows
3830 ;; have been created and sized).
3831 (ignore-errors
3832 (set-window-start window (cdr (assq 'start state)))
3833 (set-window-point window (cdr (assq 'point state)))
3834 ;; I'm not sure whether we should set the mark here, but maybe
3835 ;; it can be used.
3836 (let ((mark (cdr (assq 'mark state))))
3837 (when mark (set-mark mark))))
3838 ;; Select window if it's the selected one.
3839 (when (cdr (assq 'selected state))
3840 (select-window window)))))))
3841
3842 (defun window-state-put (state &optional window ignore)
3843 "Put window state STATE into WINDOW.
3844 STATE should be the state of a window returned by an earlier
3845 invocation of `window-state-get'. Optional argument WINDOW must
3846 specify a live window and defaults to the selected one.
3847
3848 Optional argument IGNORE non-nil means ignore minimum window
3849 sizes and fixed size restrictions. IGNORE equal `safe' means
3850 subwindows can get as small as `window-safe-min-height' and
3851 `window-safe-min-width'."
3852 (setq window (window-normalize-live-window window))
3853 (let* ((frame (window-frame window))
3854 (head (car state))
3855 ;; We check here (1) whether the total sizes of root window of
3856 ;; STATE and that of WINDOW are equal so we can avoid
3857 ;; calculating new sizes, and (2) if we do have to resize
3858 ;; whether we can do so without violating size restrictions.
3859 (totals
3860 (and (= (window-total-size window)
3861 (cdr (assq 'total-height state)))
3862 (= (window-total-size window t)
3863 (cdr (assq 'total-width state)))))
3864 (min-height (cdr (assq 'min-height head)))
3865 (min-width (cdr (assq 'min-width head)))
3866 window-splits selected)
3867 (if (and (not totals)
3868 (or (> min-height (window-total-size window))
3869 (> min-width (window-total-size window t)))
3870 (or (not ignore)
3871 (and (setq min-height
3872 (cdr (assq 'min-height-ignore head)))
3873 (setq min-width
3874 (cdr (assq 'min-width-ignore head)))
3875 (or (> min-height (window-total-size window))
3876 (> min-width (window-total-size window t)))
3877 (or (not (eq ignore 'safe))
3878 (and (setq min-height
3879 (cdr (assq 'min-height-safe head)))
3880 (setq min-width
3881 (cdr (assq 'min-width-safe head)))
3882 (or (> min-height
3883 (window-total-size window))
3884 (> min-width
3885 (window-total-size window t))))))))
3886 ;; The check above might not catch all errors due to rounding
3887 ;; issues - so IGNORE equal 'safe might not always produce the
3888 ;; minimum possible state. But such configurations hardly make
3889 ;; sense anyway.
3890 (error "Window %s too small to accommodate state" window)
3891 (setq state (cdr state))
3892 (setq window-state-put-list nil)
3893 ;; Work on the windows of a temporary buffer to make sure that
3894 ;; splitting proceeds regardless of any buffer local values of
3895 ;; `window-size-fixed'. Release that buffer after the buffers of
3896 ;; all live windows have been set by `window-state-put-2'.
3897 (with-temp-buffer
3898 (set-window-buffer window (current-buffer))
3899 (window-state-put-1 state window nil totals)
3900 (window-state-put-2 ignore))
3901 (window-check frame))))
3902 \f
3903 (defun display-buffer-record-window (type window buffer)
3904 "Record information for window used by `display-buffer'.
3905 TYPE specifies the type of the calling operation and must be one
3906 of the symbols 'reuse \(when WINDOW existed already and was
3907 reused for displaying BUFFER), 'window \(when WINDOW was created
3908 on an already existing frame), or 'frame \(when WINDOW was
3909 created on a new frame). WINDOW is the window used for or created
3910 by the `display-buffer' routines. BUFFER is the buffer that
3911 shall be displayed.
3912
3913 This function installs or updates the quit-restore parameter of
3914 WINDOW. The quit-restore parameter is a list of four elements:
3915 The first element is one of the symbols 'window, 'frame, 'same or
3916 'other. The second element is either one of the symbols 'window
3917 or 'frame or a list whose elements are the buffer previously
3918 shown in the window, that buffer's window start and window point,
3919 and the window's height. The third element is the window
3920 selected at the time the parameter was created. The fourth
3921 element is BUFFER."
3922 (cond
3923 ((eq type 'reuse)
3924 (if (eq (window-buffer window) buffer)
3925 ;; WINDOW shows BUFFER already.
3926 (when (consp (window-parameter window 'quit-restore))
3927 ;; If WINDOW has a quit-restore parameter, reset its car.
3928 (setcar (window-parameter window 'quit-restore) 'same))
3929 ;; WINDOW shows another buffer.
3930 (set-window-parameter
3931 window 'quit-restore
3932 (list 'other
3933 ;; A quadruple of WINDOW's buffer, start, point and height.
3934 (list (window-buffer window) (window-start window)
3935 (window-point-1 window) (window-total-size window))
3936 (selected-window) buffer))))
3937 ((eq type 'window)
3938 ;; WINDOW has been created on an existing frame.
3939 (set-window-parameter
3940 window 'quit-restore
3941 (list 'window 'window (selected-window) buffer)))
3942 ((eq type 'frame)
3943 ;; WINDOW has been created on a new frame.
3944 (set-window-parameter
3945 window 'quit-restore
3946 (list 'frame 'frame (selected-window) buffer)))))
3947
3948 (defcustom display-buffer-function nil
3949 "If non-nil, function to call to handle `display-buffer'.
3950 It will receive two args, the buffer and a flag which if non-nil
3951 means that the currently selected window is not acceptable. It
3952 should choose or create a window, display the specified buffer in
3953 it, and return the window.
3954
3955 The function specified here is responsible for setting the
3956 quit-restore and help-setup parameters of the window used."
3957 :type '(choice
3958 (const nil)
3959 (function :tag "function"))
3960 :group 'windows)
3961
3962 (defcustom pop-up-frame-alist nil
3963 "Alist of parameters for automatically generated new frames.
3964 You can set this in your init file; for example,
3965
3966 (setq pop-up-frame-alist '((width . 80) (height . 20)))
3967
3968 If non-nil, the value you specify here is used by the default
3969 `pop-up-frame-function' for the creation of new frames.
3970
3971 Since `pop-up-frame-function' is used by `display-buffer' for
3972 making new frames, any value specified here by default affects
3973 the automatic generation of new frames via `display-buffer' and
3974 all functions based on it. The behavior of `make-frame' is not
3975 affected by this variable."
3976 :type '(repeat (cons :format "%v"
3977 (symbol :tag "Parameter")
3978 (sexp :tag "Value")))
3979 :group 'frames)
3980
3981 (defcustom pop-up-frame-function
3982 (lambda () (make-frame pop-up-frame-alist))
3983 "Function used by `display-buffer' for creating a new frame.
3984 This function is called with no arguments and should return a new
3985 frame. The default value calls `make-frame' with the argument
3986 `pop-up-frame-alist'."
3987 :type 'function
3988 :group 'frames)
3989
3990 (defcustom special-display-buffer-names nil
3991 "List of names of buffers that should be displayed specially.
3992 Displaying a buffer with `display-buffer' or `pop-to-buffer', if
3993 its name is in this list, displays the buffer in a way specified
3994 by `special-display-function'. `special-display-popup-frame'
3995 \(the default for `special-display-function') usually displays
3996 the buffer in a separate frame made with the parameters specified
3997 by `special-display-frame-alist'. If `special-display-function'
3998 has been set to some other function, that function is called with
3999 the buffer as first, and nil as second argument.
4000
4001 Alternatively, an element of this list can be specified as
4002 \(BUFFER-NAME FRAME-PARAMETERS), where BUFFER-NAME is a buffer
4003 name and FRAME-PARAMETERS an alist of \(PARAMETER . VALUE) pairs.
4004 `special-display-popup-frame' will interpret such pairs as frame
4005 parameters when it creates a special frame, overriding the
4006 corresponding values from `special-display-frame-alist'.
4007
4008 As a special case, if FRAME-PARAMETERS contains (same-window . t)
4009 `special-display-popup-frame' displays that buffer in the
4010 selected window. If FRAME-PARAMETERS contains (same-frame . t),
4011 it displays that buffer in a window on the selected frame.
4012
4013 If `special-display-function' specifies some other function than
4014 `special-display-popup-frame', that function is called with the
4015 buffer named BUFFER-NAME as first, and FRAME-PARAMETERS as second
4016 argument.
4017
4018 Finally, an element of this list can be also specified as
4019 \(BUFFER-NAME FUNCTION OTHER-ARGS). In that case,
4020 `special-display-popup-frame' will call FUNCTION with the buffer
4021 named BUFFER-NAME as first argument, and OTHER-ARGS as the
4022 second.
4023
4024 Any alternative function specified here is responsible for
4025 setting up the quit-restore parameter of the window used.
4026
4027 If this variable appears \"not to work\", because you added a
4028 name to it but the corresponding buffer is displayed in the
4029 selected window, look at the values of `same-window-buffer-names'
4030 and `same-window-regexps'. Those variables take precedence over
4031 this one.
4032
4033 See also `special-display-regexps'."
4034 :type '(repeat
4035 (choice :tag "Buffer"
4036 :value ""
4037 (string :format "%v")
4038 (cons :tag "With parameters"
4039 :format "%v"
4040 :value ("" . nil)
4041 (string :format "%v")
4042 (repeat :tag "Parameters"
4043 (cons :format "%v"
4044 (symbol :tag "Parameter")
4045 (sexp :tag "Value"))))
4046 (list :tag "With function"
4047 :format "%v"
4048 :value ("" . nil)
4049 (string :format "%v")
4050 (function :tag "Function")
4051 (repeat :tag "Arguments" (sexp)))))
4052 :group 'windows
4053 :group 'frames)
4054
4055 ;;;###autoload
4056 (put 'special-display-buffer-names 'risky-local-variable t)
4057
4058 (defcustom special-display-regexps nil
4059 "List of regexps saying which buffers should be displayed specially.
4060 Displaying a buffer with `display-buffer' or `pop-to-buffer', if
4061 any regexp in this list matches its name, displays it specially
4062 using `special-display-function'. `special-display-popup-frame'
4063 \(the default for `special-display-function') usually displays
4064 the buffer in a separate frame made with the parameters specified
4065 by `special-display-frame-alist'. If `special-display-function'
4066 has been set to some other function, that function is called with
4067 the buffer as first, and nil as second argument.
4068
4069 Alternatively, an element of this list can be specified as
4070 \(REGEXP FRAME-PARAMETERS), where REGEXP is a regexp as above and
4071 FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
4072 `special-display-popup-frame' will then interpret these pairs as
4073 frame parameters when creating a special frame for a buffer whose
4074 name matches REGEXP, overriding the corresponding values from
4075 `special-display-frame-alist'.
4076
4077 As a special case, if FRAME-PARAMETERS contains (same-window . t)
4078 `special-display-popup-frame' displays buffers matching REGEXP in
4079 the selected window. \(same-frame . t) in FRAME-PARAMETERS means
4080 to display such buffers in a window on the selected frame.
4081
4082 If `special-display-function' specifies some other function than
4083 `special-display-popup-frame', that function is called with the
4084 buffer whose name matched REGEXP as first, and FRAME-PARAMETERS
4085 as second argument.
4086
4087 Finally, an element of this list can be also specified as
4088 \(REGEXP FUNCTION OTHER-ARGS). `special-display-popup-frame'
4089 will then call FUNCTION with the buffer whose name matched
4090 REGEXP as first, and OTHER-ARGS as second argument.
4091
4092 Any alternative function specified here is responsible for
4093 setting up the quit-restore parameter of the window used.
4094
4095 If this variable appears \"not to work\", because you added a
4096 name to it but the corresponding buffer is displayed in the
4097 selected window, look at the values of `same-window-buffer-names'
4098 and `same-window-regexps'. Those variables take precedence over
4099 this one.
4100
4101 See also `special-display-buffer-names'."
4102 :type '(repeat
4103 (choice :tag "Buffer"
4104 :value ""
4105 (regexp :format "%v")
4106 (cons :tag "With parameters"
4107 :format "%v"
4108 :value ("" . nil)
4109 (regexp :format "%v")
4110 (repeat :tag "Parameters"
4111 (cons :format "%v"
4112 (symbol :tag "Parameter")
4113 (sexp :tag "Value"))))
4114 (list :tag "With function"
4115 :format "%v"
4116 :value ("" . nil)
4117 (regexp :format "%v")
4118 (function :tag "Function")
4119 (repeat :tag "Arguments" (sexp)))))
4120 :group 'windows
4121 :group 'frames)
4122
4123 (defun special-display-p (buffer-name)
4124 "Return non-nil if a buffer named BUFFER-NAME gets a special frame.
4125 More precisely, return t if `special-display-buffer-names' or
4126 `special-display-regexps' contain a string entry equaling or
4127 matching BUFFER-NAME. If `special-display-buffer-names' or
4128 `special-display-regexps' contain a list entry whose car equals
4129 or matches BUFFER-NAME, the return value is the cdr of that
4130 entry."
4131 (let (tmp)
4132 (cond
4133 ((not (stringp buffer-name)))
4134 ((member buffer-name special-display-buffer-names)
4135 t)
4136 ((setq tmp (assoc buffer-name special-display-buffer-names))
4137 (cdr tmp))
4138 ((catch 'found
4139 (dolist (regexp special-display-regexps)
4140 (cond
4141 ((stringp regexp)
4142 (when (string-match-p regexp buffer-name)
4143 (throw 'found t)))
4144 ((and (consp regexp) (stringp (car regexp))
4145 (string-match-p (car regexp) buffer-name))
4146 (throw 'found (cdr regexp))))))))))
4147
4148 (defcustom special-display-frame-alist
4149 '((height . 14) (width . 80) (unsplittable . t))
4150 "Alist of parameters for special frames.
4151 Special frames are used for buffers whose names are listed in
4152 `special-display-buffer-names' and for buffers whose names match
4153 one of the regular expressions in `special-display-regexps'.
4154
4155 This variable can be set in your init file, like this:
4156
4157 (setq special-display-frame-alist '((width . 80) (height . 20)))
4158
4159 These supersede the values given in `default-frame-alist'."
4160 :type '(repeat (cons :format "%v"
4161 (symbol :tag "Parameter")
4162 (sexp :tag "Value")))
4163 :group 'frames)
4164
4165 (defun special-display-popup-frame (buffer &optional args)
4166 "Display BUFFER and return the window chosen.
4167 If BUFFER is already displayed in a visible or iconified frame,
4168 raise that frame. Otherwise, display BUFFER in a new frame.
4169
4170 Optional argument ARGS is a list specifying additional
4171 information.
4172
4173 If ARGS is an alist, use it as a list of frame parameters. If
4174 these parameters contain \(same-window . t), display BUFFER in
4175 the selected window. If they contain \(same-frame . t), display
4176 BUFFER in a window of the selected frame.
4177
4178 If ARGS is a list whose car is a symbol, use (car ARGS) as a
4179 function to do the work. Pass it BUFFER as first argument,
4180 and (cdr ARGS) as second."
4181 (if (and args (symbolp (car args)))
4182 (apply (car args) buffer (cdr args))
4183 (let ((window (get-buffer-window buffer 0)))
4184 (or
4185 ;; If we have a window already, make it visible.
4186 (when window
4187 (let ((frame (window-frame window)))
4188 (make-frame-visible frame)
4189 (raise-frame frame)
4190 (display-buffer-record-window 'reuse window buffer)
4191 window))
4192 ;; Reuse the current window if the user requested it.
4193 (when (cdr (assq 'same-window args))
4194 (condition-case nil
4195 (progn (switch-to-buffer buffer nil t) (selected-window))
4196 (error nil)))
4197 ;; Stay on the same frame if requested.
4198 (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
4199 (let* ((pop-up-windows t)
4200 pop-up-frames
4201 special-display-buffer-names special-display-regexps)
4202 (display-buffer buffer)))
4203 ;; If no window yet, make one in a new frame.
4204 (let* ((frame
4205 (with-current-buffer buffer
4206 (make-frame (append args special-display-frame-alist))))
4207 (window (frame-selected-window frame)))
4208 (display-buffer-record-window 'frame window buffer)
4209 (set-window-buffer window buffer)
4210 ;; Reset list of WINDOW's previous buffers to nil.
4211 (set-window-prev-buffers window nil)
4212 (set-window-dedicated-p window t)
4213 window)))))
4214
4215 (defcustom special-display-function 'special-display-popup-frame
4216 "Function to call for displaying special buffers.
4217 This function is called with two arguments - the buffer and,
4218 optionally, a list - and should return a window displaying that
4219 buffer. The default value usually makes a separate frame for the
4220 buffer using `special-display-frame-alist' to specify the frame
4221 parameters. See the definition of `special-display-popup-frame'
4222 for how to specify such a function.
4223
4224 A buffer is special when its name is either listed in
4225 `special-display-buffer-names' or matches a regexp in
4226 `special-display-regexps'.
4227
4228 The function specified here is responsible for setting the
4229 quit-restore and help-setup parameters of the window used."
4230 :type 'function
4231 :group 'frames)
4232
4233 (defcustom same-window-buffer-names nil
4234 "List of names of buffers that should appear in the \"same\" window.
4235 `display-buffer' and `pop-to-buffer' show a buffer whose name is
4236 on this list in the selected rather than some other window.
4237
4238 An element of this list can be a cons cell instead of just a
4239 string. In that case, the cell's car must be a string specifying
4240 the buffer name. This is for compatibility with
4241 `special-display-buffer-names'; the cdr of the cons cell is
4242 ignored.
4243
4244 See also `same-window-regexps'."
4245 :type '(repeat (string :format "%v"))
4246 :group 'windows)
4247
4248 (defcustom same-window-regexps nil
4249 "List of regexps saying which buffers should appear in the \"same\" window.
4250 `display-buffer' and `pop-to-buffer' show a buffer whose name
4251 matches a regexp on this list in the selected rather than some
4252 other window.
4253
4254 An element of this list can be a cons cell instead of just a
4255 string. In that case, the cell's car must be a regexp matching
4256 the buffer name. This is for compatibility with
4257 `special-display-regexps'; the cdr of the cons cell is ignored.
4258
4259 See also `same-window-buffer-names'."
4260 :type '(repeat (regexp :format "%v"))
4261 :group 'windows)
4262
4263 (defun same-window-p (buffer-name)
4264 "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
4265 This function returns non-nil if `display-buffer' or
4266 `pop-to-buffer' would show a buffer named BUFFER-NAME in the
4267 selected rather than \(as usual\) some other window. See
4268 `same-window-buffer-names' and `same-window-regexps'."
4269 (cond
4270 ((not (stringp buffer-name)))
4271 ;; The elements of `same-window-buffer-names' can be buffer
4272 ;; names or cons cells whose cars are buffer names.
4273 ((member buffer-name same-window-buffer-names))
4274 ((assoc buffer-name same-window-buffer-names))
4275 ((catch 'found
4276 (dolist (regexp same-window-regexps)
4277 ;; The elements of `same-window-regexps' can be regexps
4278 ;; or cons cells whose cars are regexps.
4279 (when (or (and (stringp regexp)
4280 (string-match regexp buffer-name))
4281 (and (consp regexp) (stringp (car regexp))
4282 (string-match-p (car regexp) buffer-name)))
4283 (throw 'found t)))))))
4284
4285 (defcustom pop-up-frames nil
4286 "Whether `display-buffer' should make a separate frame.
4287 If nil, never make a separate frame.
4288 If the value is `graphic-only', make a separate frame
4289 on graphic displays only.
4290 Any other non-nil value means always make a separate frame."
4291 :type '(choice
4292 (const :tag "Never" nil)
4293 (const :tag "On graphic displays only" graphic-only)
4294 (const :tag "Always" t))
4295 :group 'windows)
4296
4297 (defcustom display-buffer-reuse-frames nil
4298 "Non-nil means `display-buffer' should reuse frames.
4299 If the buffer in question is already displayed in a frame, raise
4300 that frame."
4301 :type 'boolean
4302 :version "21.1"
4303 :group 'windows)
4304
4305 (defcustom pop-up-windows t
4306 "Non-nil means `display-buffer' should make a new window."
4307 :type 'boolean
4308 :group 'windows)
4309
4310 (defcustom split-window-preferred-function 'split-window-sensibly
4311 "Function called by `display-buffer' routines to split a window.
4312 This function is called with a window as single argument and is
4313 supposed to split that window and return the new window. If the
4314 window can (or shall) not be split, it is supposed to return nil.
4315 The default is to call the function `split-window-sensibly' which
4316 tries to split the window in a way which seems most suitable.
4317 You can customize the options `split-height-threshold' and/or
4318 `split-width-threshold' in order to have `split-window-sensibly'
4319 prefer either vertical or horizontal splitting.
4320
4321 If you set this to any other function, bear in mind that the
4322 `display-buffer' routines may call this function two times. The
4323 argument of the first call is the largest window on its frame.
4324 If that call fails to return a live window, the function is
4325 called again with the least recently used window as argument. If
4326 that call fails too, `display-buffer' will use an existing window
4327 to display its buffer.
4328
4329 The window selected at the time `display-buffer' was invoked is
4330 still selected when this function is called. Hence you can
4331 compare the window argument with the value of `selected-window'
4332 if you intend to split the selected window instead or if you do
4333 not want to split the selected window."
4334 :type 'function
4335 :version "23.1"
4336 :group 'windows)
4337
4338 (defcustom split-height-threshold 80
4339 "Minimum height for splitting windows sensibly.
4340 If this is an integer, `split-window-sensibly' may split a window
4341 vertically only if it has at least this many lines. If this is
4342 nil, `split-window-sensibly' is not allowed to split a window
4343 vertically. If, however, a window is the only window on its
4344 frame, `split-window-sensibly' may split it vertically
4345 disregarding the value of this variable."
4346 :type '(choice (const nil) (integer :tag "lines"))
4347 :version "23.1"
4348 :group 'windows)
4349
4350 (defcustom split-width-threshold 160
4351 "Minimum width for splitting windows sensibly.
4352 If this is an integer, `split-window-sensibly' may split a window
4353 horizontally only if it has at least this many columns. If this
4354 is nil, `split-window-sensibly' is not allowed to split a window
4355 horizontally."
4356 :type '(choice (const nil) (integer :tag "columns"))
4357 :version "23.1"
4358 :group 'windows)
4359
4360 (defun window-splittable-p (window &optional horizontal)
4361 "Return non-nil if `split-window-sensibly' may split WINDOW.
4362 Optional argument HORIZONTAL nil or omitted means check whether
4363 `split-window-sensibly' may split WINDOW vertically. HORIZONTAL
4364 non-nil means check whether WINDOW may be split horizontally.
4365
4366 WINDOW may be split vertically when the following conditions
4367 hold:
4368 - `window-size-fixed' is either nil or equals `width' for the
4369 buffer of WINDOW.
4370 - `split-height-threshold' is an integer and WINDOW is at least as
4371 high as `split-height-threshold'.
4372 - When WINDOW is split evenly, the emanating windows are at least
4373 `window-min-height' lines tall and can accommodate at least one
4374 line plus - if WINDOW has one - a mode line.
4375
4376 WINDOW may be split horizontally when the following conditions
4377 hold:
4378 - `window-size-fixed' is either nil or equals `height' for the
4379 buffer of WINDOW.
4380 - `split-width-threshold' is an integer and WINDOW is at least as
4381 wide as `split-width-threshold'.
4382 - When WINDOW is split evenly, the emanating windows are at least
4383 `window-min-width' or two (whichever is larger) columns wide."
4384 (when (window-live-p window)
4385 (with-current-buffer (window-buffer window)
4386 (if horizontal
4387 ;; A window can be split horizontally when its width is not
4388 ;; fixed, it is at least `split-width-threshold' columns wide
4389 ;; and at least twice as wide as `window-min-width' and 2 (the
4390 ;; latter value is hardcoded).
4391 (and (memq window-size-fixed '(nil height))
4392 ;; Testing `window-full-width-p' here hardly makes any
4393 ;; sense nowadays. This can be done more intuitively by
4394 ;; setting up `split-width-threshold' appropriately.
4395 (numberp split-width-threshold)
4396 (>= (window-width window)
4397 (max split-width-threshold
4398 (* 2 (max window-min-width 2)))))
4399 ;; A window can be split vertically when its height is not
4400 ;; fixed, it is at least `split-height-threshold' lines high,
4401 ;; and it is at least twice as high as `window-min-height' and 2
4402 ;; if it has a modeline or 1.
4403 (and (memq window-size-fixed '(nil width))
4404 (numberp split-height-threshold)
4405 (>= (window-height window)
4406 (max split-height-threshold
4407 (* 2 (max window-min-height
4408 (if mode-line-format 2 1))))))))))
4409
4410 (defun split-window-sensibly (window)
4411 "Split WINDOW in a way suitable for `display-buffer'.
4412 If `split-height-threshold' specifies an integer, WINDOW is at
4413 least `split-height-threshold' lines tall and can be split
4414 vertically, split WINDOW into two windows one above the other and
4415 return the lower window. Otherwise, if `split-width-threshold'
4416 specifies an integer, WINDOW is at least `split-width-threshold'
4417 columns wide and can be split horizontally, split WINDOW into two
4418 windows side by side and return the window on the right. If this
4419 can't be done either and WINDOW is the only window on its frame,
4420 try to split WINDOW vertically disregarding any value specified
4421 by `split-height-threshold'. If that succeeds, return the lower
4422 window. Return nil otherwise.
4423
4424 By default `display-buffer' routines call this function to split
4425 the largest or least recently used window. To change the default
4426 customize the option `split-window-preferred-function'.
4427
4428 You can enforce this function to not split WINDOW horizontally,
4429 by setting \(or binding) the variable `split-width-threshold' to
4430 nil. If, in addition, you set `split-height-threshold' to zero,
4431 chances increase that this function does split WINDOW vertically.
4432
4433 In order to not split WINDOW vertically, set \(or bind) the
4434 variable `split-height-threshold' to nil. Additionally, you can
4435 set `split-width-threshold' to zero to make a horizontal split
4436 more likely to occur.
4437
4438 Have a look at the function `window-splittable-p' if you want to
4439 know how `split-window-sensibly' determines whether WINDOW can be
4440 split."
4441 (or (and (window-splittable-p window)
4442 ;; Split window vertically.
4443 (with-selected-window window
4444 (split-window-below)))
4445 (and (window-splittable-p window t)
4446 ;; Split window horizontally.
4447 (with-selected-window window
4448 (split-window-right)))
4449 (and (eq window (frame-root-window (window-frame window)))
4450 (not (window-minibuffer-p window))
4451 ;; If WINDOW is the only window on its frame and is not the
4452 ;; minibuffer window, try to split it vertically disregarding
4453 ;; the value of `split-height-threshold'.
4454 (let ((split-height-threshold 0))
4455 (when (window-splittable-p window)
4456 (with-selected-window window
4457 (split-window-below)))))))
4458
4459 (defun window--try-to-split-window (window)
4460 "Try to split WINDOW.
4461 Return value returned by `split-window-preferred-function' if it
4462 represents a live window, nil otherwise."
4463 (and (window-live-p window)
4464 (not (frame-parameter (window-frame window) 'unsplittable))
4465 (let ((new-window
4466 ;; Since `split-window-preferred-function' might
4467 ;; throw an error use `condition-case'.
4468 (condition-case nil
4469 (funcall split-window-preferred-function window)
4470 (error nil))))
4471 (and (window-live-p new-window) new-window))))
4472
4473 (defun window--frame-usable-p (frame)
4474 "Return FRAME if it can be used to display a buffer."
4475 (when (frame-live-p frame)
4476 (let ((window (frame-root-window frame)))
4477 ;; `frame-root-window' may be an internal window which is considered
4478 ;; "dead" by `window-live-p'. Hence if `window' is not live we
4479 ;; implicitly know that `frame' has a visible window we can use.
4480 (unless (and (window-live-p window)
4481 (or (window-minibuffer-p window)
4482 ;; If the window is soft-dedicated, the frame is usable.
4483 ;; Actually, even if the window is really dedicated,
4484 ;; the frame is still usable by splitting it.
4485 ;; At least Emacs-22 allowed it, and it is desirable
4486 ;; when displaying same-frame windows.
4487 nil ; (eq t (window-dedicated-p window))
4488 ))
4489 frame))))
4490
4491 (defcustom even-window-heights t
4492 "If non-nil `display-buffer' will try to even window heights.
4493 Otherwise `display-buffer' will leave the window configuration
4494 alone. Heights are evened only when `display-buffer' chooses a
4495 window that appears above or below the selected window."
4496 :type 'boolean
4497 :group 'windows)
4498
4499 (defun window--even-window-heights (window)
4500 "Even heights of WINDOW and selected window.
4501 Do this only if these windows are vertically adjacent to each
4502 other, `even-window-heights' is non-nil, and the selected window
4503 is higher than WINDOW."
4504 (when (and even-window-heights
4505 (not (eq window (selected-window)))
4506 ;; Don't resize minibuffer windows.
4507 (not (window-minibuffer-p (selected-window)))
4508 (> (window-height (selected-window)) (window-height window))
4509 (eq (window-frame window) (window-frame (selected-window)))
4510 (let ((sel-edges (window-edges (selected-window)))
4511 (win-edges (window-edges window)))
4512 (and (= (nth 0 sel-edges) (nth 0 win-edges))
4513 (= (nth 2 sel-edges) (nth 2 win-edges))
4514 (or (= (nth 1 sel-edges) (nth 3 win-edges))
4515 (= (nth 3 sel-edges) (nth 1 win-edges))))))
4516 (let ((window-min-height 1))
4517 ;; Don't throw an error if we can't even window heights for
4518 ;; whatever reason.
4519 (condition-case nil
4520 (enlarge-window (/ (- (window-height window) (window-height)) 2))
4521 (error nil)))))
4522
4523 (defun window--display-buffer-1 (window)
4524 "Raise the frame containing WINDOW.
4525 Do not raise the selected frame. Return WINDOW."
4526 (let* ((frame (window-frame window))
4527 (visible (frame-visible-p frame)))
4528 (unless (or (not visible)
4529 ;; Assume the selected frame is already visible enough.
4530 (eq frame (selected-frame))
4531 ;; Assume the frame from which we invoked the minibuffer
4532 ;; is visible.
4533 (and (minibuffer-window-active-p (selected-window))
4534 (eq frame (window-frame (minibuffer-selected-window)))))
4535 (raise-frame frame))
4536 window))
4537
4538 (defun window--display-buffer-2 (buffer window &optional dedicated)
4539 "Display BUFFER in WINDOW and make its frame visible.
4540 Set `window-dedicated-p' to DEDICATED if non-nil.
4541 Return WINDOW."
4542 (when (and (buffer-live-p buffer) (window-live-p window))
4543 (set-window-buffer window buffer)
4544 (when dedicated
4545 (set-window-dedicated-p window dedicated))
4546 (window--display-buffer-1 window)))
4547
4548 (defvar display-buffer-mark-dedicated nil
4549 "If non-nil, `display-buffer' marks the windows it creates as dedicated.
4550 The actual non-nil value of this variable will be copied to the
4551 `window-dedicated-p' flag.")
4552
4553 (defun window-normalize-buffer-to-display (buffer-or-name)
4554 "Normalize BUFFER-OR-NAME argument for buffer display functions.
4555 If BUFFER-OR-NAME is nil, return the curent buffer. Else, if a
4556 buffer specified by BUFFER-OR-NAME exists, return that buffer.
4557 If no such buffer exists, create a buffer with the name
4558 BUFFER-OR-NAME and return that buffer."
4559 (if buffer-or-name
4560 (or (get-buffer buffer-or-name)
4561 (let ((buffer (get-buffer-create buffer-or-name)))
4562 (set-buffer-major-mode buffer)
4563 buffer))
4564 (current-buffer)))
4565
4566 (defconst display-buffer--action-function-custom-type
4567 '(choice :tag "Function"
4568 (const :tag "--" ignore) ; default for insertion
4569 (const display-buffer-reuse-window)
4570 (const display-buffer-use-some-window)
4571 (const display-buffer-same-window)
4572 (const display-buffer-pop-up-frame)
4573 (const display-buffer-use-some-window)
4574 (function :tag "Other function"))
4575 "Custom type for `display-buffer' action functions.")
4576
4577 (defconst display-buffer--action-custom-type
4578 `(cons :tag "Action"
4579 (choice :tag "Action functions"
4580 ,display-buffer--action-function-custom-type
4581 (repeat
4582 :tag "List of functions"
4583 ,display-buffer--action-function-custom-type))
4584 (alist :tag "Action arguments"
4585 :key-type symbol
4586 :value-type (sexp :tag "Value")))
4587 "Custom type for `display-buffer' actions.")
4588
4589 (defvar display-buffer-overriding-action '(nil . nil)
4590 "Overriding action to perform to display a buffer.
4591 It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a
4592 function or a list of functions. Each function should accept 2
4593 arguments: a buffer to display and an alist similar to ALIST.
4594 See `display-buffer' for details.")
4595 (put 'display-buffer-overriding-action 'risky-local-variable t)
4596
4597 (defcustom display-buffer-alist nil
4598 "Alist of conditional actions for `display-buffer'.
4599 This is a list of elements (CONDITION . ACTION), where:
4600
4601 CONDITION is either a regexp matching buffer names, or a function
4602 that takes a buffer and returns a boolean.
4603
4604 ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a
4605 function or a list of functions. Each such function should
4606 accept 2 arguments: a buffer to display and an alist of the
4607 same form as ALIST. See `display-buffer' for details."
4608 :type `(alist :key-type
4609 (choice :tag "Condition"
4610 regexp
4611 (function :tag "Matcher function"))
4612 :value-type ,display-buffer--action-custom-type)
4613 :risky t
4614 :version "24.1"
4615 :group 'windows)
4616
4617 (defcustom display-buffer-base-action '(nil . nil)
4618 "User-specified default action for `display-buffer'.
4619 It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a
4620 function or a list of functions. Each function should accept 2
4621 arguments: a buffer to display and an alist similar to ALIST.
4622 See `display-buffer' for details."
4623 :type display-buffer--action-custom-type
4624 :risky t
4625 :version "24.1"
4626 :group 'windows)
4627
4628 (defconst display-buffer-fallback-action
4629 '((display-buffer--maybe-same-window
4630 display-buffer-reuse-window
4631 display-buffer--special
4632 display-buffer--maybe-pop-up-frame-or-window
4633 display-buffer-use-some-window
4634 ;; If all else fails, pop up a new frame.
4635 display-buffer-pop-up-frame))
4636 "Default fallback action for `display-buffer'.
4637 This is the action used by `display-buffer' if no other actions
4638 specified, e.g. by the user options `display-buffer-alist' or
4639 `display-buffer-base-action'. See `display-buffer'.")
4640 (put 'display-buffer-fallback-action 'risky-local-variable t)
4641
4642 (defun display-buffer-assq-regexp (buffer-name alist)
4643 "Retrieve ALIST entry corresponding to BUFFER-NAME."
4644 (catch 'match
4645 (dolist (entry alist)
4646 (let ((key (car entry))
4647 (value (cdr entry)))
4648 (when (or (and (stringp key)
4649 (string-match-p key buffer-name))
4650 (and (symbolp key) (functionp key)
4651 (funcall key buffer-name alist)))
4652 (throw 'match (cdr entry)))))))
4653
4654 (defvar display-buffer--same-window-action
4655 '(display-buffer-same-window
4656 (inhibit-same-window . nil))
4657 "A `display-buffer' action for displaying in the same window.")
4658 (put 'display-buffer--same-window-action 'risky-local-variable t)
4659
4660 (defvar display-buffer--other-frame-action
4661 '((display-buffer-reuse-window
4662 display-buffer--special
4663 display-buffer-pop-up-frame)
4664 (reusable-frames . 0)
4665 (inhibit-same-window . t))
4666 "A `display-buffer' action for displaying in another frame.")
4667 (put 'display-buffer--other-frame-action 'risky-local-variable t)
4668
4669 (defun display-buffer (&optional buffer-or-name action frame)
4670 "Display BUFFER-OR-NAME in some window, without selecting it.
4671 BUFFER-OR-NAME must be a buffer or the name of an existing
4672 buffer. Return the window chosen for displaying BUFFER-OR-NAME,
4673 or nil if no such window is found.
4674
4675 Optional argument ACTION should have the form (FUNCTION . ALIST).
4676 FUNCTION is either a function or a list of functions. Each such
4677 function is called with 2 arguments: the buffer to display and an
4678 alist. It should either display the buffer and return the
4679 window, or return nil if unable to display the buffer.
4680
4681 The `display-buffer' function builds a function list and an alist
4682 from `display-buffer-overriding-action', `display-buffer-alist',
4683 the ACTION argument, `display-buffer-base-action', and
4684 `display-buffer-fallback-action' (in that order). Then it calls
4685 each function in the combined function list in turn, passing the
4686 buffer as the first argument and the combined alist as the second
4687 argument, until one of the functions returns non-nil.
4688
4689 Available action functions include:
4690 `display-buffer-same-window'
4691 `display-buffer-reuse-window'
4692 `display-buffer-pop-up-frame'
4693 `display-buffer-pop-up-window'
4694 `display-buffer-use-some-window'
4695
4696 Recognized alist entries include:
4697
4698 `inhibit-same-window' -- A non-nil value prevents the same
4699 window from being used for display.
4700
4701 `reusable-frames' -- Value specifies frame(s) to search for a
4702 window that already displays the buffer.
4703 See `display-buffer-reuse-window'.
4704
4705 The ACTION argument to `display-buffer' can also have a non-nil
4706 and non-list value. This means to display the buffer in a window
4707 other than the selected one, even if it is already displayed in
4708 the selected window. If called interactively with a prefix
4709 argument, ACTION is t.
4710
4711 Optional argument FRAME, if non-nil, acts like an additional
4712 ALIST entry (reusable-frames . FRAME), specifying the frame(s) to
4713 search for a window that is already displaying the buffer. See
4714 `display-buffer-reuse-window'."
4715 (interactive (list (read-buffer "Display buffer: " (other-buffer))
4716 (if current-prefix-arg t)))
4717 (let ((buffer (window-normalize-buffer-to-display buffer-or-name))
4718 ;; Handle the old form of the first argument.
4719 (inhibit-same-window (and action (not (listp action)))))
4720 (unless (listp action) (setq action nil))
4721 (if display-buffer-function
4722 ;; If `display-buffer-function' is defined, let it do the job.
4723 (funcall display-buffer-function buffer inhibit-same-window)
4724 ;; Otherwise, use the defined actions.
4725 (let* ((user-action
4726 (display-buffer-assq-regexp (buffer-name buffer)
4727 display-buffer-alist))
4728 ;; Extra actions from the arguments to this function:
4729 (extra-action
4730 (cons nil (append (if inhibit-same-window
4731 '((inhibit-same-window . t)))
4732 (if frame
4733 `((reusable-frames . ,frame))))))
4734 ;; Construct action function list and action alist.
4735 (actions (list display-buffer-overriding-action
4736 user-action action extra-action
4737 display-buffer-base-action
4738 display-buffer-fallback-action))
4739 (functions (apply 'append
4740 (mapcar (lambda (x)
4741 (setq x (car x))
4742 (if (functionp x) (list x) x))
4743 actions)))
4744 (alist (apply 'append (mapcar 'cdr actions)))
4745 window)
4746 (unless (buffer-live-p buffer)
4747 (error "Invalid buffer"))
4748 (while (and functions (not window))
4749 (setq window (funcall (car functions) buffer alist)
4750 functions (cdr functions)))
4751 window))))
4752
4753 (defun display-buffer-other-frame (buffer)
4754 "Display buffer BUFFER in another frame.
4755 This uses the function `display-buffer' as a subroutine; see
4756 its documentation for additional customization information."
4757 (interactive "BDisplay buffer in other frame: ")
4758 (display-buffer buffer display-buffer--other-frame-action t))
4759
4760 ;;; `display-buffer' action functions:
4761
4762 (defun display-buffer-same-window (buffer alist)
4763 "Display BUFFER in the selected window.
4764 This fails if ALIST has a non-nil `inhibit-same-window' entry, or
4765 if the selected window is a minibuffer window or is dedicated to
4766 another buffer; in that case, return nil. Otherwise, return the
4767 selected window."
4768 (unless (or (cdr (assq 'inhibit-same-window alist))
4769 (window-minibuffer-p)
4770 (window-dedicated-p))
4771 (display-buffer-record-window 'reuse (selected-window) buffer)
4772 (window--display-buffer-2 buffer (selected-window))))
4773
4774 (defun display-buffer--maybe-same-window (buffer alist)
4775 "Conditionally display BUFFER in the selected window.
4776 If `same-window-p' returns non-nil for BUFFER's name, call
4777 `display-buffer-same-window' and return its value. Otherwise,
4778 return nil."
4779 (and (same-window-p (buffer-name buffer))
4780 (display-buffer-same-window buffer alist)))
4781
4782 (defun display-buffer-reuse-window (buffer alist)
4783 "Return a window that is already displaying BUFFER.
4784 Return nil if no usable window is found.
4785
4786 If ALIST has a non-nil `inhibit-same-window' entry, the selected
4787 window is not eligible for reuse.
4788
4789 If ALIST contains a `reusable-frames' entry, its value determines
4790 which frames to search for a reusable window:
4791 nil -- the selected frame (actually the last non-minibuffer frame)
4792 A frame -- just that frame
4793 `visible' -- all visible frames
4794 0 -- all frames on the current terminal
4795 t -- all frames.
4796
4797 If ALIST contains no `reusable-frames' entry, search just the
4798 selected frame if `display-buffer-reuse-frames' and
4799 `pop-up-frames' are both nil; search all frames on the current
4800 terminal if either of those variables is non-nil."
4801 (let* ((alist-entry (assq 'reusable-frames alist))
4802 (frames (cond (alist-entry (cdr alist-entry))
4803 ((if (eq pop-up-frames 'graphic-only)
4804 (display-graphic-p)
4805 pop-up-frames)
4806 0)
4807 (display-buffer-reuse-frames 0)
4808 (t (last-nonminibuffer-frame))))
4809 (window (if (and (eq buffer (window-buffer))
4810 (not (cdr (assq 'inhibit-same-window alist))))
4811 (selected-window)
4812 (car (delq (selected-window)
4813 (get-buffer-window-list buffer 'nomini
4814 frames))))))
4815 (when window
4816 (display-buffer-record-window 'reuse window buffer)
4817 (window--display-buffer-1 window))))
4818
4819 (defun display-buffer--special (buffer alist)
4820 "Try to display BUFFER using `special-display-function'.
4821 Call `special-display-p' on BUFFER's name, and if that returns
4822 non-nil, call `special-display-function' on BUFFER."
4823 (and special-display-function
4824 ;; `special-display-p' returns either t or a list of frame
4825 ;; parameters to pass to `special-display-function'.
4826 (let ((pars (special-display-p (buffer-name buffer))))
4827 (when pars
4828 (funcall special-display-function
4829 buffer (if (listp pars) pars))))))
4830
4831 (defun display-buffer-pop-up-frame (buffer alist)
4832 "Display BUFFER in a new frame.
4833 This works by calling `pop-up-frame-function'. If successful,
4834 return the window used; otherwise return nil."
4835 (let ((fun pop-up-frame-function)
4836 frame window)
4837 (when (and fun
4838 (setq frame (funcall fun))
4839 (setq window (frame-selected-window frame)))
4840 (display-buffer-record-window 'frame window buffer)
4841 (window--display-buffer-2 buffer window display-buffer-mark-dedicated)
4842 ;; Reset list of WINDOW's previous buffers to nil.
4843 (set-window-prev-buffers window nil)
4844 window)))
4845
4846 (defun display-buffer-pop-up-window (buffer alist)
4847 "Display BUFFER by popping up a new window.
4848 The new window is created on the selected frame, or in
4849 `last-nonminibuffer-frame' if no windows can be created there.
4850 If sucessful, return the new window; otherwise return nil."
4851 (let ((frame (or (window--frame-usable-p (selected-frame))
4852 (window--frame-usable-p (last-nonminibuffer-frame))))
4853 window)
4854 (when (and (or (not (frame-parameter frame 'unsplittable))
4855 ;; If the selected frame cannot be split, look at
4856 ;; `last-nonminibuffer-frame'.
4857 (and (eq frame (selected-frame))
4858 (setq frame (last-nonminibuffer-frame))
4859 (window--frame-usable-p frame)
4860 (not (frame-parameter frame 'unsplittable))))
4861 ;; Attempt to split largest or least recently used window.
4862 (setq window (or (window--try-to-split-window
4863 (get-largest-window frame t))
4864 (window--try-to-split-window
4865 (get-lru-window frame t)))))
4866 (display-buffer-record-window 'window window buffer)
4867 (window--display-buffer-2 buffer window display-buffer-mark-dedicated)
4868 ;; Reset list of WINDOW's previous buffers to nil.
4869 (set-window-prev-buffers window nil)
4870 window)))
4871
4872 (defun display-buffer--maybe-pop-up-frame-or-window (buffer alist)
4873 "Try displaying BUFFER based on `pop-up-frames' or `pop-up-windows'.
4874
4875 If `pop-up-frames' is non-nil (and not `graphic-only' on a
4876 text-only terminal), try with `display-buffer-pop-up-frame'.
4877
4878 If that cannot be done, and `pop-up-windows' is non-nil, try
4879 again with `display-buffer-pop-up-window'."
4880 (or (and (if (eq pop-up-frames 'graphic-only)
4881 (display-graphic-p)
4882 pop-up-frames)
4883 (display-buffer-pop-up-frame buffer alist))
4884 (and pop-up-windows
4885 (display-buffer-pop-up-window buffer alist))))
4886
4887 (defun display-buffer-use-some-window (buffer alist)
4888 "Display BUFFER in an existing window.
4889 Search for a usable window, set that window to the buffer, and
4890 return the window. If no suitable window is found, return nil."
4891 (let* ((not-this-window (cdr (assq 'inhibit-same-window alist)))
4892 (window-to-undedicate
4893 ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate the
4894 ;; selected window to its buffer, to prevent any of the
4895 ;; `get-' routines below from choosing it. (Bug#1415)
4896 (and not-this-window (not (window-dedicated-p))
4897 (set-window-dedicated-p (selected-window) t)
4898 (selected-window)))
4899 (frame (or (window--frame-usable-p (selected-frame))
4900 (window--frame-usable-p (last-nonminibuffer-frame))))
4901 window)
4902 (unwind-protect
4903 (setq window
4904 ;; Reuse an existing window.
4905 (or (get-lru-window frame)
4906 (let ((window (get-buffer-window buffer 'visible)))
4907 (unless (and not-this-window
4908 (eq window (selected-window)))
4909 window))
4910 (get-largest-window 'visible)
4911 (let ((window (get-buffer-window buffer 0)))
4912 (unless (and not-this-window
4913 (eq window (selected-window)))
4914 window))
4915 (get-largest-window 0)))
4916 (when (window-live-p window-to-undedicate)
4917 ;; Restore dedicated status of selected window.
4918 (set-window-dedicated-p window-to-undedicate nil)))
4919 (when window
4920 (display-buffer-record-window 'reuse window buffer)
4921 (window--even-window-heights window)
4922 (window--display-buffer-2 buffer window))))
4923
4924 ;;; Display + selection commands:
4925
4926 (defun pop-to-buffer (buffer &optional action norecord)
4927 "Select buffer BUFFER in some window, preferably a different one.
4928 BUFFER may be a buffer, a string (a buffer name), or nil. If it
4929 is a string not naming an existent buffer, create a buffer with
4930 that name. If BUFFER is nil, choose some other buffer. Return
4931 the buffer.
4932
4933 This uses `display-buffer' as a subroutine. The optional ACTION
4934 argument is passed to `display-buffer' as its ACTION argument.
4935 See `display-buffer' for more information. ACTION is t if called
4936 interactively with a prefix argument, which means to pop to a
4937 window other than the selected one even if the buffer is already
4938 displayed in the selected window.
4939
4940 If the window to show BUFFER is not on the selected
4941 frame, raise that window's frame and give it input focus.
4942
4943 Optional third arg NORECORD non-nil means do not put this buffer
4944 at the front of the list of recently selected ones."
4945 (interactive (list (read-buffer "Pop to buffer: " (other-buffer))
4946 (if current-prefix-arg t)))
4947 (setq buffer (window-normalize-buffer-to-switch-to buffer))
4948 (set-buffer buffer)
4949 (let* ((old-window (selected-window))
4950 (old-frame (selected-frame))
4951 (window (display-buffer buffer action))
4952 (frame (window-frame window)))
4953 ;; If we chose another frame, make sure it gets input focus.
4954 (unless (eq frame old-frame)
4955 (select-frame-set-input-focus frame norecord))
4956 ;; Make sure new window is selected (Bug#8615), (Bug#6954).
4957 (select-window window norecord)
4958 buffer))
4959
4960 (defun pop-to-buffer-same-window (buffer &optional norecord)
4961 "Select buffer BUFFER in some window, preferably the same one.
4962 This function behaves much like `switch-to-buffer', except it
4963 displays with `special-display-function' if BUFFER has a match in
4964 `special-display-buffer-names' or `special-display-regexps'.
4965
4966 Unlike `pop-to-buffer', this function prefers using the selected
4967 window over popping up a new window or frame.
4968
4969 BUFFER may be a buffer, a string (a buffer name), or nil. If it
4970 is a string not naming an existent buffer, create a buffer with
4971 that name. If BUFFER is nil, choose some other buffer. Return
4972 the buffer.
4973
4974 NORECORD, if non-nil means do not put this buffer at the front of
4975 the list of recently selected ones."
4976 (pop-to-buffer buffer
4977 '((display-buffer--special
4978 display-buffer-same-window)
4979 (inhibit-same-window . nil))
4980 norecord))
4981
4982 (defun read-buffer-to-switch (prompt)
4983 "Read the name of a buffer to switch to, prompting with PROMPT.
4984 Return the neame of the buffer as a string.
4985
4986 This function is intended for the `switch-to-buffer' family of
4987 commands since these need to omit the name of the current buffer
4988 from the list of completions and default values."
4989 (let ((rbts-completion-table (internal-complete-buffer-except)))
4990 (minibuffer-with-setup-hook
4991 (lambda ()
4992 (setq minibuffer-completion-table rbts-completion-table)
4993 ;; Since rbts-completion-table is built dynamically, we
4994 ;; can't just add it to the default value of
4995 ;; icomplete-with-completion-tables, so we add it
4996 ;; here manually.
4997 (if (and (boundp 'icomplete-with-completion-tables)
4998 (listp icomplete-with-completion-tables))
4999 (set (make-local-variable 'icomplete-with-completion-tables)
5000 (cons rbts-completion-table
5001 icomplete-with-completion-tables))))
5002 (read-buffer prompt (other-buffer (current-buffer))
5003 (confirm-nonexistent-file-or-buffer)))))
5004
5005 (defun window-normalize-buffer-to-switch-to (buffer-or-name)
5006 "Normalize BUFFER-OR-NAME argument of buffer switching functions.
5007 If BUFFER-OR-NAME is nil, return the buffer returned by
5008 `other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME
5009 exists, return that buffer. If no such buffer exists, create a
5010 buffer with the name BUFFER-OR-NAME and return that buffer."
5011 (if buffer-or-name
5012 (or (get-buffer buffer-or-name)
5013 (let ((buffer (get-buffer-create buffer-or-name)))
5014 (set-buffer-major-mode buffer)
5015 buffer))
5016 (other-buffer)))
5017
5018 (defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
5019 "Switch to buffer BUFFER-OR-NAME in the selected window.
5020 If called interactively, prompt for the buffer name using the
5021 minibuffer. The variable `confirm-nonexistent-file-or-buffer'
5022 determines whether to request confirmation before creating a new
5023 buffer.
5024
5025 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
5026 nil. If BUFFER-OR-NAME is a string that does not identify an
5027 existing buffer, create a buffer with that name. If
5028 BUFFER-OR-NAME is nil, switch to the buffer returned by
5029 `other-buffer'.
5030
5031 Optional argument NORECORD non-nil means do not put the buffer
5032 specified by BUFFER-OR-NAME at the front of the buffer list and
5033 do not make the window displaying it the most recently selected
5034 one.
5035
5036 If FORCE-SAME-WINDOW is non-nil, BUFFER-OR-NAME must be displayed
5037 in the selected window; signal an error if that is
5038 impossible (e.g. if the selected window is minibuffer-only). If
5039 nil, BUFFER-OR-NAME may be displayed in another window.
5040
5041 Return the buffer switched to."
5042 (interactive
5043 (list (read-buffer-to-switch "Switch to buffer: ") nil 'force-same-window))
5044 (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
5045 (if (null force-same-window)
5046 (pop-to-buffer buffer display-buffer--same-window-action norecord)
5047 (cond
5048 ;; Don't call set-window-buffer if it's not needed since it
5049 ;; might signal an error (e.g. if the window is dedicated).
5050 ((eq buffer (window-buffer)))
5051 ((window-minibuffer-p)
5052 (error "Cannot switch buffers in minibuffer window"))
5053 ((eq (window-dedicated-p) t)
5054 (error "Cannot switch buffers in a dedicated window"))
5055 (t (set-window-buffer nil buffer)))
5056
5057 (unless norecord
5058 (select-window (selected-window)))
5059 (set-buffer buffer))))
5060
5061 (defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
5062 "Select the buffer specified by BUFFER-OR-NAME in another window.
5063 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
5064 nil. Return the buffer switched to.
5065
5066 If called interactively, prompt for the buffer name using the
5067 minibuffer. The variable `confirm-nonexistent-file-or-buffer'
5068 determines whether to request confirmation before creating a new
5069 buffer.
5070
5071 If BUFFER-OR-NAME is a string and does not identify an existing
5072 buffer, create a new buffer with that name. If BUFFER-OR-NAME is
5073 nil, switch to the buffer returned by `other-buffer'.
5074
5075 Optional second argument NORECORD non-nil means do not put this
5076 buffer at the front of the list of recently selected ones.
5077
5078 This uses the function `display-buffer' as a subroutine; see its
5079 documentation for additional customization information."
5080 (interactive
5081 (list (read-buffer-to-switch "Switch to buffer in other window: ")))
5082 (let ((pop-up-windows t))
5083 (pop-to-buffer buffer-or-name t norecord)))
5084
5085 (defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
5086 "Switch to buffer BUFFER-OR-NAME in another frame.
5087 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
5088 nil. Return the buffer switched to.
5089
5090 If called interactively, prompt for the buffer name using the
5091 minibuffer. The variable `confirm-nonexistent-file-or-buffer'
5092 determines whether to request confirmation before creating a new
5093 buffer.
5094
5095 If BUFFER-OR-NAME is a string and does not identify an existing
5096 buffer, create a new buffer with that name. If BUFFER-OR-NAME is
5097 nil, switch to the buffer returned by `other-buffer'.
5098
5099 Optional second arg NORECORD non-nil means do not put this
5100 buffer at the front of the list of recently selected ones.
5101
5102 This uses the function `display-buffer' as a subroutine; see its
5103 documentation for additional customization information."
5104 (interactive
5105 (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
5106 (pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
5107 \f
5108 (defun set-window-text-height (window height)
5109 "Set the height in lines of the text display area of WINDOW to HEIGHT.
5110 WINDOW must be a live window. HEIGHT doesn't include the mode
5111 line or header line, if any, or any partial-height lines in the
5112 text display area.
5113
5114 Note that the current implementation of this function cannot
5115 always set the height exactly, but attempts to be conservative,
5116 by allocating more lines than are actually needed in the case
5117 where some error may be present."
5118 (setq window (window-normalize-live-window window))
5119 (let ((delta (- height (window-text-height window))))
5120 (unless (zerop delta)
5121 ;; Setting window-min-height to a value like 1 can lead to very
5122 ;; bizarre displays because it also allows Emacs to make *other*
5123 ;; windows 1-line tall, which means that there's no more space for
5124 ;; the modeline.
5125 (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
5126 (window-resize window delta)))))
5127
5128 (defun enlarge-window-horizontally (delta)
5129 "Make selected window DELTA columns wider.
5130 Interactively, if no argument is given, make selected window one
5131 column wider."
5132 (interactive "p")
5133 (enlarge-window delta t))
5134
5135 (defun shrink-window-horizontally (delta)
5136 "Make selected window DELTA columns narrower.
5137 Interactively, if no argument is given, make selected window one
5138 column narrower."
5139 (interactive "p")
5140 (shrink-window delta t))
5141
5142 (defun count-screen-lines (&optional beg end count-final-newline window)
5143 "Return the number of screen lines in the region.
5144 The number of screen lines may be different from the number of actual lines,
5145 due to line breaking, display table, etc.
5146
5147 Optional arguments BEG and END default to `point-min' and `point-max'
5148 respectively.
5149
5150 If region ends with a newline, ignore it unless optional third argument
5151 COUNT-FINAL-NEWLINE is non-nil.
5152
5153 The optional fourth argument WINDOW specifies the window used for obtaining
5154 parameters such as width, horizontal scrolling, and so on. The default is
5155 to use the selected window's parameters.
5156
5157 Like `vertical-motion', `count-screen-lines' always uses the current buffer,
5158 regardless of which buffer is displayed in WINDOW. This makes possible to use
5159 `count-screen-lines' in any buffer, whether or not it is currently displayed
5160 in some window."
5161 (unless beg
5162 (setq beg (point-min)))
5163 (unless end
5164 (setq end (point-max)))
5165 (if (= beg end)
5166 0
5167 (save-excursion
5168 (save-restriction
5169 (widen)
5170 (narrow-to-region (min beg end)
5171 (if (and (not count-final-newline)
5172 (= ?\n (char-before (max beg end))))
5173 (1- (max beg end))
5174 (max beg end)))
5175 (goto-char (point-min))
5176 (1+ (vertical-motion (buffer-size) window))))))
5177
5178 (defun window-buffer-height (window)
5179 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
5180 (with-current-buffer (window-buffer window)
5181 (max 1
5182 (count-screen-lines (point-min) (point-max)
5183 ;; If buffer ends with a newline, ignore it when
5184 ;; counting height unless point is after it.
5185 (eobp)
5186 window))))
5187
5188 ;;; Resizing buffers to fit their contents exactly.
5189 (defun fit-window-to-buffer (&optional window max-height min-height override)
5190 "Adjust height of WINDOW to display its buffer's contents exactly.
5191 WINDOW can be any live window and defaults to the selected one.
5192
5193 Optional argument MAX-HEIGHT specifies the maximum height of
5194 WINDOW and defaults to the height of WINDOW's frame. Optional
5195 argument MIN-HEIGHT specifies the minimum height of WINDOW and
5196 defaults to `window-min-height'. Both, MAX-HEIGHT and MIN-HEIGHT
5197 are specified in lines and include the mode line and header line,
5198 if any.
5199
5200 Optional argument OVERRIDE non-nil means override restrictions
5201 imposed by `window-min-height' and `window-min-width' on the size
5202 of WINDOW.
5203
5204 Return the number of lines by which WINDOW was enlarged or
5205 shrunk. If an error occurs during resizing, return nil but don't
5206 signal an error.
5207
5208 Note that even if this function makes WINDOW large enough to show
5209 _all_ lines of its buffer you might not see the first lines when
5210 WINDOW was scrolled."
5211 (interactive)
5212 ;; Do all the work in WINDOW and its buffer and restore the selected
5213 ;; window and the current buffer when we're done.
5214 (setq window (window-normalize-live-window window))
5215 ;; Can't resize a full height or fixed-size window.
5216 (unless (or (window-size-fixed-p window)
5217 (window-full-height-p window))
5218 ;; `with-selected-window' should orderly restore the current buffer.
5219 (with-selected-window window
5220 ;; We are in WINDOW's buffer now.
5221 (let* (;; Adjust MIN-HEIGHT.
5222 (min-height
5223 (if override
5224 (window-min-size window nil window)
5225 (max (or min-height window-min-height)
5226 window-safe-min-height)))
5227 (max-window-height
5228 (window-total-size (frame-root-window window)))
5229 ;; Adjust MAX-HEIGHT.
5230 (max-height
5231 (if (or override (not max-height))
5232 max-window-height
5233 (min max-height max-window-height)))
5234 ;; Make `desired-height' the height necessary to show
5235 ;; all of WINDOW's buffer, constrained by MIN-HEIGHT
5236 ;; and MAX-HEIGHT.
5237 (desired-height
5238 (max
5239 (min
5240 (+ (count-screen-lines)
5241 ;; For non-minibuffers count the mode line, if any.
5242 (if (and (not (window-minibuffer-p window))
5243 mode-line-format)
5244 1
5245 0)
5246 ;; Count the header line, if any.
5247 (if header-line-format 1 0))
5248 max-height)
5249 min-height))
5250 (desired-delta
5251 (- desired-height (window-total-size window)))
5252 (delta
5253 (if (> desired-delta 0)
5254 (min desired-delta
5255 (window-max-delta window nil window))
5256 (max desired-delta
5257 (- (window-min-delta window nil window))))))
5258 ;; This `condition-case' shouldn't be necessary, but who knows?
5259 (condition-case nil
5260 (if (zerop delta)
5261 ;; Return zero if DELTA became zero in the proces.
5262 0
5263 ;; Don't try to redisplay with the cursor at the end on its
5264 ;; own line--that would force a scroll and spoil things.
5265 (when (and (eobp) (bolp) (not (bobp)))
5266 ;; It's silly to put `point' at the end of the previous
5267 ;; line and so maybe force horizontal scrolling.
5268 (set-window-point window (line-beginning-position 0)))
5269 ;; Call `window-resize' with OVERRIDE argument equal WINDOW.
5270 (window-resize window delta nil window)
5271 ;; Check if the last line is surely fully visible. If
5272 ;; not, enlarge the window.
5273 (let ((end (save-excursion
5274 (goto-char (point-max))
5275 (when (and (bolp) (not (bobp)))
5276 ;; Don't include final newline.
5277 (backward-char 1))
5278 (when truncate-lines
5279 ;; If line-wrapping is turned off, test the
5280 ;; beginning of the last line for
5281 ;; visibility instead of the end, as the
5282 ;; end of the line could be invisible by
5283 ;; virtue of extending past the edge of the
5284 ;; window.
5285 (forward-line 0))
5286 (point))))
5287 (set-window-vscroll window 0)
5288 ;; This loop might in some rare pathological cases raise
5289 ;; an error - another reason for the `condition-case'.
5290 (while (and (< desired-height max-height)
5291 (= desired-height (window-total-size))
5292 (not (pos-visible-in-window-p end)))
5293 (window-resize window 1 nil window)
5294 (setq desired-height (1+ desired-height)))))
5295 (error (setq delta nil)))
5296 delta))))
5297
5298 (defun window-safely-shrinkable-p (&optional window)
5299 "Return t if WINDOW can be shrunk without shrinking other windows.
5300 WINDOW defaults to the selected window."
5301 (with-selected-window (or window (selected-window))
5302 (let ((edges (window-edges)))
5303 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
5304 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
5305
5306 (defun shrink-window-if-larger-than-buffer (&optional window)
5307 "Shrink height of WINDOW if its buffer doesn't need so many lines.
5308 More precisely, shrink WINDOW vertically to be as small as
5309 possible, while still showing the full contents of its buffer.
5310 WINDOW defaults to the selected window.
5311
5312 Do not shrink WINDOW to less than `window-min-height' lines. Do
5313 nothing if the buffer contains more lines than the present window
5314 height, or if some of the window's contents are scrolled out of
5315 view, or if shrinking this window would also shrink another
5316 window, or if the window is the only window of its frame.
5317
5318 Return non-nil if the window was shrunk, nil otherwise."
5319 (interactive)
5320 (setq window (window-normalize-live-window window))
5321 ;; Make sure that WINDOW is vertically combined and `point-min' is
5322 ;; visible (for whatever reason that's needed). The remaining issues
5323 ;; should be taken care of by `fit-window-to-buffer'.
5324 (when (and (window-combined-p window)
5325 (pos-visible-in-window-p (point-min) window))
5326 (fit-window-to-buffer window (window-total-size window))))
5327 \f
5328 (defun kill-buffer-and-window ()
5329 "Kill the current buffer and delete the selected window."
5330 (interactive)
5331 (let ((window-to-delete (selected-window))
5332 (buffer-to-kill (current-buffer))
5333 (delete-window-hook (lambda () (ignore-errors (delete-window)))))
5334 (unwind-protect
5335 (progn
5336 (add-hook 'kill-buffer-hook delete-window-hook t t)
5337 (if (kill-buffer (current-buffer))
5338 ;; If `delete-window' failed before, we rerun it to regenerate
5339 ;; the error so it can be seen in the echo area.
5340 (when (eq (selected-window) window-to-delete)
5341 (delete-window))))
5342 ;; If the buffer is not dead for some reason (probably because
5343 ;; of a `quit' signal), remove the hook again.
5344 (ignore-errors
5345 (with-current-buffer buffer-to-kill
5346 (remove-hook 'kill-buffer-hook delete-window-hook t))))))
5347
5348 \f
5349 (defvar recenter-last-op nil
5350 "Indicates the last recenter operation performed.
5351 Possible values: `top', `middle', `bottom', integer or float numbers.")
5352
5353 (defcustom recenter-positions '(middle top bottom)
5354 "Cycling order for `recenter-top-bottom'.
5355 A list of elements with possible values `top', `middle', `bottom',
5356 integer or float numbers that define the cycling order for
5357 the command `recenter-top-bottom'.
5358
5359 Top and bottom destinations are `scroll-margin' lines the from true
5360 window top and bottom. Middle redraws the frame and centers point
5361 vertically within the window. Integer number moves current line to
5362 the specified absolute window-line. Float number between 0.0 and 1.0
5363 means the percentage of the screen space from the top. The default
5364 cycling order is middle -> top -> bottom."
5365 :type '(repeat (choice
5366 (const :tag "Top" top)
5367 (const :tag "Middle" middle)
5368 (const :tag "Bottom" bottom)
5369 (integer :tag "Line number")
5370 (float :tag "Percentage")))
5371 :version "23.2"
5372 :group 'windows)
5373
5374 (defun recenter-top-bottom (&optional arg)
5375 "Move current buffer line to the specified window line.
5376 With no prefix argument, successive calls place point according
5377 to the cycling order defined by `recenter-positions'.
5378
5379 A prefix argument is handled like `recenter':
5380 With numeric prefix ARG, move current line to window-line ARG.
5381 With plain `C-u', move current line to window center."
5382 (interactive "P")
5383 (cond
5384 (arg (recenter arg)) ; Always respect ARG.
5385 (t
5386 (setq recenter-last-op
5387 (if (eq this-command last-command)
5388 (car (or (cdr (member recenter-last-op recenter-positions))
5389 recenter-positions))
5390 (car recenter-positions)))
5391 (let ((this-scroll-margin
5392 (min (max 0 scroll-margin)
5393 (truncate (/ (window-body-height) 4.0)))))
5394 (cond ((eq recenter-last-op 'middle)
5395 (recenter))
5396 ((eq recenter-last-op 'top)
5397 (recenter this-scroll-margin))
5398 ((eq recenter-last-op 'bottom)
5399 (recenter (- -1 this-scroll-margin)))
5400 ((integerp recenter-last-op)
5401 (recenter recenter-last-op))
5402 ((floatp recenter-last-op)
5403 (recenter (round (* recenter-last-op (window-height))))))))))
5404
5405 (define-key global-map [?\C-l] 'recenter-top-bottom)
5406
5407 (defun move-to-window-line-top-bottom (&optional arg)
5408 "Position point relative to window.
5409
5410 With a prefix argument ARG, acts like `move-to-window-line'.
5411
5412 With no argument, positions point at center of window.
5413 Successive calls position point at positions defined
5414 by `recenter-positions'."
5415 (interactive "P")
5416 (cond
5417 (arg (move-to-window-line arg)) ; Always respect ARG.
5418 (t
5419 (setq recenter-last-op
5420 (if (eq this-command last-command)
5421 (car (or (cdr (member recenter-last-op recenter-positions))
5422 recenter-positions))
5423 (car recenter-positions)))
5424 (let ((this-scroll-margin
5425 (min (max 0 scroll-margin)
5426 (truncate (/ (window-body-height) 4.0)))))
5427 (cond ((eq recenter-last-op 'middle)
5428 (call-interactively 'move-to-window-line))
5429 ((eq recenter-last-op 'top)
5430 (move-to-window-line this-scroll-margin))
5431 ((eq recenter-last-op 'bottom)
5432 (move-to-window-line (- -1 this-scroll-margin)))
5433 ((integerp recenter-last-op)
5434 (move-to-window-line recenter-last-op))
5435 ((floatp recenter-last-op)
5436 (move-to-window-line (round (* recenter-last-op (window-height))))))))))
5437
5438 (define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
5439 \f
5440 ;;; Scrolling commands.
5441
5442 ;;; Scrolling commands which does not signal errors at top/bottom
5443 ;;; of buffer at first key-press (instead moves to top/bottom
5444 ;;; of buffer).
5445
5446 (defcustom scroll-error-top-bottom nil
5447 "Move point to top/bottom of buffer before signalling a scrolling error.
5448 A value of nil means just signal an error if no more scrolling possible.
5449 A value of t means point moves to the beginning or the end of the buffer
5450 \(depending on scrolling direction) when no more scrolling possible.
5451 When point is already on that position, then signal an error."
5452 :type 'boolean
5453 :group 'scrolling
5454 :version "24.1")
5455
5456 (defun scroll-up-command (&optional arg)
5457 "Scroll text of selected window upward ARG lines; or near full screen if no ARG.
5458 If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
5459 scroll window further, move cursor to the bottom line.
5460 When point is already on that position, then signal an error.
5461 A near full screen is `next-screen-context-lines' less than a full screen.
5462 Negative ARG means scroll downward.
5463 If ARG is the atom `-', scroll downward by nearly full screen."
5464 (interactive "^P")
5465 (cond
5466 ((null scroll-error-top-bottom)
5467 (scroll-up arg))
5468 ((eq arg '-)
5469 (scroll-down-command nil))
5470 ((< (prefix-numeric-value arg) 0)
5471 (scroll-down-command (- (prefix-numeric-value arg))))
5472 ((eobp)
5473 (scroll-up arg)) ; signal error
5474 (t
5475 (condition-case nil
5476 (scroll-up arg)
5477 (end-of-buffer
5478 (if arg
5479 ;; When scrolling by ARG lines can't be done,
5480 ;; move by ARG lines instead.
5481 (forward-line arg)
5482 ;; When ARG is nil for full-screen scrolling,
5483 ;; move to the bottom of the buffer.
5484 (goto-char (point-max))))))))
5485
5486 (put 'scroll-up-command 'scroll-command t)
5487
5488 (defun scroll-down-command (&optional arg)
5489 "Scroll text of selected window down ARG lines; or near full screen if no ARG.
5490 If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
5491 scroll window further, move cursor to the top line.
5492 When point is already on that position, then signal an error.
5493 A near full screen is `next-screen-context-lines' less than a full screen.
5494 Negative ARG means scroll upward.
5495 If ARG is the atom `-', scroll upward by nearly full screen."
5496 (interactive "^P")
5497 (cond
5498 ((null scroll-error-top-bottom)
5499 (scroll-down arg))
5500 ((eq arg '-)
5501 (scroll-up-command nil))
5502 ((< (prefix-numeric-value arg) 0)
5503 (scroll-up-command (- (prefix-numeric-value arg))))
5504 ((bobp)
5505 (scroll-down arg)) ; signal error
5506 (t
5507 (condition-case nil
5508 (scroll-down arg)
5509 (beginning-of-buffer
5510 (if arg
5511 ;; When scrolling by ARG lines can't be done,
5512 ;; move by ARG lines instead.
5513 (forward-line (- arg))
5514 ;; When ARG is nil for full-screen scrolling,
5515 ;; move to the top of the buffer.
5516 (goto-char (point-min))))))))
5517
5518 (put 'scroll-down-command 'scroll-command t)
5519
5520 ;;; Scrolling commands which scroll a line instead of full screen.
5521
5522 (defun scroll-up-line (&optional arg)
5523 "Scroll text of selected window upward ARG lines; or one line if no ARG.
5524 If ARG is omitted or nil, scroll upward by one line.
5525 This is different from `scroll-up-command' that scrolls a full screen."
5526 (interactive "p")
5527 (scroll-up (or arg 1)))
5528
5529 (put 'scroll-up-line 'scroll-command t)
5530
5531 (defun scroll-down-line (&optional arg)
5532 "Scroll text of selected window down ARG lines; or one line if no ARG.
5533 If ARG is omitted or nil, scroll down by one line.
5534 This is different from `scroll-down-command' that scrolls a full screen."
5535 (interactive "p")
5536 (scroll-down (or arg 1)))
5537
5538 (put 'scroll-down-line 'scroll-command t)
5539
5540 \f
5541 (defun scroll-other-window-down (lines)
5542 "Scroll the \"other window\" down.
5543 For more details, see the documentation for `scroll-other-window'."
5544 (interactive "P")
5545 (scroll-other-window
5546 ;; Just invert the argument's meaning.
5547 ;; We can do that without knowing which window it will be.
5548 (if (eq lines '-) nil
5549 (if (null lines) '-
5550 (- (prefix-numeric-value lines))))))
5551
5552 (defun beginning-of-buffer-other-window (arg)
5553 "Move point to the beginning of the buffer in the other window.
5554 Leave mark at previous position.
5555 With arg N, put point N/10 of the way from the true beginning."
5556 (interactive "P")
5557 (let ((orig-window (selected-window))
5558 (window (other-window-for-scrolling)))
5559 ;; We use unwind-protect rather than save-window-excursion
5560 ;; because the latter would preserve the things we want to change.
5561 (unwind-protect
5562 (progn
5563 (select-window window)
5564 ;; Set point and mark in that window's buffer.
5565 (with-no-warnings
5566 (beginning-of-buffer arg))
5567 ;; Set point accordingly.
5568 (recenter '(t)))
5569 (select-window orig-window))))
5570
5571 (defun end-of-buffer-other-window (arg)
5572 "Move point to the end of the buffer in the other window.
5573 Leave mark at previous position.
5574 With arg N, put point N/10 of the way from the true end."
5575 (interactive "P")
5576 ;; See beginning-of-buffer-other-window for comments.
5577 (let ((orig-window (selected-window))
5578 (window (other-window-for-scrolling)))
5579 (unwind-protect
5580 (progn
5581 (select-window window)
5582 (with-no-warnings
5583 (end-of-buffer arg))
5584 (recenter '(t)))
5585 (select-window orig-window))))
5586 \f
5587 (defvar mouse-autoselect-window-timer nil
5588 "Timer used by delayed window autoselection.")
5589
5590 (defvar mouse-autoselect-window-position nil
5591 "Last mouse position recorded by delayed window autoselection.")
5592
5593 (defvar mouse-autoselect-window-window nil
5594 "Last window recorded by delayed window autoselection.")
5595
5596 (defvar mouse-autoselect-window-state nil
5597 "When non-nil, special state of delayed window autoselection.
5598 Possible values are `suspend' \(suspend autoselection after a menu or
5599 scrollbar interaction\) and `select' \(the next invocation of
5600 'handle-select-window' shall select the window immediately\).")
5601
5602 (defun mouse-autoselect-window-cancel (&optional force)
5603 "Cancel delayed window autoselection.
5604 Optional argument FORCE means cancel unconditionally."
5605 (unless (and (not force)
5606 ;; Don't cancel for select-window or select-frame events
5607 ;; or when the user drags a scroll bar.
5608 (or (memq this-command
5609 '(handle-select-window handle-switch-frame))
5610 (and (eq this-command 'scroll-bar-toolkit-scroll)
5611 (memq (nth 4 (event-end last-input-event))
5612 '(handle end-scroll)))))
5613 (setq mouse-autoselect-window-state nil)
5614 (when (timerp mouse-autoselect-window-timer)
5615 (cancel-timer mouse-autoselect-window-timer))
5616 (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
5617
5618 (defun mouse-autoselect-window-start (mouse-position &optional window suspend)
5619 "Start delayed window autoselection.
5620 MOUSE-POSITION is the last position where the mouse was seen as returned
5621 by `mouse-position'. Optional argument WINDOW non-nil denotes the
5622 window where the mouse was seen. Optional argument SUSPEND non-nil
5623 means suspend autoselection."
5624 ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
5625 (setq mouse-autoselect-window-position mouse-position)
5626 (when window (setq mouse-autoselect-window-window window))
5627 (setq mouse-autoselect-window-state (when suspend 'suspend))
5628 ;; Install timer which runs `mouse-autoselect-window-select' after
5629 ;; `mouse-autoselect-window' seconds.
5630 (setq mouse-autoselect-window-timer
5631 (run-at-time
5632 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
5633
5634 (defun mouse-autoselect-window-select ()
5635 "Select window with delayed window autoselection.
5636 If the mouse position has stabilized in a non-selected window, select
5637 that window. The minibuffer window is selected only if the minibuffer is
5638 active. This function is run by `mouse-autoselect-window-timer'."
5639 (ignore-errors
5640 (let* ((mouse-position (mouse-position))
5641 (window
5642 (ignore-errors
5643 (window-at (cadr mouse-position) (cddr mouse-position)
5644 (car mouse-position)))))
5645 (cond
5646 ((or (menu-or-popup-active-p)
5647 (and window
5648 (not (coordinates-in-window-p (cdr mouse-position) window))))
5649 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
5650 ;; of WINDOW, temporarily suspend delayed autoselection.
5651 (mouse-autoselect-window-start mouse-position nil t))
5652 ((eq mouse-autoselect-window-state 'suspend)
5653 ;; Delayed autoselection was temporarily suspended, reenable it.
5654 (mouse-autoselect-window-start mouse-position))
5655 ((and window (not (eq window (selected-window)))
5656 (or (not (numberp mouse-autoselect-window))
5657 (and (> mouse-autoselect-window 0)
5658 ;; If `mouse-autoselect-window' is positive, select
5659 ;; window if the window is the same as before.
5660 (eq window mouse-autoselect-window-window))
5661 ;; Otherwise select window if the mouse is at the same
5662 ;; position as before. Observe that the first test after
5663 ;; starting autoselection usually fails since the value of
5664 ;; `mouse-autoselect-window-position' recorded there is the
5665 ;; position where the mouse has entered the new window and
5666 ;; not necessarily where the mouse has stopped moving.
5667 (equal mouse-position mouse-autoselect-window-position))
5668 ;; The minibuffer is a candidate window if it's active.
5669 (or (not (window-minibuffer-p window))
5670 (eq window (active-minibuffer-window))))
5671 ;; Mouse position has stabilized in non-selected window: Cancel
5672 ;; delayed autoselection and try to select that window.
5673 (mouse-autoselect-window-cancel t)
5674 ;; Select window where mouse appears unless the selected window is the
5675 ;; minibuffer. Use `unread-command-events' in order to execute pre-
5676 ;; and post-command hooks and trigger idle timers. To avoid delaying
5677 ;; autoselection again, set `mouse-autoselect-window-state'."
5678 (unless (window-minibuffer-p (selected-window))
5679 (setq mouse-autoselect-window-state 'select)
5680 (setq unread-command-events
5681 (cons (list 'select-window (list window))
5682 unread-command-events))))
5683 ((or (and window (eq window (selected-window)))
5684 (not (numberp mouse-autoselect-window))
5685 (equal mouse-position mouse-autoselect-window-position))
5686 ;; Mouse position has either stabilized in the selected window or at
5687 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
5688 (mouse-autoselect-window-cancel t))
5689 (t
5690 ;; Mouse position has not stabilized yet, resume delayed
5691 ;; autoselection.
5692 (mouse-autoselect-window-start mouse-position window))))))
5693
5694 (defun handle-select-window (event)
5695 "Handle select-window events."
5696 (interactive "e")
5697 (let ((window (posn-window (event-start event))))
5698 (unless (or (not (window-live-p window))
5699 ;; Don't switch if we're currently in the minibuffer.
5700 ;; This tries to work around problems where the
5701 ;; minibuffer gets unselected unexpectedly, and where
5702 ;; you then have to move your mouse all the way down to
5703 ;; the minibuffer to select it.
5704 (window-minibuffer-p (selected-window))
5705 ;; Don't switch to minibuffer window unless it's active.
5706 (and (window-minibuffer-p window)
5707 (not (minibuffer-window-active-p window)))
5708 ;; Don't switch when autoselection shall be delayed.
5709 (and (numberp mouse-autoselect-window)
5710 (not (zerop mouse-autoselect-window))
5711 (not (eq mouse-autoselect-window-state 'select))
5712 (progn
5713 ;; Cancel any delayed autoselection.
5714 (mouse-autoselect-window-cancel t)
5715 ;; Start delayed autoselection from current mouse
5716 ;; position and window.
5717 (mouse-autoselect-window-start (mouse-position) window)
5718 ;; Executing a command cancels delayed autoselection.
5719 (add-hook
5720 'pre-command-hook 'mouse-autoselect-window-cancel))))
5721 (when mouse-autoselect-window
5722 ;; Reset state of delayed autoselection.
5723 (setq mouse-autoselect-window-state nil)
5724 ;; Run `mouse-leave-buffer-hook' when autoselecting window.
5725 (run-hooks 'mouse-leave-buffer-hook))
5726 (select-window window))))
5727
5728 (defun truncated-partial-width-window-p (&optional window)
5729 "Return non-nil if lines in WINDOW are specifically truncated due to its width.
5730 WINDOW defaults to the selected window.
5731 Return nil if WINDOW is not a partial-width window
5732 (regardless of the value of `truncate-lines').
5733 Otherwise, consult the value of `truncate-partial-width-windows'
5734 for the buffer shown in WINDOW."
5735 (unless window
5736 (setq window (selected-window)))
5737 (unless (window-full-width-p window)
5738 (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
5739 (window-buffer window))))
5740 (if (integerp t-p-w-w)
5741 (< (window-width window) t-p-w-w)
5742 t-p-w-w))))
5743 \f
5744 ;; Some of these are in tutorial--default-keys, so update that if you
5745 ;; change these.
5746 (define-key ctl-x-map "0" 'delete-window)
5747 (define-key ctl-x-map "1" 'delete-other-windows)
5748 (define-key ctl-x-map "2" 'split-window-below)
5749 (define-key ctl-x-map "3" 'split-window-right)
5750 (define-key ctl-x-map "o" 'other-window)
5751 (define-key ctl-x-map "^" 'enlarge-window)
5752 (define-key ctl-x-map "}" 'enlarge-window-horizontally)
5753 (define-key ctl-x-map "{" 'shrink-window-horizontally)
5754 (define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
5755 (define-key ctl-x-map "+" 'balance-windows)
5756 (define-key ctl-x-4-map "0" 'kill-buffer-and-window)
5757
5758 ;;; window.el ends here