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