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