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