Line data Source code
1 : ;;; window.el --- GNU Emacs window commands aside from those written in C -*- lexical-binding:t -*-
2 :
3 : ;; Copyright (C) 1985, 1989, 1992-1994, 2000-2017 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 33 : (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 33 : (apply #'append
38 33 : (mapcar (lambda (terminal)
39 33 : (let ((frames (frames-on-display-list terminal))
40 33 : (top-frame (tty-top-frame terminal))
41 : alist)
42 33 : (if top-frame
43 0 : (setq frames
44 0 : (cons top-frame
45 33 : (delq top-frame frames))))
46 33 : (dolist (f frames)
47 33 : (push (cons f (frame-selected-window f))
48 66 : alist))
49 33 : alist))
50 33 : (terminal-list)))))
51 :
52 : (defun internal--after-save-selected-window (state)
53 33 : (dolist (elt (cdr state))
54 33 : (and (frame-live-p (car elt))
55 33 : (window-live-p (cdr elt))
56 33 : (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
57 33 : (when (window-live-p (car state))
58 33 : (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 15 : `(let ((save-selected-window--state (internal--before-save-selected-window)))
77 : (save-current-buffer
78 : (unwind-protect
79 15 : (progn ,@body)
80 15 : (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 0 : (let ((old-dir default-directory)
96 0 : (buffer (get-buffer-create buffer-or-name)))
97 0 : (with-current-buffer buffer
98 0 : (kill-all-local-variables)
99 0 : (setq default-directory old-dir)
100 0 : (delete-all-overlays)
101 0 : (setq buffer-read-only nil)
102 0 : (setq buffer-file-name nil)
103 0 : (setq buffer-undo-list t)
104 0 : (let ((inhibit-read-only t)
105 : (inhibit-modification-hooks t))
106 0 : (erase-buffer)
107 0 : (run-hooks 'temp-buffer-window-setup-hook))
108 : ;; Return the buffer.
109 0 : buffer)))
110 :
111 : (defun temp-buffer-window-show (buffer &optional 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 0 : (let (window frame)
116 0 : (with-current-buffer buffer
117 0 : (set-buffer-modified-p nil)
118 0 : (setq buffer-read-only t)
119 0 : (goto-char (point-min))
120 0 : (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 0 : (if (or (eq window-combination-limit 'temp-buffer)
127 0 : (and (eq window-combination-limit
128 0 : 'temp-buffer-resize)
129 0 : temp-buffer-resize-mode))
130 : t
131 0 : window-combination-limit)))
132 0 : (setq window (display-buffer buffer action)))
133 0 : (setq frame (window-frame window))
134 0 : (unless (eq frame (selected-frame))
135 0 : (raise-frame frame))
136 0 : (setq minibuffer-scroll-window window)
137 0 : (set-window-hscroll window 0)
138 0 : (with-selected-window window
139 0 : (run-hooks 'temp-buffer-window-show-hook)
140 0 : (when temp-buffer-resize-mode
141 0 : (resize-temp-buffer-window window)))
142 : ;; Return the window.
143 0 : 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 11 : (let ((buffer (make-symbol "buffer"))
186 11 : (window (make-symbol "window"))
187 11 : (value (make-symbol "value")))
188 11 : (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
189 11 : (vaction action)
190 11 : (vquit-function quit-function))
191 11 : `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
192 11 : (standard-output ,buffer)
193 11 : ,window ,value)
194 11 : (setq ,value (progn ,@body))
195 11 : (with-current-buffer ,buffer
196 11 : (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
197 :
198 11 : (if (functionp ,vquit-function)
199 11 : (funcall ,vquit-function ,window ,value)
200 11 : ,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 2 : (let ((buffer (make-symbol "buffer"))
209 2 : (window (make-symbol "window"))
210 2 : (value (make-symbol "value")))
211 2 : (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
212 2 : (vaction action)
213 2 : (vquit-function quit-function))
214 2 : `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
215 2 : (standard-output ,buffer)
216 2 : ,window ,value)
217 2 : (with-current-buffer ,buffer
218 2 : (setq ,value (progn ,@body))
219 2 : (setq ,window (temp-buffer-window-show ,buffer ,vaction)))
220 :
221 2 : (if (functionp ,vquit-function)
222 2 : (funcall ,vquit-function ,window ,value)
223 2 : ,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 1 : (let ((buffer (make-symbol "buffer"))
231 1 : (window (make-symbol "window"))
232 1 : (value (make-symbol "value")))
233 1 : (macroexp-let2* nil ((vbuffer-or-name buffer-or-name)
234 1 : (vaction action)
235 1 : (vquit-function quit-function))
236 1 : `(let* ((,buffer (temp-buffer-window-setup ,vbuffer-or-name))
237 1 : (standard-output ,buffer)
238 : ;; If a 'window-height' entry specifies a function,
239 : ;; remember it here in order to call it below but replace
240 : ;; the entry so `window--try-to-split-window' will bind
241 : ;; `window-combination-limit' to t and the function does
242 : ;; not resize any other window but the one we split this
243 : ;; one off (Bug#25055, Bug#25179).
244 : (vheight-function
245 1 : (let ((window-height (assq 'window-height (cdr ,vaction))))
246 : (when (functionp (cdr window-height))
247 : (cdr window-height))))
248 : (vaction-copied
249 : (when vheight-function
250 1 : (cons (car , vaction)
251 : (cons
252 : '(window-height . t)
253 : (assq-delete-all
254 1 : 'window-height (cdr (copy-sequence ,vaction)))))))
255 1 : ,window ,value)
256 1 : (with-current-buffer ,buffer
257 1 : (setq ,window (temp-buffer-window-show
258 1 : ,buffer (or vaction-copied ,vaction))))
259 :
260 : (let ((inhibit-read-only t)
261 : (inhibit-modification-hooks t))
262 1 : (setq ,value (progn ,@body)))
263 :
264 1 : (set-window-point ,window (point-min))
265 :
266 : (when vheight-function
267 : (ignore-errors
268 1 : (set-window-parameter ,window 'preserve-size nil)
269 1 : (funcall vheight-function ,window)))
270 :
271 1 : (when (consp (cdr (assq 'preserve-size (cdr ,vaction))))
272 : (window-preserve-size
273 1 : ,window t (cadr (assq 'preserve-size (cdr ,vaction))))
274 : (window-preserve-size
275 1 : ,window nil (cddr (assq 'preserve-size (cdr ,vaction)))))
276 :
277 1 : (if (functionp ,vquit-function)
278 1 : (funcall ,vquit-function ,window ,value)
279 1 : ,value)))))
280 :
281 : ;; The following two functions are like `window-next-sibling' and
282 : ;; `window-prev-sibling' but the WINDOW argument is _not_ optional (so
283 : ;; they don't substitute the selected window for nil), and they return
284 : ;; nil when WINDOW doesn't have a parent (like a frame's root window or
285 : ;; a minibuffer window).
286 : (defun window-right (window)
287 : "Return WINDOW's right sibling.
288 : Return nil if WINDOW is the root window of its frame. WINDOW can
289 : be any window."
290 144 : (and window (window-parent window) (window-next-sibling window)))
291 :
292 : (defun window-left (window)
293 : "Return WINDOW's left sibling.
294 : Return nil if WINDOW is the root window of its frame. WINDOW can
295 : be any window."
296 0 : (and window (window-parent window) (window-prev-sibling window)))
297 :
298 : (defun window-child (window)
299 : "Return WINDOW's first child window.
300 : WINDOW can be any window."
301 528 : (or (window-top-child window) (window-left-child window)))
302 :
303 : (defun window-child-count (window)
304 : "Return number of WINDOW's child windows.
305 : WINDOW can be any window."
306 8 : (let ((count 0))
307 8 : (when (and (windowp window) (setq window (window-child window)))
308 24 : (while window
309 16 : (setq count (1+ count))
310 16 : (setq window (window-next-sibling window))))
311 8 : count))
312 :
313 : (defun window-last-child (window)
314 : "Return last child window of WINDOW.
315 : WINDOW can be any window."
316 0 : (when (and (windowp window) (setq window (window-child window)))
317 0 : (while (window-next-sibling window)
318 0 : (setq window (window-next-sibling window))))
319 0 : window)
320 :
321 : (defun window-normalize-buffer (buffer-or-name)
322 : "Return buffer specified by BUFFER-OR-NAME.
323 : BUFFER-OR-NAME must be either a buffer or a string naming a live
324 : buffer and defaults to the current buffer."
325 2464 : (cond
326 2464 : ((not buffer-or-name)
327 0 : (current-buffer))
328 2464 : ((bufferp buffer-or-name)
329 2464 : (if (buffer-live-p buffer-or-name)
330 2464 : buffer-or-name
331 2464 : (error "Buffer %s is not a live buffer" buffer-or-name)))
332 0 : ((get-buffer buffer-or-name))
333 : (t
334 2464 : (error "No such buffer %s" buffer-or-name))))
335 :
336 : (defun window-normalize-frame (frame)
337 : "Return frame specified by FRAME.
338 : FRAME must be a live frame and defaults to the selected frame."
339 231 : (if frame
340 120 : (if (frame-live-p frame)
341 120 : frame
342 120 : (error "%s is not a live frame" frame))
343 231 : (selected-frame)))
344 :
345 : (defun window-normalize-window (window &optional live-only)
346 : "Return the window specified by WINDOW.
347 : If WINDOW is nil, return the selected window. Otherwise, if
348 : WINDOW is a live or an internal window, return WINDOW; if
349 : LIVE-ONLY is non-nil, return WINDOW for a live window only.
350 : Otherwise, signal an error."
351 3813 : (cond
352 3813 : ((null window)
353 3 : (selected-window))
354 3810 : (live-only
355 2882 : (if (window-live-p window)
356 2882 : window
357 2882 : (error "%s is not a live window" window)))
358 928 : ((window-valid-p window)
359 928 : window)
360 : (t
361 3813 : (error "%s is not a valid window" window))))
362 :
363 : ;; Maybe this should go to frame.el.
364 : (defun frame-char-size (&optional window-or-frame horizontal)
365 : "Return the value of `frame-char-height' for WINDOW-OR-FRAME.
366 : If WINDOW-OR-FRAME is a live frame, return the value of
367 : `frame-char-height' for that frame. If WINDOW-OR-FRAME is a
368 : valid window, return the value of `frame-char-height' for that
369 : window's frame. In any other case, return the value of
370 : `frame-char-height' for the selected frame.
371 :
372 : Optional argument HORIZONTAL non-nil means to return the value of
373 : `frame-char-width' for WINDOW-OR-FRAME."
374 454 : (let ((frame
375 454 : (cond
376 454 : ((window-valid-p window-or-frame)
377 451 : (window-frame window-or-frame))
378 3 : ((frame-live-p window-or-frame)
379 3 : window-or-frame)
380 454 : (t (selected-frame)))))
381 454 : (if horizontal
382 215 : (frame-char-width frame)
383 454 : (frame-char-height frame))))
384 :
385 : (defvar ignore-window-parameters nil
386 : "If non-nil, standard functions ignore window parameters.
387 : The functions currently affected by this are `split-window',
388 : `delete-window', `delete-other-windows' and `other-window'.
389 :
390 : An application may bind this to a non-nil value around calls to
391 : these functions to inhibit processing of window parameters.")
392 :
393 : ;; This must go to C, finally (or get removed).
394 : (defconst window-safe-min-height 1
395 : "The absolute minimum number of lines of any window.
396 : Anything less might crash Emacs.")
397 :
398 : (defun window-safe-min-pixel-height (&optional window)
399 : "Return the absolute minimum pixel height of WINDOW."
400 0 : (* window-safe-min-height
401 0 : (frame-char-size (window-normalize-window window))))
402 :
403 : (defcustom window-min-height 4
404 : "The minimum total height, in lines, of any window.
405 : The value has to accommodate one text line, a mode and header
406 : line, a horizontal scroll bar and a bottom divider, if present.
407 : A value less than `window-safe-min-height' is ignored. The value
408 : of this variable is honored when windows are resized or split.
409 :
410 : Applications should never rebind this variable. To resize a
411 : window to a height less than the one specified here, an
412 : application should instead call `window-resize' with a non-nil
413 : IGNORE argument. In order to have `split-window' make a window
414 : shorter, explicitly specify the SIZE argument of that function."
415 : :type 'integer
416 : :version "24.1"
417 : :group 'windows)
418 :
419 : (defun window-min-pixel-height (&optional window)
420 : "Return the minimum pixel height of window WINDOW."
421 116 : (* (max window-min-height window-safe-min-height)
422 116 : (frame-char-size window)))
423 :
424 : ;; This must go to C, finally (or get removed).
425 : (defconst window-safe-min-width 2
426 : "The absolute minimum number of columns of a window.
427 : Anything less might crash Emacs.")
428 :
429 : (defun window-safe-min-pixel-width (&optional window)
430 : "Return the absolute minimum pixel width of WINDOW."
431 0 : (* window-safe-min-width
432 0 : (frame-char-size (window-normalize-window window) t)))
433 :
434 : (defcustom window-min-width 10
435 : "The minimum total width, in columns, of any window.
436 : The value has to accommodate two text columns as well as margins,
437 : fringes, a scroll bar and a right divider, if present. A value
438 : less than `window-safe-min-width' is ignored. The value of this
439 : variable is honored when windows are resized or split.
440 :
441 : Applications should never rebind this variable. To resize a
442 : window to a width less than the one specified here, an
443 : application should instead call `window-resize' with a non-nil
444 : IGNORE argument. In order to have `split-window' make a window
445 : narrower, explicitly specify the SIZE argument of that function."
446 : :type 'integer
447 : :version "24.1"
448 : :group 'windows)
449 :
450 : (defun window-min-pixel-width (&optional window)
451 : "Return the minimum pixel width of window WINDOW."
452 107 : (* (max window-min-width window-safe-min-width)
453 107 : (frame-char-size window t)))
454 :
455 : (defun window-safe-min-pixel-size (&optional window horizontal)
456 : "Return the absolute minimum pixel height of WINDOW.
457 : Optional argument HORIZONTAL non-nil means return the absolute
458 : minimum pixel width of WINDOW."
459 0 : (if horizontal
460 0 : (window-safe-min-pixel-width window)
461 0 : (window-safe-min-pixel-height window)))
462 :
463 : (defun window-min-pixel-size (&optional window horizontal)
464 : "Return the minimum pixel height of WINDOW.
465 : Optional argument HORIZONTAL non-nil means return the minimum
466 : pixel width of WINDOW."
467 0 : (if horizontal
468 0 : (window-min-pixel-width window)
469 0 : (window-min-pixel-height window)))
470 :
471 : (defun window-combined-p (&optional window horizontal)
472 : "Return non-nil if WINDOW has siblings in a given direction.
473 : WINDOW must be a valid window and defaults to the selected one.
474 :
475 : HORIZONTAL determines a direction for the window combination. If
476 : HORIZONTAL is omitted or nil, return non-nil if WINDOW is part of
477 : a vertical window combination. If HORIZONTAL is non-nil, return
478 : non-nil if WINDOW is part of a horizontal window combination."
479 176 : (setq window (window-normalize-window window))
480 176 : (let ((parent (window-parent window)))
481 176 : (and parent
482 24 : (if horizontal
483 8 : (window-left-child parent)
484 176 : (window-top-child parent)))))
485 :
486 : (defun window-combination-p (&optional window horizontal)
487 : "Return WINDOW's first child if WINDOW is a vertical combination.
488 : WINDOW can be any window and defaults to the selected one.
489 : Optional argument HORIZONTAL non-nil means return WINDOW's first
490 : child if WINDOW is a horizontal combination."
491 9 : (setq window (window-normalize-window window))
492 9 : (if horizontal
493 0 : (window-left-child window)
494 9 : (window-top-child window)))
495 :
496 : (defun window-combinations (window &optional horizontal)
497 : "Return largest number of windows vertically arranged within WINDOW.
498 : WINDOW must be a valid window and defaults to the selected one.
499 : If HORIZONTAL is non-nil, return the largest number of
500 : windows horizontally arranged within WINDOW."
501 0 : (setq window (window-normalize-window window))
502 0 : (cond
503 0 : ((window-live-p window)
504 : ;; If WINDOW is live, return 1.
505 : 1)
506 0 : ((if horizontal
507 0 : (window-left-child window)
508 0 : (window-top-child window))
509 : ;; If WINDOW is iso-combined, return the sum of the values for all
510 : ;; child windows of WINDOW.
511 0 : (let ((child (window-child window))
512 : (count 0))
513 0 : (while child
514 0 : (setq count
515 0 : (+ (window-combinations child horizontal)
516 0 : count))
517 0 : (setq child (window-right child)))
518 0 : count))
519 : (t
520 : ;; If WINDOW is not iso-combined, return the maximum value of any
521 : ;; child window of WINDOW.
522 0 : (let ((child (window-child window))
523 : (count 1))
524 0 : (while child
525 0 : (setq count
526 0 : (max (window-combinations child horizontal)
527 0 : count))
528 0 : (setq child (window-right child)))
529 0 : count))))
530 :
531 : (defun walk-window-tree-1 (fun walk-window-tree-window any &optional sub-only)
532 : "Helper function for `walk-window-tree' and `walk-window-subtree'."
533 129 : (let (walk-window-tree-buffer)
534 258 : (while walk-window-tree-window
535 129 : (setq walk-window-tree-buffer
536 129 : (window-buffer walk-window-tree-window))
537 129 : (when (or walk-window-tree-buffer any)
538 129 : (funcall fun walk-window-tree-window))
539 129 : (unless walk-window-tree-buffer
540 6 : (walk-window-tree-1
541 6 : fun (window-left-child walk-window-tree-window) any)
542 6 : (walk-window-tree-1
543 129 : fun (window-top-child walk-window-tree-window) any))
544 129 : (if sub-only
545 0 : (setq walk-window-tree-window nil)
546 129 : (setq walk-window-tree-window
547 129 : (window-right walk-window-tree-window))))))
548 :
549 : (defun walk-window-tree (fun &optional frame any minibuf)
550 : "Run function FUN on each live window of FRAME.
551 : FUN must be a function with one argument - a window. FRAME must
552 : be a live frame and defaults to the selected one. ANY, if
553 : non-nil, means to run FUN on all live and internal windows of
554 : FRAME.
555 :
556 : Optional argument MINIBUF t means run FUN on FRAME's minibuffer
557 : window even if it isn't active. MINIBUF nil or omitted means run
558 : FUN on FRAME's minibuffer window only if it's active. In both
559 : cases the minibuffer window must be part of FRAME. MINIBUF
560 : neither nil nor t means never run FUN on the minibuffer window.
561 :
562 : This function performs a pre-order, depth-first traversal of the
563 : window tree. If FUN changes the window tree, the result is
564 : unpredictable."
565 117 : (setq frame (window-normalize-frame frame))
566 117 : (walk-window-tree-1 fun (frame-root-window frame) any)
567 117 : (when (memq minibuf '(nil t))
568 : ;; Run FUN on FRAME's minibuffer window if requested.
569 117 : (let ((minibuffer-window (minibuffer-window frame)))
570 117 : (when (and (window-live-p minibuffer-window)
571 117 : (eq (window-frame minibuffer-window) frame)
572 117 : (or (eq minibuf t)
573 117 : (minibuffer-window-active-p minibuffer-window)))
574 117 : (funcall fun minibuffer-window)))))
575 :
576 : (defun walk-window-subtree (fun &optional window any)
577 : "Run function FUN on the subtree of windows rooted at WINDOW.
578 : WINDOW defaults to the selected window. FUN must be a function
579 : with one argument - a window. By default, run FUN only on live
580 : windows of the subtree. If the optional argument ANY is non-nil,
581 : run FUN on all live and internal windows of the subtree. If
582 : WINDOW is live, run FUN on WINDOW only.
583 :
584 : This function performs a pre-order, depth-first traversal of the
585 : subtree rooted at WINDOW. If FUN changes that tree, the result
586 : is unpredictable."
587 0 : (setq window (window-normalize-window window))
588 0 : (walk-window-tree-1 fun window any t))
589 :
590 : (defun window-with-parameter (parameter &optional value frame any minibuf)
591 : "Return first window on FRAME with PARAMETER non-nil.
592 : FRAME defaults to the selected frame. Optional argument VALUE
593 : non-nil means only return a window whose window-parameter value
594 : for PARAMETER equals VALUE (comparison is done with `equal').
595 : Optional argument ANY non-nil means consider internal windows
596 : too.
597 :
598 : Optional argument MINIBUF t means consider FRAME's minibuffer
599 : window even if it isn't active. MINIBUF nil or omitted means
600 : consider FRAME's minibuffer window only if it's active. In both
601 : cases the minibuffer window must be part of FRAME. MINIBUF
602 : neither nil nor t means never consider the minibuffer window."
603 6 : (let (this-value)
604 6 : (catch 'found
605 6 : (walk-window-tree
606 : (lambda (window)
607 12 : (when (and (setq this-value (window-parameter window parameter))
608 12 : (or (not value) (equal value this-value)))
609 12 : (throw 'found window)))
610 6 : frame any minibuf))))
611 :
612 : ;;; Atomic windows.
613 : (defun window-atom-root (&optional window)
614 : "Return root of atomic window WINDOW is a part of.
615 : WINDOW must be a valid window and defaults to the selected one.
616 : Return nil if WINDOW is not part of an atomic window."
617 0 : (setq window (window-normalize-window window))
618 0 : (let (root)
619 0 : (while (and window (window-parameter window 'window-atom))
620 0 : (setq root window)
621 0 : (setq window (window-parent window)))
622 0 : root))
623 :
624 : (defun window-make-atom (window)
625 : "Make WINDOW an atomic window.
626 : WINDOW must be an internal window. Return WINDOW."
627 0 : (if (not (window-child window))
628 0 : (error "Window %s is not an internal window" window)
629 0 : (walk-window-subtree
630 : (lambda (window)
631 0 : (unless (window-parameter window 'window-atom)
632 0 : (set-window-parameter window 'window-atom t)))
633 0 : window t)
634 0 : window))
635 :
636 : (defun display-buffer-in-atom-window (buffer alist)
637 : "Display BUFFER in an atomic window.
638 : This function displays BUFFER in a new window that will be
639 : combined with an existing window to form an atomic window. If
640 : the existing window is already part of an atomic window, add the
641 : new window to that atomic window. Operations like `split-window'
642 : or `delete-window', when applied to a constituent of an atomic
643 : window, are applied atomically to the root of that atomic window.
644 :
645 : ALIST is an association list of symbols and values. The
646 : following symbols can be used.
647 :
648 : `window' specifies the existing window the new window shall be
649 : combined with. Use `window-atom-root' to make the new window a
650 : sibling of an atomic window's root. If an internal window is
651 : specified here, all children of that window become part of the
652 : atomic window too. If no window is specified, the new window
653 : becomes a sibling of the selected window. By default, the
654 : `window-atom' parameter of the existing window is set to `main'
655 : provided it is live and was not set before.
656 :
657 : `side' denotes the side of the existing window where the new
658 : window shall be located. Valid values are `below', `right',
659 : `above' and `left'. The default is `below'. By default, the
660 : `window-atom' parameter of the new window is set to this value.
661 :
662 : The return value is the new window, nil when creating that window
663 : failed."
664 0 : (let* ((ignore-window-parameters t)
665 : (window-combination-limit t)
666 : (window-combination-resize 'atom)
667 0 : (window (cdr (assq 'window alist)))
668 0 : (side (or (cdr (assq 'side alist)) 'below))
669 0 : (atom (when window (window-parameter window 'window-atom)))
670 : root new)
671 0 : (setq window (window-normalize-window window))
672 0 : (setq root (window-atom-root window))
673 : ;; Split off new window.
674 0 : (when (setq new (split-window-no-error window nil side))
675 0 : (window-make-atom
676 0 : (if (and root (not (eq root window)))
677 : ;; When WINDOW was part of an atomic window and we did not
678 : ;; split its root, root atomic window at old root.
679 0 : root
680 : ;; Otherwise, root atomic window at WINDOW's new parent.
681 0 : (window-parent window)))
682 : ;; Assign `window-atom' parameters, if needed.
683 0 : (when (and (not atom) (window-live-p window))
684 0 : (set-window-parameter window 'window-atom 'main))
685 0 : (set-window-parameter new 'window-atom side)
686 : ;; Display BUFFER in NEW and return NEW.
687 0 : (window--display-buffer
688 0 : buffer new 'window alist display-buffer-mark-dedicated))))
689 :
690 : (defun window--atom-check-1 (window)
691 : "Subroutine of `window--atom-check'."
692 24 : (when window
693 12 : (if (window-parameter window 'window-atom)
694 0 : (let ((count 0))
695 0 : (when (or (catch 'reset
696 0 : (walk-window-subtree
697 : (lambda (window)
698 0 : (if (window-parameter window 'window-atom)
699 0 : (setq count (1+ count))
700 0 : (throw 'reset t)))
701 0 : window t))
702 : ;; count >= 1 must hold here. If there's no other
703 : ;; window around dissolve this atomic window.
704 0 : (= count 1))
705 : ;; Dissolve atomic window.
706 0 : (walk-window-subtree
707 : (lambda (window)
708 0 : (set-window-parameter window 'window-atom nil))
709 0 : window t)))
710 : ;; Check children.
711 12 : (unless (window-buffer window)
712 3 : (window--atom-check-1 (window-left-child window))
713 12 : (window--atom-check-1 (window-top-child window))))
714 : ;; Check right sibling
715 24 : (window--atom-check-1 (window-right window))))
716 :
717 : (defun window--atom-check (&optional frame)
718 : "Check atomicity of all windows on FRAME.
719 : FRAME defaults to the selected frame. If an atomic window is
720 : wrongly configured, reset the atomicity of all its windows on
721 : FRAME to nil. An atomic window is wrongly configured if it has
722 : no child windows or one of its child windows is not atomic."
723 6 : (window--atom-check-1 (frame-root-window frame)))
724 :
725 : ;; Side windows.
726 : (defcustom window-sides-vertical nil
727 : "If non-nil, left and right side windows occupy full frame height.
728 : If nil, top and bottom side windows occupy full frame width."
729 : :type 'boolean
730 : :initialize 'custom-initialize-default
731 : :set 'window--sides-verticalize
732 : :group 'windows
733 : :version "26.1")
734 :
735 : (defcustom window-sides-reversed nil
736 : "Whether top/bottom side windows appear in reverse order.
737 : When this is nil, side windows on the top and bottom of a frame
738 : are always drawn from left to right with increasing slot values.
739 : When this is t, side windows on the top and bottom of a frame are
740 : always drawn from right to left with increasing slot values.
741 :
742 : When this is `bidi', the drawing order is like that for the value
743 : t if the value of `bidi-paragraph-direction' is `right-to-left'
744 : in the buffer most recently shown in the window selected within
745 : the main window area of this frame.
746 :
747 : The layout of side windows on the left or right of a frame is not
748 : affected by the value of this variable."
749 : :type
750 : '(choice (const :tag "Never" nil)
751 : (const :tag "Bidi" bidi)
752 : (const :tag "Always" t))
753 : :initialize 'custom-initialize-default
754 : :set 'window--sides-reverse
755 : :group 'windows
756 : :version "26.1")
757 :
758 : (defcustom window-sides-slots '(nil nil nil nil)
759 : "Number of available side window slots on each side of a frame.
760 : The value is a list of four elements specifying the maximum
761 : number of side windows that may be created on the left, top,
762 : right and bottom side of any frame.
763 :
764 : If an element is a number, `display-buffer-in-side-window' will
765 : refrain from making a new side window if the number of windows on
766 : that side is equal to or exceeds that number. Rather, it will
767 : reuse the window whose `window-slot' value is nearest to the slot
768 : specified via its ALIST argument. If an element is nil, this
769 : means there's no bound on the number of windows on that side."
770 : :version "24.1"
771 : :risky t
772 : :type
773 : '(list
774 : :value (nil nil nil nil)
775 : (choice
776 : :tag "Left"
777 : :help-echo "Maximum number of left side windows."
778 : :value nil
779 : :format "%[Left%] %v\n"
780 : (const :tag "Unlimited" :format "%t" nil)
781 : (integer :tag "Number" :value 2 :size 5))
782 : (choice
783 : :tag "Top"
784 : :help-echo "Maximum number of top side windows."
785 : :value nil
786 : :format "%[Top%] %v\n"
787 : (const :tag "Unlimited" :format "%t" nil)
788 : (integer :tag "Number" :value 3 :size 5))
789 : (choice
790 : :tag "Right"
791 : :help-echo "Maximum number of right side windows."
792 : :value nil
793 : :format "%[Right%] %v\n"
794 : (const :tag "Unlimited" :format "%t" nil)
795 : (integer :tag "Number" :value 2 :size 5))
796 : (choice
797 : :tag "Bottom"
798 : :help-echo "Maximum number of bottom side windows."
799 : :value nil
800 : :format "%[Bottom%] %v\n"
801 : (const :tag "Unlimited" :format "%t" nil)
802 : (integer :tag "Number" :value 3 :size 5)))
803 : :group 'windows)
804 :
805 : (defvar-local window--sides-shown nil
806 : "Non-nil if this buffer was shown in a side window once.
807 : If this variable is non-nil in a buffer, `switch-to-prev-buffer'
808 : and `switch-to-next-buffer' will refrain from showing this buffer
809 : within the main window area. `display-buffer-in-side-window'
810 : sets this variable automatically.
811 :
812 : Killing buffer local variables after showing the buffer in a side
813 : window annihilates any effect provided by this variable.")
814 :
815 : (defvar window--sides-inhibit-check nil
816 : "Non-nil means inhibit any checks on side windows.")
817 :
818 : (defun window--sides-reverse-on-frame-p (frame)
819 : "Return non-nil when side windows should appear reversed on FRAME.
820 : This uses some heuristics to guess the user's intentions when the
821 : selected window of FRAME is a side window ."
822 0 : (cond
823 : ;; Reverse when `window-sides-reversed' is t. Do not reverse when
824 : ;; `window-sides-reversed' is nil.
825 0 : ((memq window-sides-reversed '(nil t))
826 0 : window-sides-reversed)
827 : ;; Reverse when FRAME's selected window shows a right-to-left buffer.
828 0 : ((let ((window (frame-selected-window frame)))
829 0 : (when (and (not (window-parameter window 'window-side))
830 0 : (or (not (window-minibuffer-p window))
831 0 : (setq window (minibuffer-selected-window))))
832 0 : (with-current-buffer (window-buffer window)
833 0 : (eq bidi-paragraph-direction 'right-to-left)))))
834 : ;; Reverse when FRAME's `window-sides-main-selected-window' parameter
835 : ;; specifies a live window showing a right-to-left buffer.
836 0 : ((let ((window (frame-parameter
837 0 : frame 'window-sides-main-selected-window)))
838 0 : (when (window-live-p window)
839 0 : (with-current-buffer (window-buffer window)
840 0 : (eq bidi-paragraph-direction 'right-to-left)))))
841 : ;; Reverse when all windows in FRAME's main window show right-to-left
842 : ;; buffers.
843 : (t
844 0 : (catch 'found
845 0 : (walk-window-subtree
846 : (lambda (window)
847 0 : (with-current-buffer (window-buffer window)
848 0 : (when (eq bidi-paragraph-direction 'left-to-right)
849 0 : (throw 'found nil))))
850 0 : (window-main-window frame))
851 0 : t))))
852 :
853 : (defun window-main-window (&optional frame)
854 : "Return the main window of specified FRAME.
855 : The optional argument FRAME must be a live frame and defaults to
856 : the selected one.
857 :
858 : If FRAME has no side windows, return FRAME's root window.
859 : Otherwise, return either an internal non-side window such that
860 : all other non-side windows on FRAME descend from it, or the
861 : single live non-side window of FRAME."
862 0 : (let ((frame (window-normalize-frame frame))
863 : main sibling)
864 : ;; Set main to the _last_ window found by `walk-window-tree' that
865 : ;; is not a side window but has a side window as its sibling.
866 0 : (walk-window-tree
867 : (lambda (window)
868 0 : (and (not (window-parameter window 'window-side))
869 0 : (or (and (setq sibling (window-prev-sibling window))
870 0 : (window-parameter sibling 'window-side))
871 0 : (and (setq sibling (window-next-sibling window))
872 0 : (window-parameter sibling 'window-side)))
873 0 : (setq main window)))
874 0 : frame t 'nomini)
875 0 : (or main (frame-root-window frame))))
876 :
877 : (defun window--make-major-side-window-next-to (side)
878 : "Return window to split for making a major side window.
879 : SIDE must be one of the symbols `left', `top', `right' or
880 : `bottom'.
881 :
882 : This is an auxiliary function of `window--make-major-side-window'
883 : and must not be called when a window on SIDE exists already."
884 0 : (let ((root (frame-root-window))
885 : (window--sides-inhibit-check t)
886 : window)
887 : ;; (1) If a window on the opposite side exists, return that window's
888 : ;; sibling.
889 : ;; (2) If the new window shall span the entire side, return the
890 : ;; frame's root window.
891 : ;; (3) If a window on an orthogonal side exists, return that
892 : ;; window's sibling.
893 : ;; (4) Otherwise return the frame's root window.
894 0 : (cond
895 0 : ((or (and (eq side 'left)
896 0 : (setq window (window-with-parameter 'window-side 'right nil t)))
897 0 : (and (eq side 'top)
898 0 : (setq window (window-with-parameter 'window-side 'bottom nil t))))
899 0 : (window-prev-sibling window))
900 0 : ((or (and (eq side 'right)
901 0 : (setq window (window-with-parameter 'window-side 'left nil t)))
902 0 : (and (eq side 'bottom)
903 0 : (setq window (window-with-parameter 'window-side 'top nil t))))
904 0 : (window-next-sibling window))
905 0 : ((memq side '(left right))
906 0 : (cond
907 0 : (window-sides-vertical
908 0 : root)
909 0 : ((setq window (window-with-parameter 'window-side 'top nil t))
910 0 : (window-next-sibling window))
911 0 : ((setq window (window-with-parameter 'window-side 'bottom nil t))
912 0 : (window-prev-sibling window))
913 0 : (t root)))
914 0 : ((memq side '(top bottom))
915 0 : (cond
916 0 : ((not window-sides-vertical)
917 0 : root)
918 0 : ((setq window (window-with-parameter 'window-side 'left nil t))
919 0 : (window-next-sibling window))
920 0 : ((setq window (window-with-parameter 'window-side 'right nil t))
921 0 : (window-prev-sibling window))
922 0 : (t root))))))
923 :
924 : (defun window--make-major-side-window (buffer side slot &optional alist)
925 : "Display BUFFER in a new major side window on the selected frame.
926 : SIDE must be one of `left', `top', `right' or `bottom'. SLOT
927 : specifies the slot to use. ALIST is an association list of
928 : symbols and values as passed to `display-buffer-in-side-window'.
929 : Return the new window, nil if its creation failed.
930 :
931 : This is an auxiliary function of `display-buffer-in-side-window'
932 : and may be called only if no window on SIDE exists yet."
933 0 : (let* ((left-or-right (memq side '(left right)))
934 0 : (next-to (window--make-major-side-window-next-to side))
935 0 : (on-side (cond
936 0 : ((eq side 'top) 'above)
937 0 : ((eq side 'bottom) 'below)
938 0 : (t side)))
939 : (window--sides-inhibit-check t)
940 : ;; The following two bindings will tell `split-window' to take
941 : ;; the space for the new window from the selected frame's main
942 : ;; window and not make a new parent window unless needed.
943 : (window-combination-resize 'side)
944 : (window-combination-limit nil)
945 0 : (window (split-window-no-error next-to nil on-side)))
946 0 : (when window
947 : ;; Initialize `window-side' parameter of new window to SIDE and
948 : ;; make that parameter persistent.
949 0 : (set-window-parameter window 'window-side side)
950 0 : (add-to-list 'window-persistent-parameters '(window-side . writable))
951 : ;; Install `window-slot' parameter of new window and make that
952 : ;; parameter persistent.
953 0 : (set-window-parameter window 'window-slot slot)
954 0 : (add-to-list 'window-persistent-parameters '(window-slot . writable))
955 : ;; Auto-adjust height/width of new window unless a size has been
956 : ;; explicitly requested.
957 0 : (unless (if left-or-right
958 0 : (cdr (assq 'window-width alist))
959 0 : (cdr (assq 'window-height alist)))
960 0 : (setq alist
961 0 : (cons
962 0 : (cons
963 0 : (if left-or-right 'window-width 'window-height)
964 0 : (/ (window-total-size (frame-root-window) left-or-right)
965 : ;; By default use a fourth of the size of the frame's
966 : ;; root window.
967 0 : 4))
968 0 : alist)))
969 0 : (with-current-buffer buffer
970 0 : (setq window--sides-shown t))
971 : ;; Install BUFFER in new window and return WINDOW.
972 0 : (window--display-buffer buffer window 'window alist 'side))))
973 :
974 : (defun display-buffer-in-side-window (buffer alist)
975 : "Display BUFFER in a side window of the selected frame.
976 : ALIST is an association list of symbols and values. The
977 : following special symbols can be used in ALIST.
978 :
979 : `side' denotes the side of the frame where the new window shall
980 : be located. Valid values are `bottom', `right', `top' and
981 : `left'. The default is `bottom'.
982 :
983 : `slot' if non-nil, specifies the window slot where to display
984 : BUFFER. A value of zero or nil means use the middle slot on
985 : the specified side. A negative value means use a slot
986 : preceding (that is, above or on the left of) the middle slot.
987 : A positive value means use a slot following (that is, below or
988 : on the right of) the middle slot. The default is zero.
989 :
990 : If the current frame size or the settings of `window-sides-slots'
991 : do not permit making a new window, a suitable existing window may
992 : be reused and have its `window-slot' parameter value accordingly
993 : modified.
994 :
995 : Unless `display-buffer-mark-dedicated' is non-nil, softly
996 : dedicate the side window used to BUFFER. Return the window used
997 : for displaying BUFFER, nil if no suitable window can be found.
998 :
999 : This function installs the `window-side' and `window-slot'
1000 : parameters and makes them persistent. It neither modifies ALIST
1001 : nor installs any other window parameters unless they have been
1002 : explicitly provided via a `window-parameters' entry in ALIST."
1003 0 : (let* ((side (or (cdr (assq 'side alist)) 'bottom))
1004 0 : (slot (or (cdr (assq 'slot alist)) 0))
1005 0 : (left-or-right (memq side '(left right)))
1006 : ;; Softly dedicate window to BUFFER unless
1007 : ;; `display-buffer-mark-dedicated' already asks for it.
1008 0 : (dedicated (or display-buffer-mark-dedicated 'side)))
1009 0 : (cond
1010 0 : ((not (memq side '(top bottom left right)))
1011 0 : (error "Invalid side %s specified" side))
1012 0 : ((not (numberp slot))
1013 0 : (error "Invalid slot %s specified" slot)))
1014 :
1015 0 : (let* ((major (window-with-parameter 'window-side side nil t))
1016 : ;; `major' is the major window on SIDE, `windows' the list of
1017 : ;; life windows on SIDE.
1018 0 : (reversed (window--sides-reverse-on-frame-p (selected-frame)))
1019 : (windows
1020 0 : (cond
1021 0 : ((window-live-p major)
1022 0 : (list major))
1023 0 : ((window-valid-p major)
1024 0 : (let* ((first (window-child major))
1025 0 : (next (window-next-sibling first))
1026 0 : (windows (list next first)))
1027 0 : (setq reversed (> (window-parameter first 'window-slot)
1028 0 : (window-parameter next 'window-slot)))
1029 0 : (while (setq next (window-next-sibling next))
1030 0 : (setq windows (cons next windows)))
1031 0 : (if reversed windows (nreverse windows))))))
1032 0 : (slots (when major (max 1 (window-child-count major))))
1033 : (max-slots
1034 0 : (nth (cond
1035 0 : ((eq side 'left) 0)
1036 0 : ((eq side 'top) 1)
1037 0 : ((eq side 'right) 2)
1038 0 : ((eq side 'bottom) 3))
1039 0 : window-sides-slots))
1040 : (window--sides-inhibit-check t)
1041 : window this-window this-slot prev-window next-window
1042 : best-window best-slot abs-slot)
1043 :
1044 0 : (cond
1045 0 : ((and (numberp max-slots) (<= max-slots 0))
1046 : ;; No side-slots available on this side. Don't raise an error,
1047 : ;; just return nil.
1048 : nil)
1049 0 : ((not windows)
1050 : ;; No major side window exists on this side, make one.
1051 0 : (window--make-major-side-window buffer side slot alist))
1052 : (t
1053 : ;; Scan windows on SIDE.
1054 0 : (catch 'found
1055 0 : (dolist (window windows)
1056 0 : (setq this-slot (window-parameter window 'window-slot))
1057 0 : (cond
1058 : ;; The following should not happen and probably be checked
1059 : ;; by window--sides-check.
1060 0 : ((not (numberp this-slot)))
1061 0 : ((= this-slot slot)
1062 : ;; A window with a matching slot has been found.
1063 0 : (setq this-window window)
1064 0 : (throw 'found t))
1065 : (t
1066 : ;; Check if this window has a better slot value wrt the
1067 : ;; slot of the window we want.
1068 0 : (setq abs-slot
1069 0 : (if (or (and (> this-slot 0) (> slot 0))
1070 0 : (and (< this-slot 0) (< slot 0)))
1071 0 : (abs (- slot this-slot))
1072 0 : (+ (abs slot) (abs this-slot))))
1073 0 : (unless (and best-slot (<= best-slot abs-slot))
1074 0 : (setq best-window window)
1075 0 : (setq best-slot abs-slot))
1076 0 : (if reversed
1077 0 : (cond
1078 0 : ((<= this-slot slot)
1079 0 : (setq next-window window))
1080 0 : ((not prev-window)
1081 0 : (setq prev-window window)))
1082 0 : (cond
1083 0 : ((<= this-slot slot)
1084 0 : (setq prev-window window))
1085 0 : ((not next-window)
1086 0 : (setq next-window window))))))))
1087 :
1088 : ;; `this-window' is the first window with the same SLOT.
1089 : ;; `prev-window' is the window with the largest slot < SLOT. A new
1090 : ;; window will be created after it.
1091 : ;; `next-window' is the window with the smallest slot > SLOT. A new
1092 : ;; window will be created before it.
1093 : ;; `best-window' is the window with the smallest absolute difference
1094 : ;; of its slot and SLOT.
1095 0 : (or (and this-window
1096 : ;; Reuse `this-window'.
1097 0 : (with-current-buffer buffer
1098 0 : (setq window--sides-shown t))
1099 0 : (window--display-buffer
1100 0 : buffer this-window 'reuse alist dedicated))
1101 0 : (and (or (not max-slots) (< slots max-slots))
1102 0 : (or (and next-window
1103 : ;; Make new window before `next-window'.
1104 0 : (let ((next-side (if left-or-right 'above 'left))
1105 : (window-combination-resize 'side))
1106 0 : (setq window (split-window-no-error
1107 0 : next-window nil next-side))))
1108 0 : (and prev-window
1109 : ;; Make new window after `prev-window'.
1110 0 : (let ((prev-side (if left-or-right 'below 'right))
1111 : (window-combination-resize 'side))
1112 0 : (setq window (split-window-no-error
1113 0 : prev-window nil prev-side)))))
1114 0 : (set-window-parameter window 'window-slot slot)
1115 0 : (with-current-buffer buffer
1116 0 : (setq window--sides-shown t))
1117 0 : (window--display-buffer
1118 0 : buffer window 'window alist dedicated))
1119 0 : (and best-window
1120 : ;; Reuse `best-window'.
1121 0 : (progn
1122 : ;; Give best-window the new slot value.
1123 0 : (set-window-parameter best-window 'window-slot slot)
1124 0 : (with-current-buffer buffer
1125 0 : (setq window--sides-shown t))
1126 0 : (window--display-buffer
1127 0 : buffer best-window 'reuse alist dedicated)))))))))
1128 :
1129 : (defun window-toggle-side-windows (&optional frame)
1130 : "Toggle side windows on specified FRAME.
1131 : FRAME must be a live frame and defaults to the selected one.
1132 :
1133 : If FRAME has at least one side window, save FRAME's state in the
1134 : FRAME's `window-state' frame parameter and delete all side
1135 : windows on FRAME afterwards. Otherwise, if FRAME has a
1136 : `window-state' parameter, use that to restore any side windows on
1137 : FRAME leaving FRAME's main window alone. Signal an error if
1138 : FRAME has no side window and no saved state is found."
1139 : (interactive)
1140 0 : (let* ((frame (window-normalize-frame frame))
1141 : (window--sides-inhibit-check t)
1142 : state)
1143 0 : (cond
1144 0 : ((window-with-parameter 'window-side nil frame)
1145 : ;; At least one side window exists. Remove all side windows after
1146 : ;; saving FRAME's state in its `window-state' parameter.
1147 0 : (set-frame-parameter
1148 0 : frame 'window-state (window-state-get (frame-root-window frame)))
1149 0 : (let ((ignore-window-parameters t))
1150 0 : (delete-other-windows (window-main-window frame))))
1151 0 : ((setq state (frame-parameter frame 'window-state))
1152 : ;; A window state was saved for FRAME. Restore it and put the
1153 : ;; current root window into its main window.
1154 0 : (let ((main-state (window-state-get (frame-root-window frame))))
1155 0 : (window-state-put state (frame-root-window frame) t)
1156 0 : (window-state-put main-state (window-main-window frame)))
1157 0 : (window--sides-reverse-frame frame))
1158 : (t
1159 0 : (error "No side windows state found")))))
1160 :
1161 : (defun window--sides-reverse-all ()
1162 : "Maybe reverse side windows on all frames."
1163 0 : (unless window--sides-inhibit-check
1164 0 : (dolist (frame (frame-list))
1165 0 : (window--sides-reverse-frame frame))))
1166 :
1167 : (defun window--sides-reverse-frame (frame)
1168 : "Maybe reverse side windows on FRAME."
1169 0 : (when (eq window-sides-reversed 'bidi)
1170 0 : (let ((window (frame-selected-window frame)))
1171 0 : (unless (or (window-parameter window 'window-side)
1172 0 : (window-minibuffer-p window))
1173 0 : (set-frame-parameter
1174 0 : frame 'window-sides-main-selected-window window))))
1175 0 : (window--sides-reverse-side frame 'top)
1176 0 : (window--sides-reverse-side frame 'bottom))
1177 :
1178 : (defun window--sides-reverse-side (frame side)
1179 : "Maybe reverse windows on SIDE of FRAME."
1180 0 : (let ((major (window-with-parameter 'window-side side frame t))
1181 : (window--sides-inhibit-check t))
1182 0 : (when (and major (not (window-live-p major)))
1183 0 : (let* ((first (window-child major))
1184 0 : (reversed (> (window-parameter first 'window-slot)
1185 0 : (window-parameter
1186 0 : (window-next-sibling first) 'window-slot)))
1187 0 : (reverse (window--sides-reverse-on-frame-p frame)))
1188 0 : (unless (eq reversed reverse)
1189 : ;; We have to reverse.
1190 0 : (let ((last (window-last-child major)))
1191 0 : (while (and (not (eq first last))
1192 0 : (not (eq first (window-next-sibling last))))
1193 0 : (window-swap-states first last t)
1194 0 : (setq first (window-next-sibling first))
1195 0 : (setq last (window-prev-sibling last)))))))))
1196 :
1197 : (defun window--sides-reverse (symbol value)
1198 : "Helper function for customizing `window-sides-reversed'."
1199 0 : (set-default symbol value)
1200 0 : (remove-hook 'buffer-list-update-hook 'window--sides-reverse-all)
1201 0 : (remove-hook 'window-configuration-change-hook 'window--sides-reverse-all)
1202 0 : (dolist (frame (frame-list))
1203 0 : (set-frame-parameter frame 'window-sides-main-selected-window nil))
1204 0 : (when (eq value 'bidi)
1205 0 : (add-hook 'buffer-list-update-hook 'window--sides-reverse-all)
1206 0 : (add-hook 'window-configuration-change-hook 'window--sides-reverse-all))
1207 0 : (window--sides-reverse-all))
1208 :
1209 : (defun window--sides-verticalize-frame (&optional frame)
1210 : "Maybe change side windows layout on specified FRAME."
1211 0 : (setq frame (window-normalize-frame frame))
1212 0 : (let ((window--sides-inhibit-check t)
1213 0 : (root (frame-root-window frame))
1214 0 : (main (window-main-window frame)))
1215 0 : (when (and (not (eq main root))
1216 0 : (not (eq (window-parent main) root))
1217 0 : (window-combined-p main window-sides-vertical))
1218 0 : (let* ((window--sides-inhibit-check t)
1219 : (ignore-window-parameters t)
1220 0 : (first (window-child root))
1221 : (first-state
1222 0 : (and first (window-parameter first 'window-side)
1223 0 : (window-state-get first)))
1224 0 : (last (window-last-child root))
1225 : (last-state
1226 0 : (and last (window-parameter last 'window-side)
1227 0 : (window-state-get last)))
1228 0 : (dummy (get-buffer-create " *dummy*"))
1229 : major)
1230 0 : (unwind-protect
1231 0 : (progn
1232 0 : (when first-state (delete-window first))
1233 0 : (when last-state (delete-window last))
1234 0 : (when first-state
1235 0 : (setq major (window--make-major-side-window
1236 0 : dummy (if window-sides-vertical 'top 'left) 0))
1237 0 : (window-state-put first-state major t))
1238 0 : (when last-state
1239 0 : (setq major (window--make-major-side-window
1240 0 : dummy (if window-sides-vertical 'bottom 'right) 0))
1241 0 : (window-state-put last-state major t)))
1242 0 : (kill-buffer " *dummy*"))))))
1243 :
1244 : (defun window--sides-verticalize (symbol value)
1245 : "Helper function for customizing `window-sides-vertical'."
1246 0 : (set-default symbol value)
1247 0 : (dolist (frame (frame-list))
1248 0 : (window--sides-verticalize-frame frame)))
1249 :
1250 : (defun window--sides-check-failed (frame)
1251 : "Helper function for `window--sides-check'."
1252 0 : (catch 'failed
1253 : ;; FRAME must have a main window.
1254 0 : (unless (window-main-window frame)
1255 0 : (error "Frame %s has no main window" frame)
1256 0 : (throw 'failed t))
1257 : ;; Now check the side windows.
1258 0 : (dolist (side '(left top right bottom))
1259 0 : (let ((window (window-with-parameter 'window-side side frame t)))
1260 0 : (when window
1261 : ;; If WINDOW is live there must be no other window on this frame
1262 : ;; with the same `window-side' parameter.
1263 0 : (if (window-live-p window)
1264 0 : (walk-window-tree
1265 : (lambda (this)
1266 0 : (when (and (eq (window-parameter this 'window-side) side)
1267 0 : (not (eq this window)))
1268 0 : (error "Window %s has same side %s as window %s but no common parent"
1269 0 : this side window)
1270 0 : (throw 'failed t)))
1271 0 : frame t 'nomini)
1272 0 : (walk-window-tree
1273 : (lambda (this)
1274 0 : (if (eq (window-parent this) window)
1275 0 : (unless (eq (window-parameter this 'window-side) side)
1276 0 : (error "Window %s has not same side %s as its parent %s"
1277 0 : this side window)
1278 0 : (throw 'failed t))
1279 0 : (when (and (eq (window-parameter this 'window-side) side)
1280 0 : (not (eq this window)))
1281 0 : (error "Window %s has same side %s as major side window %s but its parent is %s"
1282 0 : this side window (window-parent this))
1283 0 : (throw 'failed t))))
1284 0 : frame t 'nomini)))))))
1285 :
1286 : (defun window--sides-check (frame)
1287 : "Check side windows configuration of FRAME.
1288 : In a valid side windows configuration there can be at most one
1289 : internal side window on each side and all its children must be
1290 : live and have the same `window-side' parameter and no other
1291 : window with the same `window-side' parameter exists on FRAME. If
1292 : there is no such internal window, there may be at most one window
1293 : with this side's `window-side' parameter on FRAME.
1294 :
1295 : If the configuration is invalid, reset the `window-side'
1296 : parameters of all windows on FRAME."
1297 6 : (when (and (not window--sides-inhibit-check)
1298 6 : (window-with-parameter 'window-side nil frame t)
1299 6 : (window--sides-check-failed frame))
1300 : ;; Reset all `window-side' parameters.
1301 0 : (walk-window-tree
1302 : (lambda (window)
1303 0 : (set-window-parameter window 'window-side nil))
1304 0 : frame t 'nomini)
1305 6 : (message "Side windows configuration reset for frame %s" frame)))
1306 :
1307 : (defun window--check (&optional frame)
1308 : "Check atomic and side windows on FRAME.
1309 : FRAME defaults to the selected frame."
1310 6 : (window--sides-check frame)
1311 6 : (window--atom-check frame))
1312 :
1313 : ;; Dumping frame/window contents.
1314 : (defun window--dump-window (&optional window erase)
1315 : "Dump WINDOW to buffer *window-frame-dump*.
1316 : WINDOW must be a valid window and defaults to the selected one.
1317 : Optional argument ERASE non-nil means erase *window-frame-dump*
1318 : before writing to it."
1319 0 : (setq window (window-normalize-window window))
1320 0 : (with-current-buffer (get-buffer-create "*window-frame-dump*")
1321 0 : (when erase (erase-buffer))
1322 0 : (insert
1323 0 : (format "%s parent: %s\n" window (window-parent window))
1324 0 : (format "pixel left: %s top: %s size: %s x %s new: %s\n"
1325 0 : (window-pixel-left window) (window-pixel-top window)
1326 0 : (window-size window t t) (window-size window nil t)
1327 0 : (window-new-pixel window))
1328 0 : (format "char left: %s top: %s size: %s x %s new: %s\n"
1329 0 : (window-left-column window) (window-top-line window)
1330 0 : (window-total-size window t) (window-total-size window)
1331 0 : (window-new-total window))
1332 0 : (format "normal: %s x %s new: %s\n"
1333 0 : (window-normal-size window t) (window-normal-size window)
1334 0 : (window-new-normal window)))
1335 0 : (when (window-live-p window)
1336 0 : (let ((fringes (window-fringes window))
1337 0 : (margins (window-margins window)))
1338 0 : (insert
1339 0 : (format "body pixel: %s x %s char: %s x %s\n"
1340 0 : (window-body-width window t) (window-body-height window t)
1341 0 : (window-body-width window) (window-body-height window))
1342 0 : (format "width left fringe: %s left margin: %s right margin: %s\n"
1343 0 : (car fringes) (or (car margins) 0) (or (cdr margins) 0))
1344 0 : (format "width right fringe: %s scroll-bar: %s divider: %s\n"
1345 0 : (cadr fringes)
1346 0 : (window-scroll-bar-width window)
1347 0 : (window-right-divider-width window))
1348 0 : (format "height header-line: %s mode-line: %s divider: %s\n"
1349 0 : (window-header-line-height window)
1350 0 : (window-mode-line-height window)
1351 0 : (window-bottom-divider-width window)))))
1352 0 : (insert "\n")))
1353 :
1354 : (defun window--dump-frame (&optional window-or-frame)
1355 : "Dump WINDOW-OR-FRAME to buffer *window-frame-dump*.
1356 : WINDOW-OR-FRAME can be a frame or a window and defaults to the
1357 : selected frame. When WINDOW-OR-FRAME is a window, dump that
1358 : window's frame. The buffer *window-frame-dump* is erased before
1359 : dumping to it."
1360 0 : (let* ((window
1361 0 : (cond
1362 0 : ((or (not window-or-frame)
1363 0 : (frame-live-p window-or-frame))
1364 0 : (frame-root-window window-or-frame))
1365 0 : ((or (window-live-p window-or-frame)
1366 0 : (window-child window-or-frame))
1367 0 : window-or-frame)
1368 : (t
1369 0 : (frame-root-window))))
1370 0 : (frame (window-frame window)))
1371 0 : (with-current-buffer (get-buffer-create "*window-frame-dump*")
1372 0 : (erase-buffer)
1373 0 : (insert
1374 0 : (format "frame pixel: %s x %s cols/lines: %s x %s units: %s x %s\n"
1375 0 : (frame-pixel-width frame) (frame-pixel-height frame)
1376 0 : (frame-total-cols frame) (frame-total-lines frame)
1377 0 : (frame-char-width frame) (frame-char-height frame))
1378 0 : (format "frame text pixel: %s x %s cols/lines: %s x %s\n"
1379 0 : (frame-text-width frame) (frame-text-height frame)
1380 0 : (frame-text-cols frame) (frame-text-lines frame))
1381 0 : (format "tool: %s scroll: %s/%s fringe: %s border: %s right: %s bottom: %s\n\n"
1382 0 : (if (fboundp 'tool-bar-height)
1383 0 : (tool-bar-height frame t)
1384 0 : "0")
1385 0 : (frame-scroll-bar-width frame)
1386 0 : (frame-scroll-bar-height frame)
1387 0 : (frame-fringe-width frame)
1388 0 : (frame-border-width frame)
1389 0 : (frame-right-divider-width frame)
1390 0 : (frame-bottom-divider-width frame)))
1391 0 : (walk-window-tree 'window--dump-window frame t t))))
1392 :
1393 : ;;; Window sizes.
1394 : (defun window-total-size (&optional window horizontal round)
1395 : "Return the total height or width of WINDOW.
1396 : WINDOW must be a valid window and defaults to the selected one.
1397 :
1398 : If HORIZONTAL is omitted or nil, return the total height of
1399 : WINDOW, in lines. If WINDOW is live, its total height includes,
1400 : in addition to the height of WINDOW's text, the heights of
1401 : WINDOW's mode and header line and a bottom divider, if any.
1402 :
1403 : If HORIZONTAL is non-nil, return the total width of WINDOW, in
1404 : columns. If WINDOW is live, its total width includes, in
1405 : addition to the width of WINDOW's text, the widths of WINDOW's
1406 : fringes, margins, scroll bars and its right divider, if any.
1407 :
1408 : If WINDOW is internal, return the respective size of the screen
1409 : areas spanned by its children.
1410 :
1411 : Optional argument ROUND is handled as for `window-total-height'
1412 : and `window-total-width'."
1413 0 : (if horizontal
1414 0 : (window-total-width window round)
1415 0 : (window-total-height window round)))
1416 :
1417 : (defun window-size (&optional window horizontal pixelwise round)
1418 : "Return the height or width of WINDOW.
1419 : WINDOW must be a valid window and defaults to the selected one.
1420 :
1421 : If HORIZONTAL is omitted or nil, return the total height of
1422 : WINDOW, in lines, like `window-total-height'. Otherwise return
1423 : the total width, in columns, like `window-total-width'.
1424 :
1425 : Optional argument PIXELWISE means return the pixel size of WINDOW
1426 : like `window-pixel-height' and `window-pixel-width'.
1427 :
1428 : Optional argument ROUND is ignored if PIXELWISE is non-nil and
1429 : handled as for `window-total-height' and `window-total-width'
1430 : otherwise."
1431 135 : (if horizontal
1432 54 : (if pixelwise
1433 54 : (window-pixel-width window)
1434 54 : (window-total-width window round))
1435 81 : (if pixelwise
1436 78 : (window-pixel-height window)
1437 135 : (window-total-height window round))))
1438 :
1439 : (defvar window-size-fixed nil
1440 : "Non-nil in a buffer means windows displaying the buffer are fixed-size.
1441 : If the value is `height', then only the window's height is fixed.
1442 : If the value is `width', then only the window's width is fixed.
1443 : Any other non-nil value fixes both the width and the height.
1444 :
1445 : Emacs won't change the size of any window displaying that buffer,
1446 : unless it has no other choice (like when deleting a neighboring
1447 : window).")
1448 : (make-variable-buffer-local 'window-size-fixed)
1449 :
1450 : (defun window--preservable-size (window &optional horizontal)
1451 : "Return height of WINDOW as `window-preserve-size' would preserve it.
1452 : Optional argument HORIZONTAL non-nil means to return the width of
1453 : WINDOW as `window-preserve-size' would preserve it."
1454 0 : (if horizontal
1455 0 : (window-body-width window t)
1456 0 : (+ (window-body-height window t)
1457 0 : (window-header-line-height window)
1458 0 : (window-mode-line-height window))))
1459 :
1460 : (defun window-preserve-size (&optional window horizontal preserve)
1461 : "Preserve height of window WINDOW.
1462 : WINDOW must be a live window and defaults to the selected one.
1463 : Optional argument HORIZONTAL non-nil means preserve the width of
1464 : WINDOW.
1465 :
1466 : PRESERVE t means to preserve the current height/width of WINDOW's
1467 : body in frame and window resizing operations whenever possible.
1468 : The height/width of WINDOW will change only if Emacs has no other
1469 : choice. Resizing a window whose height/width is preserved never
1470 : throws an error.
1471 :
1472 : PRESERVE nil means to stop preserving the height/width of WINDOW,
1473 : lifting the respective restraint induced by a previous call of
1474 : `window-preserve-size' for WINDOW. Calling `enlarge-window',
1475 : `shrink-window', `split-window' or `fit-window-to-buffer' with
1476 : WINDOW as argument also removes the respective restraint.
1477 :
1478 : Other values of PRESERVE are reserved for future use."
1479 0 : (setq window (window-normalize-window window t))
1480 0 : (let* ((parameter (window-parameter window 'window-preserved-size))
1481 0 : (width (nth 1 parameter))
1482 0 : (height (nth 2 parameter)))
1483 0 : (if horizontal
1484 0 : (set-window-parameter
1485 0 : window 'window-preserved-size
1486 0 : (list
1487 0 : (window-buffer window)
1488 0 : (and preserve (window--preservable-size window t))
1489 0 : height))
1490 0 : (set-window-parameter
1491 0 : window 'window-preserved-size
1492 0 : (list
1493 0 : (window-buffer window)
1494 0 : width
1495 0 : (and preserve (window--preservable-size window)))))))
1496 :
1497 : (defun window-preserved-size (&optional window horizontal)
1498 : "Return preserved height of window WINDOW.
1499 : WINDOW must be a live window and defaults to the selected one.
1500 : Optional argument HORIZONTAL non-nil means to return preserved
1501 : width of WINDOW."
1502 223 : (setq window (window-normalize-window window t))
1503 223 : (let* ((parameter (window-parameter window 'window-preserved-size))
1504 223 : (buffer (nth 0 parameter))
1505 223 : (width (nth 1 parameter))
1506 223 : (height (nth 2 parameter)))
1507 223 : (when (eq buffer (window-buffer window))
1508 223 : (if horizontal width height))))
1509 :
1510 : (defun window--preserve-size (window horizontal)
1511 : "Return non-nil when the height of WINDOW shall be preserved.
1512 : Optional argument HORIZONTAL non-nil means to return non-nil when
1513 : the width of WINDOW shall be preserved."
1514 223 : (let ((size (window-preserved-size window horizontal)))
1515 223 : (and (numberp size)
1516 223 : (= size (window--preservable-size window horizontal)))))
1517 :
1518 : (defun window-safe-min-size (&optional window horizontal pixelwise)
1519 : "Return safe minimum size of WINDOW.
1520 : WINDOW must be a valid window and defaults to the selected one.
1521 : Optional argument HORIZONTAL non-nil means return the minimum
1522 : number of columns of WINDOW; otherwise return the minimum number
1523 : of WINDOW's lines.
1524 :
1525 : Optional argument PIXELWISE non-nil means return the minimum pixel-size
1526 : of WINDOW."
1527 225 : (setq window (window-normalize-window window))
1528 225 : (if pixelwise
1529 225 : (if horizontal
1530 108 : (* window-safe-min-width
1531 108 : (frame-char-width (window-frame window)))
1532 117 : (* window-safe-min-height
1533 225 : (frame-char-height (window-frame window))))
1534 225 : (if horizontal window-safe-min-width window-safe-min-height)))
1535 :
1536 : (defun window-min-size (&optional window horizontal ignore pixelwise)
1537 : "Return the minimum size of WINDOW.
1538 : WINDOW must be a valid window and defaults to the selected one.
1539 : Optional argument HORIZONTAL non-nil means return the minimum
1540 : number of columns of WINDOW; otherwise return the minimum number
1541 : of WINDOW's lines.
1542 :
1543 : The optional argument IGNORE has the same meaning as for
1544 : `window-resizable'. Optional argument PIXELWISE non-nil means
1545 : return the minimum pixel-size of WINDOW."
1546 279 : (window--min-size-1
1547 279 : (window-normalize-window window) horizontal ignore pixelwise))
1548 :
1549 : (defun window--min-size-ignore-p (window ignore)
1550 : "Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
1551 225 : (if (window-valid-p ignore)
1552 0 : (eq window ignore)
1553 225 : (not (memq ignore '(nil preserved)))))
1554 :
1555 : (defun window--min-size-1 (window horizontal ignore pixelwise)
1556 : "Internal function of `window-min-size'."
1557 279 : (let ((sub (window-child window)))
1558 279 : (if sub
1559 0 : (let ((value 0))
1560 : ;; WINDOW is an internal window.
1561 0 : (if (window-combined-p sub horizontal)
1562 : ;; The minimum size of an iso-combination is the sum of
1563 : ;; the minimum sizes of its child windows.
1564 0 : (while sub
1565 0 : (setq value (+ value
1566 0 : (window--min-size-1
1567 0 : sub horizontal ignore pixelwise)))
1568 0 : (setq sub (window-right sub)))
1569 : ;; The minimum size of an ortho-combination is the maximum
1570 : ;; of the minimum sizes of its child windows.
1571 0 : (while sub
1572 0 : (setq value (max value
1573 0 : (window--min-size-1
1574 0 : sub horizontal ignore pixelwise)))
1575 0 : (setq sub (window-right sub))))
1576 0 : value)
1577 279 : (with-current-buffer (window-buffer window)
1578 279 : (cond
1579 279 : ((window-minibuffer-p window)
1580 54 : (if pixelwise (frame-char-height (window-frame window)) 1))
1581 225 : ((window-size-fixed-p window horizontal ignore)
1582 : ;; The minimum size of a fixed size window is its size.
1583 0 : (window-size window horizontal pixelwise))
1584 225 : ((eq ignore 'safe)
1585 : ;; If IGNORE equals `safe' return the safe value.
1586 0 : (window-safe-min-size window horizontal pixelwise))
1587 225 : (horizontal
1588 : ;; For the minimum width of a window take fringes and
1589 : ;; scroll-bars into account. This is questionable and should
1590 : ;; be removed as soon as we are able to split (and resize)
1591 : ;; windows such that the new (or resized) windows can get a
1592 : ;; size less than the user-specified `window-min-height' and
1593 : ;; `window-min-width'.
1594 108 : (let* ((char-size (frame-char-size window t))
1595 108 : (fringes (window-fringes window))
1596 108 : (margins (window-margins window))
1597 : ;; Let the 'min-margins' parameter override the actual
1598 : ;; widths of the margins. We allow any number to
1599 : ;; replace the values specified by `window-margins'.
1600 : ;; See bug#24193 for the rationale of this parameter.
1601 108 : (min-margins (window-parameter window 'min-margins))
1602 108 : (left-min-margin (and min-margins
1603 0 : (numberp (car min-margins))
1604 108 : (car min-margins)))
1605 108 : (right-min-margin (and min-margins
1606 0 : (numberp (cdr min-margins))
1607 108 : (cdr min-margins)))
1608 : (pixel-width
1609 108 : (+ (window-safe-min-size window t t)
1610 108 : (* (or left-min-margin (car margins) 0) char-size)
1611 108 : (* (or right-min-margin(cdr margins) 0) char-size)
1612 108 : (car fringes) (cadr fringes)
1613 108 : (window-scroll-bar-width window)
1614 108 : (window-right-divider-width window))))
1615 108 : (if pixelwise
1616 108 : (max
1617 108 : (if window-resize-pixelwise
1618 0 : pixel-width
1619 : ;; Round up to next integral of columns.
1620 108 : (* (ceiling pixel-width char-size) char-size))
1621 108 : (if (window--min-size-ignore-p window ignore)
1622 : 0
1623 108 : (window-min-pixel-width window)))
1624 0 : (max
1625 0 : (ceiling pixel-width char-size)
1626 0 : (if (window--min-size-ignore-p window ignore)
1627 : 0
1628 108 : window-min-width)))))
1629 117 : ((let ((char-size (frame-char-size window))
1630 : (pixel-height
1631 117 : (+ (window-safe-min-size window nil t)
1632 117 : (window-header-line-height window)
1633 117 : (window-scroll-bar-height window)
1634 117 : (window-mode-line-height window)
1635 117 : (window-bottom-divider-width window))))
1636 117 : (if pixelwise
1637 117 : (max
1638 117 : (if window-resize-pixelwise
1639 0 : pixel-height
1640 : ;; Round up to next integral of lines.
1641 117 : (* (ceiling pixel-height char-size) char-size))
1642 117 : (if (window--min-size-ignore-p window ignore)
1643 : 0
1644 117 : (window-min-pixel-height window)))
1645 0 : (max (ceiling pixel-height char-size)
1646 0 : (if (window--min-size-ignore-p window ignore)
1647 : 0
1648 279 : window-min-height))))))))))
1649 :
1650 : (defun window-sizable (window delta &optional horizontal ignore pixelwise)
1651 : "Return DELTA if DELTA lines can be added to WINDOW.
1652 : WINDOW must be a valid window and defaults to the selected one.
1653 : Optional argument HORIZONTAL non-nil means return DELTA if DELTA
1654 : columns can be added to WINDOW. A return value of zero means
1655 : that no lines (or columns) can be added to WINDOW.
1656 :
1657 : This function looks only at WINDOW and, recursively, its child
1658 : windows. The function `window-resizable' looks at other windows
1659 : as well.
1660 :
1661 : DELTA positive means WINDOW shall be enlarged by DELTA lines or
1662 : columns. If WINDOW cannot be enlarged by DELTA lines or columns
1663 : return the maximum value in the range 0..DELTA by which WINDOW
1664 : can be enlarged.
1665 :
1666 : DELTA negative means WINDOW shall be shrunk by -DELTA lines or
1667 : columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
1668 : return the minimum value in the range DELTA..0 by which WINDOW
1669 : can be shrunk.
1670 :
1671 : The optional argument IGNORE has the same meaning as for
1672 : `window-resizable'. Optional argument PIXELWISE non-nil means
1673 : interpret DELTA as pixels."
1674 0 : (setq window (window-normalize-window window))
1675 0 : (cond
1676 0 : ((< delta 0)
1677 0 : (max (- (window-min-size window horizontal ignore pixelwise)
1678 0 : (window-size window horizontal pixelwise))
1679 0 : delta))
1680 0 : ((> delta 0)
1681 0 : (if (window-size-fixed-p window horizontal ignore)
1682 : 0
1683 0 : delta))
1684 0 : (t 0)))
1685 :
1686 : (defun window-sizable-p (window delta &optional horizontal ignore pixelwise)
1687 : "Return t if WINDOW can be resized by DELTA lines.
1688 : WINDOW must be a valid window and defaults to the selected one.
1689 : For the meaning of the arguments of this function see the
1690 : doc-string of `window-sizable'."
1691 0 : (setq window (window-normalize-window window))
1692 0 : (if (> delta 0)
1693 0 : (>= (window-sizable window delta horizontal ignore pixelwise)
1694 0 : delta)
1695 0 : (<= (window-sizable window delta horizontal ignore pixelwise)
1696 0 : delta)))
1697 :
1698 : (defun window--size-fixed-1 (window horizontal ignore)
1699 : "Internal function for `window-size-fixed-p'."
1700 223 : (let ((sub (window-child window)))
1701 223 : (catch 'fixed
1702 223 : (if sub
1703 : ;; WINDOW is an internal window.
1704 0 : (if (window-combined-p sub horizontal)
1705 : ;; An iso-combination is fixed size if all its child
1706 : ;; windows are fixed-size.
1707 0 : (progn
1708 0 : (while sub
1709 0 : (unless (window--size-fixed-1 sub horizontal ignore)
1710 : ;; We found a non-fixed-size child window, so
1711 : ;; WINDOW's size is not fixed.
1712 0 : (throw 'fixed nil))
1713 0 : (setq sub (window-right sub)))
1714 : ;; All child windows are fixed-size, so WINDOW's size is
1715 : ;; fixed.
1716 0 : (throw 'fixed t))
1717 : ;; An ortho-combination is fixed-size if at least one of its
1718 : ;; child windows is fixed-size.
1719 0 : (while sub
1720 0 : (when (window--size-fixed-1 sub horizontal ignore)
1721 : ;; We found a fixed-size child window, so WINDOW's size
1722 : ;; is fixed.
1723 0 : (throw 'fixed t))
1724 0 : (setq sub (window-right sub))))
1725 : ;; WINDOW is a live window.
1726 223 : (and (or (not (windowp ignore)) (not (eq window ignore)))
1727 223 : (or (and (not (eq ignore 'preserved))
1728 223 : (window--preserve-size window horizontal))
1729 223 : (with-current-buffer (window-buffer window)
1730 223 : (if horizontal
1731 107 : (memq window-size-fixed '(width t))
1732 223 : (memq window-size-fixed '(height t))))))))))
1733 :
1734 : (defun window-size-fixed-p (&optional window horizontal ignore)
1735 : "Return non-nil if WINDOW's height is fixed.
1736 : WINDOW must be a valid window and defaults to the selected one.
1737 : Optional argument HORIZONTAL non-nil means return non-nil if
1738 : WINDOW's width is fixed. The optional argument IGNORE has the
1739 : same meaning as for `window-resizable'.
1740 :
1741 : If this function returns nil, this does not necessarily mean that
1742 : WINDOW can be resized in the desired direction. The function
1743 : `window-resizable' can tell that."
1744 225 : (when (or (windowp ignore) (memq ignore '(nil preserved)))
1745 223 : (window--size-fixed-1
1746 225 : (window-normalize-window window) horizontal ignore)))
1747 :
1748 : (defun window--min-delta-1 (window delta &optional horizontal ignore trail noup pixelwise)
1749 : "Internal function for `window-min-delta'."
1750 0 : (if (not (window-parent window))
1751 : ;; If we can't go up, return zero.
1752 : 0
1753 : ;; Else try to find a non-fixed-size sibling of WINDOW.
1754 0 : (let* ((parent (window-parent window))
1755 0 : (sub (window-child parent)))
1756 0 : (catch 'done
1757 0 : (if (window-combined-p sub horizontal)
1758 : ;; In an iso-combination throw DELTA if we find at least one
1759 : ;; child window and that window is either not fixed-size or
1760 : ;; we can ignore fixed-sizeness.
1761 0 : (let ((skip (eq trail 'after)))
1762 0 : (while sub
1763 0 : (cond
1764 0 : ((eq sub window)
1765 0 : (setq skip (eq trail 'before)))
1766 0 : (skip)
1767 0 : ((window-size-fixed-p sub horizontal ignore))
1768 : (t
1769 : ;; We found a non-fixed-size child window.
1770 0 : (throw 'done delta)))
1771 0 : (setq sub (window-right sub))))
1772 : ;; In an ortho-combination set DELTA to the minimum value by
1773 : ;; which other child windows can shrink.
1774 0 : (while sub
1775 0 : (unless (eq sub window)
1776 0 : (setq delta
1777 0 : (min delta
1778 0 : (max (- (window-size sub horizontal pixelwise 'ceiling)
1779 0 : (window-min-size
1780 0 : sub horizontal ignore pixelwise))
1781 0 : 0))))
1782 0 : (setq sub (window-right sub))))
1783 0 : (if noup
1784 0 : delta
1785 0 : (window--min-delta-1
1786 0 : parent delta horizontal ignore trail nil pixelwise))))))
1787 :
1788 : (defun window-min-delta (&optional window horizontal ignore trail noup nodown pixelwise)
1789 : "Return number of lines by which WINDOW can be shrunk.
1790 : WINDOW must be a valid window and defaults to the selected one.
1791 : Return zero if WINDOW cannot be shrunk.
1792 :
1793 : Optional argument HORIZONTAL non-nil means return number of
1794 : columns by which WINDOW can be shrunk.
1795 :
1796 : The optional argument IGNORE has the same meaning as for
1797 : `window-resizable'. Optional argument TRAIL restricts the
1798 : windows that can be enlarged. If its value is `before', only
1799 : windows to the left of or above WINDOW can be enlarged. If it is
1800 : `after', only windows to the right of or below WINDOW can be
1801 : enlarged.
1802 :
1803 : Optional argument NOUP non-nil means don't go up in the window
1804 : tree, but try to enlarge windows within WINDOW's combination
1805 : only. Optional argument NODOWN non-nil means don't check whether
1806 : WINDOW itself (and its child windows) can be shrunk; check only
1807 : whether at least one other window can be enlarged appropriately.
1808 :
1809 : Optional argument PIXELWISE non-nil means return number of pixels
1810 : by which WINDOW can be shrunk."
1811 0 : (setq window (window-normalize-window window))
1812 0 : (let ((size (window-size window horizontal pixelwise 'floor))
1813 0 : (minimum (window-min-size window horizontal ignore pixelwise)))
1814 0 : (cond
1815 0 : (nodown
1816 : ;; If NODOWN is t, try to recover the entire size of WINDOW.
1817 0 : (window--min-delta-1
1818 0 : window size horizontal ignore trail noup pixelwise))
1819 0 : ((<= size minimum)
1820 : ;; If NODOWN is nil and WINDOW's size is already at its minimum,
1821 : ;; there's nothing to recover.
1822 : 0)
1823 : (t
1824 : ;; Otherwise, try to recover whatever WINDOW is larger than its
1825 : ;; minimum size.
1826 0 : (window--min-delta-1
1827 0 : window (- size minimum) horizontal ignore trail noup pixelwise)))))
1828 :
1829 : (defun frame-windows-min-size (&optional frame horizontal ignore pixelwise)
1830 : "Return minimum number of lines of FRAME's windows.
1831 : HORIZONTAL non-nil means return number of columns of FRAME's
1832 : windows. The optional argument IGNORE has the same meaning as
1833 : for `window-resizable'. PIXELWISE non-nil means return sizes in
1834 : pixels."
1835 108 : (setq frame (window-normalize-frame frame))
1836 108 : (let* ((root (frame-root-window frame))
1837 108 : (mini (window-next-sibling root)))
1838 108 : (+ (window-min-size root horizontal ignore pixelwise)
1839 108 : (if (and mini (not horizontal))
1840 54 : (window-min-size mini horizontal nil pixelwise)
1841 108 : 0))))
1842 :
1843 : (defun window--max-delta-1 (window delta &optional horizontal ignore trail noup pixelwise)
1844 : "Internal function of `window-max-delta'."
1845 0 : (if (not (window-parent window))
1846 : ;; Can't go up. Return DELTA.
1847 0 : delta
1848 0 : (let* ((parent (window-parent window))
1849 0 : (sub (window-child parent)))
1850 0 : (catch 'fixed
1851 0 : (if (window-combined-p sub horizontal)
1852 : ;; For an iso-combination calculate how much we can get from
1853 : ;; other child windows.
1854 0 : (let ((skip (eq trail 'after)))
1855 0 : (while sub
1856 0 : (cond
1857 0 : ((eq sub window)
1858 0 : (setq skip (eq trail 'before)))
1859 0 : (skip)
1860 : (t
1861 0 : (setq delta
1862 0 : (+ delta
1863 0 : (max
1864 0 : (- (window-size sub horizontal pixelwise 'floor)
1865 0 : (window-min-size
1866 0 : sub horizontal ignore pixelwise))
1867 0 : 0)))))
1868 0 : (setq sub (window-right sub))))
1869 : ;; For an ortho-combination throw DELTA when at least one
1870 : ;; child window is fixed-size.
1871 0 : (while sub
1872 0 : (when (and (not (eq sub window))
1873 0 : (window-size-fixed-p sub horizontal ignore))
1874 0 : (throw 'fixed delta))
1875 0 : (setq sub (window-right sub))))
1876 0 : (if noup
1877 : ;; When NOUP is nil, DELTA is all we can get.
1878 0 : delta
1879 : ;; Else try with parent of WINDOW, passing the DELTA we
1880 : ;; recovered so far.
1881 0 : (window--max-delta-1
1882 0 : parent delta horizontal ignore trail nil pixelwise))))))
1883 :
1884 : (defun window-max-delta (&optional window horizontal ignore trail noup nodown pixelwise)
1885 : "Return maximum number of lines by which WINDOW can be enlarged.
1886 : WINDOW must be a valid window and defaults to the selected one.
1887 : The return value is zero if WINDOW cannot be enlarged.
1888 :
1889 : Optional argument HORIZONTAL non-nil means return maximum number
1890 : of columns by which WINDOW can be enlarged.
1891 :
1892 : The optional argument IGNORE has the same meaning as for
1893 : `window-resizable'. Optional argument TRAIL restricts the
1894 : windows that can be enlarged. If its value is `before', only
1895 : windows to the left of or above WINDOW can be enlarged. If it is
1896 : `after', only windows to the right of or below WINDOW can be
1897 : enlarged.
1898 :
1899 : Optional argument NOUP non-nil means don't go up in the window
1900 : tree but try to obtain the entire space from windows within
1901 : WINDOW's combination. Optional argument NODOWN non-nil means do
1902 : not check whether WINDOW itself (and its child windows) can be
1903 : enlarged; check only whether other windows can be shrunk
1904 : appropriately.
1905 :
1906 : Optional argument PIXELWISE non-nil means return number of
1907 : pixels by which WINDOW can be enlarged."
1908 0 : (setq window (window-normalize-window window))
1909 0 : (if (and (not nodown) (window-size-fixed-p window horizontal ignore))
1910 : ;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
1911 : ;; size.
1912 : 0
1913 : ;; WINDOW has no fixed size.
1914 0 : (window--max-delta-1 window 0 horizontal ignore trail noup pixelwise)))
1915 :
1916 : ;; Make NOUP also inhibit the min-size check.
1917 : (defun window--resizable (window delta &optional horizontal ignore trail noup nodown pixelwise)
1918 : "Return DELTA if WINDOW can be resized vertically by DELTA lines.
1919 : WINDOW must be a valid window and defaults to the selected one.
1920 : Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
1921 : can be resized horizontally by DELTA columns. A return value of
1922 : zero means that WINDOW is not resizable.
1923 :
1924 : DELTA positive means WINDOW shall be enlarged by DELTA lines or
1925 : columns. If WINDOW cannot be enlarged by DELTA lines or columns,
1926 : return the maximum value in the range 0..DELTA by which WINDOW
1927 : can be enlarged.
1928 :
1929 : DELTA negative means WINDOW shall be shrunk by -DELTA lines or
1930 : columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
1931 : return the minimum value in the range DELTA..0 that can be used
1932 : for shrinking WINDOW.
1933 :
1934 : The optional argument IGNORE has the same meaning as for
1935 : `window-resizable'. Optional argument TRAIL `before' means only
1936 : windows to the left of or below WINDOW can be shrunk. Optional
1937 : argument TRAIL `after' means only windows to the right of or
1938 : above WINDOW can be shrunk.
1939 :
1940 : Optional argument NOUP non-nil means don't go up in the window
1941 : tree but check only whether space can be obtained from (or given
1942 : to) WINDOW's siblings. Optional argument NODOWN non-nil means
1943 : don't go down in the window tree. This means do not check
1944 : whether resizing would violate size restrictions of WINDOW or its
1945 : child windows.
1946 :
1947 : Optional argument PIXELWISE non-nil means interpret DELTA as
1948 : number of pixels."
1949 0 : (setq window (window-normalize-window window))
1950 0 : (cond
1951 0 : ((< delta 0)
1952 0 : (max (- (window-min-delta
1953 0 : window horizontal ignore trail noup nodown pixelwise))
1954 0 : delta))
1955 0 : ((> delta 0)
1956 0 : (min (window-max-delta
1957 0 : window horizontal ignore trail noup nodown pixelwise)
1958 0 : delta))
1959 0 : (t 0)))
1960 :
1961 : (defun window--resizable-p (window delta &optional horizontal ignore trail noup nodown pixelwise)
1962 : "Return t if WINDOW can be resized vertically by DELTA lines.
1963 : WINDOW must be a valid window and defaults to the selected one.
1964 : For the meaning of the arguments of this function see the
1965 : doc-string of `window--resizable'.
1966 :
1967 : Optional argument PIXELWISE non-nil means interpret DELTA as
1968 : pixels."
1969 0 : (setq window (window-normalize-window window))
1970 0 : (if (> delta 0)
1971 0 : (>= (window--resizable
1972 0 : window delta horizontal ignore trail noup nodown pixelwise)
1973 0 : delta)
1974 0 : (<= (window--resizable
1975 0 : window delta horizontal ignore trail noup nodown pixelwise)
1976 0 : delta)))
1977 :
1978 : (defun window-resizable (window delta &optional horizontal ignore pixelwise)
1979 : "Return DELTA if WINDOW can be resized vertically by DELTA lines.
1980 : WINDOW must be a valid window and defaults to the selected one.
1981 : Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
1982 : can be resized horizontally by DELTA columns. A return value of
1983 : zero means that WINDOW is not resizable.
1984 :
1985 : DELTA positive means WINDOW shall be enlarged by DELTA lines or
1986 : columns. If WINDOW cannot be enlarged by DELTA lines or columns
1987 : return the maximum value in the range 0..DELTA by which WINDOW
1988 : can be enlarged.
1989 :
1990 : DELTA negative means WINDOW shall be shrunk by -DELTA lines or
1991 : columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
1992 : return the minimum value in the range DELTA..0 that can be used
1993 : for shrinking WINDOW.
1994 :
1995 : Optional argument IGNORE, if non-nil, means to ignore restraints
1996 : induced by fixed size windows or the values of the variables
1997 : `window-min-height' and `window-min-width'. The following values
1998 : have special meanings: `safe' means that in addition live windows
1999 : are allowed to get as small as `window-safe-min-height' lines and
2000 : `window-safe-min-width' columns. `preserved' means to ignore
2001 : only restrictions induced by `window-preserve-size'. If IGNORE
2002 : is a window, then ignore restrictions for that window only.
2003 :
2004 : Optional argument PIXELWISE non-nil means interpret DELTA as
2005 : pixels."
2006 0 : (setq window (window-normalize-window window))
2007 0 : (window--resizable window delta horizontal ignore nil nil nil pixelwise))
2008 :
2009 : (defun window-resizable-p (window delta &optional horizontal ignore pixelwise)
2010 : "Return t if WINDOW can be resized vertically by DELTA lines.
2011 : WINDOW must be a valid window and defaults to the selected one.
2012 : For the meaning of the arguments of this function see the
2013 : doc-string of `window-resizable'."
2014 0 : (setq window (window-normalize-window window))
2015 0 : (if (> delta 0)
2016 0 : (>= (window--resizable
2017 0 : window delta horizontal ignore nil nil nil pixelwise)
2018 0 : delta)
2019 0 : (<= (window--resizable
2020 0 : window delta horizontal ignore nil nil nil pixelwise)
2021 0 : delta)))
2022 :
2023 : ;; Aliases of functions defined in window.c.
2024 : (defalias 'window-height 'window-total-height)
2025 : (defalias 'window-width 'window-body-width)
2026 :
2027 : (defun window-full-height-p (&optional window)
2028 : "Return t if WINDOW is as high as its containing frame.
2029 : More precisely, return t if and only if the total height of
2030 : WINDOW equals the total height of the root window of WINDOW's
2031 : frame. WINDOW must be a valid window and defaults to the
2032 : selected one."
2033 0 : (setq window (window-normalize-window window))
2034 0 : (if (window-minibuffer-p window)
2035 0 : (eq window (frame-root-window (window-frame window)))
2036 0 : (= (window-pixel-height window)
2037 0 : (window-pixel-height (frame-root-window window)))))
2038 :
2039 : (defun window-full-width-p (&optional window)
2040 : "Return t if WINDOW is as wide as its containing frame.
2041 : More precisely, return t if and only if the total width of WINDOW
2042 : equals the total width of the root window of WINDOW's frame.
2043 : WINDOW must be a valid window and defaults to the selected one."
2044 16 : (setq window (window-normalize-window window))
2045 16 : (= (window-pixel-width window)
2046 16 : (window-pixel-width (frame-root-window window))))
2047 :
2048 : (defun window-body-size (&optional window horizontal pixelwise)
2049 : "Return the height or width of WINDOW's text area.
2050 : WINDOW must be a live window and defaults to the selected one.
2051 :
2052 : If HORIZONTAL is omitted or nil, return the height of the text
2053 : area, like `window-body-height'. Otherwise, return the width of
2054 : the text area, like `window-body-width'. In either case, the
2055 : optional argument PIXELWISE is passed to the functions."
2056 0 : (if horizontal
2057 0 : (window-body-width window pixelwise)
2058 0 : (window-body-height window pixelwise)))
2059 :
2060 : (declare-function font-info "font.c" (name &optional frame))
2061 :
2062 : (defun window-font-width (&optional window face)
2063 : "Return average character width for the font of FACE used in WINDOW.
2064 : WINDOW must be a live window and defaults to the selected one.
2065 :
2066 : If FACE is nil or omitted, the default face is used. If FACE is
2067 : remapped (see `face-remapping-alist'), the function returns the
2068 : information for the remapped face."
2069 0 : (with-selected-window (window-normalize-window window t)
2070 0 : (if (display-multi-font-p)
2071 0 : (let* ((face (if face face 'default))
2072 0 : (info (font-info (face-font face)))
2073 0 : (width (aref info 11)))
2074 0 : (if (> width 0)
2075 0 : width
2076 0 : (aref info 10)))
2077 0 : (frame-char-width))))
2078 :
2079 : (defun window-font-height (&optional window face)
2080 : "Return character height for the font of FACE used in WINDOW.
2081 : WINDOW must be a live window and defaults to the selected one.
2082 :
2083 : If FACE is nil or omitted, the default face is used. If FACE is
2084 : remapped (see `face-remapping-alist'), the function returns the
2085 : information for the remapped face."
2086 0 : (with-selected-window (window-normalize-window window t)
2087 0 : (if (display-multi-font-p)
2088 0 : (let* ((face (if face face 'default))
2089 0 : (info (font-info (face-font face))))
2090 0 : (aref info 3))
2091 0 : (frame-char-height))))
2092 :
2093 : (defvar overflow-newline-into-fringe)
2094 :
2095 : (defun window-max-chars-per-line (&optional window face)
2096 : "Return the number of characters that can be displayed on one line in WINDOW.
2097 : WINDOW must be a live window and defaults to the selected one.
2098 :
2099 : The character width of FACE is used for the calculation. If FACE
2100 : is nil or omitted, the default face is used. If FACE is
2101 : remapped (see `face-remapping-alist'), the function uses the
2102 : remapped face.
2103 :
2104 : This function is different from `window-body-width' in two
2105 : ways. First, it accounts for the portions of the line reserved
2106 : for the continuation glyph. Second, it accounts for the size of
2107 : the font."
2108 0 : (with-selected-window (window-normalize-window window t)
2109 0 : (let* ((window-width (window-body-width window t))
2110 0 : (font-width (window-font-width window face))
2111 0 : (ncols (/ window-width font-width)))
2112 0 : (if (and (display-graphic-p)
2113 0 : overflow-newline-into-fringe
2114 0 : (not
2115 0 : (or (eq left-fringe-width 0)
2116 0 : (and (null left-fringe-width)
2117 0 : (= (frame-parameter nil 'left-fringe) 0))))
2118 0 : (not
2119 0 : (or (eq right-fringe-width 0)
2120 0 : (and (null right-fringe-width)
2121 0 : (= (frame-parameter nil 'right-fringe) 0)))))
2122 0 : ncols
2123 : ;; FIXME: This should remove 1 more column when there are no
2124 : ;; fringes, lines are truncated, and the window is hscrolled,
2125 : ;; but EOL is not in the view, because then there are 2
2126 : ;; truncation glyphs, not one.
2127 0 : (1- ncols)))))
2128 :
2129 : (defun window-current-scroll-bars (&optional window)
2130 : "Return the current scroll bar types for WINDOW.
2131 : WINDOW must be a live window and defaults to the selected one.
2132 :
2133 : The return value is a cons cell (VERTICAL . HORIZONTAL) where
2134 : VERTICAL specifies the current location of the vertical scroll
2135 : bar (`left', `right' or nil), and HORIZONTAL specifies the
2136 : current location of the horizontal scroll bar (`bottom' or nil).
2137 :
2138 : Unlike `window-scroll-bars', this function reports the scroll bar
2139 : type actually used, once frame defaults and `scroll-bar-mode' are
2140 : taken into account."
2141 0 : (setq window (window-normalize-window window t))
2142 0 : (let ((vertical (nth 2 (window-scroll-bars window)))
2143 0 : (horizontal (nth 5 (window-scroll-bars window)))
2144 0 : (inherited (frame-current-scroll-bars (window-frame window))))
2145 0 : (when (eq vertical t)
2146 0 : (setq vertical (car inherited)))
2147 0 : (when (eq horizontal t)
2148 0 : (setq horizontal (cdr inherited)))
2149 0 : (cons vertical (and horizontal 'bottom))))
2150 :
2151 : (defun walk-windows (fun &optional minibuf all-frames)
2152 : "Cycle through all live windows, calling FUN for each one.
2153 : FUN must specify a function with a window as its sole argument.
2154 : The optional arguments MINIBUF and ALL-FRAMES specify the set of
2155 : windows to include in the walk.
2156 :
2157 : MINIBUF t means include the minibuffer window even if the
2158 : minibuffer is not active. MINIBUF nil or omitted means include
2159 : the minibuffer window only if the minibuffer is active. Any
2160 : other value means do not include the minibuffer window even if
2161 : the minibuffer is active.
2162 :
2163 : ALL-FRAMES nil or omitted means consider all windows on the
2164 : selected frame, plus the minibuffer window if specified by the
2165 : MINIBUF argument. If the minibuffer counts, consider all windows
2166 : on all frames that share that minibuffer too. The following
2167 : non-nil values of ALL-FRAMES have special meanings:
2168 :
2169 : - t means consider all windows on all existing frames.
2170 :
2171 : - `visible' means consider all windows on all visible frames on
2172 : the current terminal.
2173 :
2174 : - 0 (the number zero) means consider all windows on all visible
2175 : and iconified frames on the current terminal.
2176 :
2177 : - A frame means consider all windows on that frame only.
2178 :
2179 : Anything else means consider all windows on the selected frame
2180 : and no others.
2181 :
2182 : This function changes neither the order of recently selected
2183 : windows nor the buffer list."
2184 : ;; If we start from the minibuffer window, don't fail to come
2185 : ;; back to it.
2186 33 : (when (window-minibuffer-p)
2187 33 : (setq minibuf t))
2188 : ;; Make sure to not mess up the order of recently selected
2189 : ;; windows. Use `save-selected-window' and `select-window'
2190 : ;; with second argument non-nil for this purpose.
2191 33 : (save-selected-window
2192 33 : (when (framep all-frames)
2193 33 : (select-window (frame-first-window all-frames) 'norecord))
2194 33 : (dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
2195 55 : (funcall fun walk-windows-window))))
2196 :
2197 : (defun window-at-side-p (&optional window side)
2198 : "Return t if WINDOW is at SIDE of its containing frame.
2199 : WINDOW must be a valid window and defaults to the selected one.
2200 : SIDE can be any of the symbols `left', `top', `right' or
2201 : `bottom'. The default value nil is handled like `bottom'."
2202 0 : (setq window (window-normalize-window window))
2203 0 : (let ((edge
2204 0 : (cond
2205 0 : ((eq side 'left) 0)
2206 0 : ((eq side 'top) 1)
2207 0 : ((eq side 'right) 2)
2208 0 : ((memq side '(bottom nil)) 3))))
2209 0 : (= (nth edge (window-pixel-edges window))
2210 0 : (nth edge (window-pixel-edges (frame-root-window window))))))
2211 :
2212 : (defun window-at-side-list (&optional frame side)
2213 : "Return list of all windows on SIDE of FRAME.
2214 : FRAME must be a live frame and defaults to the selected frame.
2215 : SIDE can be any of the symbols `left', `top', `right' or
2216 : `bottom'. The default value nil is handled like `bottom'."
2217 0 : (setq frame (window-normalize-frame frame))
2218 0 : (let (windows)
2219 0 : (walk-window-tree
2220 : (lambda (window)
2221 0 : (when (window-at-side-p window side)
2222 0 : (setq windows (cons window windows))))
2223 0 : frame nil 'nomini)
2224 0 : (nreverse windows)))
2225 :
2226 : (defun window--in-direction-2 (window posn &optional horizontal)
2227 : "Support function for `window-in-direction'."
2228 0 : (if horizontal
2229 0 : (let ((top (window-pixel-top window)))
2230 0 : (if (> top posn)
2231 0 : (- top posn)
2232 0 : (- posn top (window-pixel-height window))))
2233 0 : (let ((left (window-pixel-left window)))
2234 0 : (if (> left posn)
2235 0 : (- left posn)
2236 0 : (- posn left (window-pixel-width window))))))
2237 :
2238 : ;; Predecessors to the below have been devised by Julian Assange in
2239 : ;; change-windows-intuitively.el and Hovav Shacham in windmove.el.
2240 : ;; Neither of these allow one to selectively ignore specific windows
2241 : ;; (windows whose `no-other-window' parameter is non-nil) as targets of
2242 : ;; the movement.
2243 : (defun window-in-direction (direction &optional window ignore sign wrap mini)
2244 : "Return window in DIRECTION as seen from WINDOW.
2245 : More precisely, return the nearest window in direction DIRECTION
2246 : as seen from the position of `window-point' in window WINDOW.
2247 : DIRECTION must be one of `above', `below', `left' or `right'.
2248 : WINDOW must be a live window and defaults to the selected one.
2249 :
2250 : Do not return a window whose `no-other-window' parameter is
2251 : non-nil. If the nearest window's `no-other-window' parameter is
2252 : non-nil, try to find another window in the indicated direction.
2253 : If, however, the optional argument IGNORE is non-nil, return that
2254 : window even if its `no-other-window' parameter is non-nil.
2255 :
2256 : Optional argument SIGN a negative number means to use the right
2257 : or bottom edge of WINDOW as reference position instead of
2258 : `window-point'. SIGN a positive number means to use the left or
2259 : top edge of WINDOW as reference position.
2260 :
2261 : Optional argument WRAP non-nil means to wrap DIRECTION around
2262 : frame borders. This means to return for WINDOW at the top of the
2263 : frame and DIRECTION `above' the minibuffer window if the frame
2264 : has one, and a window at the bottom of the frame otherwise.
2265 :
2266 : Optional argument MINI nil means to return the minibuffer window
2267 : if and only if it is currently active. MINI non-nil means to
2268 : return the minibuffer window even when it's not active. However,
2269 : if WRAP is non-nil, always act as if MINI were nil.
2270 :
2271 : Return nil if no suitable window can be found."
2272 0 : (setq window (window-normalize-window window t))
2273 0 : (unless (memq direction '(above below left right))
2274 0 : (error "Wrong direction %s" direction))
2275 0 : (let* ((frame (window-frame window))
2276 0 : (hor (memq direction '(left right)))
2277 0 : (first (if hor
2278 0 : (window-pixel-left window)
2279 0 : (window-pixel-top window)))
2280 0 : (last (+ first (window-size window hor t)))
2281 : ;; The column / row value of `posn-at-point' can be nil for the
2282 : ;; mini-window, guard against that.
2283 : (posn
2284 0 : (cond
2285 0 : ((and (numberp sign) (< sign 0))
2286 0 : (if hor
2287 0 : (1- (+ (window-pixel-top window) (window-pixel-height window)))
2288 0 : (1- (+ (window-pixel-left window) (window-pixel-width window)))))
2289 0 : ((and (numberp sign) (> sign 0))
2290 0 : (if hor
2291 0 : (window-pixel-top window)
2292 0 : (window-pixel-left window)))
2293 0 : ((let ((posn-cons (nth 2 (posn-at-point (window-point window) window))))
2294 0 : (if hor
2295 0 : (+ (or (cdr posn-cons) 1) (window-pixel-top window))
2296 0 : (+ (or (car posn-cons) 1) (window-pixel-left window)))))))
2297 : (best-edge
2298 0 : (cond
2299 0 : ((eq direction 'below) (frame-pixel-height frame))
2300 0 : ((eq direction 'right) (frame-pixel-width frame))
2301 0 : (t -1)))
2302 0 : (best-edge-2 best-edge)
2303 0 : (best-diff-2 (if hor (frame-pixel-height frame) (frame-pixel-width frame)))
2304 : best best-2 best-diff-2-new)
2305 0 : (walk-window-tree
2306 : (lambda (w)
2307 0 : (let* ((w-top (window-pixel-top w))
2308 0 : (w-left (window-pixel-left w)))
2309 0 : (cond
2310 0 : ((or (eq window w)
2311 : ;; Ignore ourselves.
2312 0 : (and (window-parameter w 'no-other-window)
2313 : ;; Ignore W unless IGNORE is non-nil.
2314 0 : (not ignore))))
2315 0 : (hor
2316 0 : (cond
2317 0 : ((and (<= w-top posn)
2318 0 : (< posn (+ w-top (window-pixel-height w))))
2319 : ;; W is to the left or right of WINDOW and covers POSN.
2320 0 : (when (or (and (eq direction 'left)
2321 0 : (or (and (<= w-left first) (> w-left best-edge))
2322 0 : (and wrap
2323 0 : (window-at-side-p window 'left)
2324 0 : (window-at-side-p w 'right))))
2325 0 : (and (eq direction 'right)
2326 0 : (or (and (>= w-left last) (< w-left best-edge))
2327 0 : (and wrap
2328 0 : (window-at-side-p window 'right)
2329 0 : (window-at-side-p w 'left)))))
2330 0 : (setq best-edge w-left)
2331 0 : (setq best w)))
2332 0 : ((and (or (and (eq direction 'left)
2333 0 : (<= (+ w-left (window-pixel-width w)) first))
2334 0 : (and (eq direction 'right) (<= last w-left)))
2335 : ;; W is to the left or right of WINDOW but does not
2336 : ;; cover POSN.
2337 0 : (setq best-diff-2-new
2338 0 : (window--in-direction-2 w posn hor))
2339 0 : (or (< best-diff-2-new best-diff-2)
2340 0 : (and (= best-diff-2-new best-diff-2)
2341 0 : (if (eq direction 'left)
2342 0 : (> w-left best-edge-2)
2343 0 : (< w-left best-edge-2)))))
2344 0 : (setq best-edge-2 w-left)
2345 0 : (setq best-diff-2 best-diff-2-new)
2346 0 : (setq best-2 w))))
2347 0 : ((and (<= w-left posn)
2348 0 : (< posn (+ w-left (window-pixel-width w))))
2349 : ;; W is above or below WINDOW and covers POSN.
2350 0 : (when (or (and (eq direction 'above)
2351 0 : (or (and (<= w-top first) (> w-top best-edge))
2352 0 : (and wrap
2353 0 : (window-at-side-p window 'top)
2354 0 : (if (active-minibuffer-window)
2355 0 : (minibuffer-window-active-p w)
2356 0 : (window-at-side-p w 'bottom)))))
2357 0 : (and (eq direction 'below)
2358 0 : (or (and (>= w-top first) (< w-top best-edge))
2359 0 : (and wrap
2360 0 : (if (active-minibuffer-window)
2361 0 : (minibuffer-window-active-p window)
2362 0 : (window-at-side-p window 'bottom))
2363 0 : (window-at-side-p w 'top)))))
2364 0 : (setq best-edge w-top)
2365 0 : (setq best w)))
2366 0 : ((and (or (and (eq direction 'above)
2367 0 : (<= (+ w-top (window-pixel-height w)) first))
2368 0 : (and (eq direction 'below) (<= last w-top)))
2369 : ;; W is above or below WINDOW but does not cover POSN.
2370 0 : (setq best-diff-2-new
2371 0 : (window--in-direction-2 w posn hor))
2372 0 : (or (< best-diff-2-new best-diff-2)
2373 0 : (and (= best-diff-2-new best-diff-2)
2374 0 : (if (eq direction 'above)
2375 0 : (> w-top best-edge-2)
2376 0 : (< w-top best-edge-2)))))
2377 0 : (setq best-edge-2 w-top)
2378 0 : (setq best-diff-2 best-diff-2-new)
2379 0 : (setq best-2 w)))))
2380 0 : frame nil (and mini t))
2381 0 : (or best best-2)))
2382 :
2383 : (defun get-window-with-predicate (predicate &optional minibuf all-frames default)
2384 : "Return a live window satisfying PREDICATE.
2385 : More precisely, cycle through all windows calling the function
2386 : PREDICATE on each one of them with the window as its sole
2387 : argument. Return the first window for which PREDICATE returns
2388 : non-nil. Windows are scanned starting with the window following
2389 : the selected window. If no window satisfies PREDICATE, return
2390 : DEFAULT.
2391 :
2392 : MINIBUF t means include the minibuffer window even if the
2393 : minibuffer is not active. MINIBUF nil or omitted means include
2394 : the minibuffer window only if the minibuffer is active. Any
2395 : other value means do not include the minibuffer window even if
2396 : the minibuffer is active.
2397 :
2398 : ALL-FRAMES nil or omitted means consider all windows on the selected
2399 : frame, plus the minibuffer window if specified by the MINIBUF
2400 : argument. If the minibuffer counts, consider all windows on all
2401 : frames that share that minibuffer too. The following non-nil
2402 : values of ALL-FRAMES have special meanings:
2403 :
2404 : - t means consider all windows on all existing frames.
2405 :
2406 : - `visible' means consider all windows on all visible frames on
2407 : the current terminal.
2408 :
2409 : - 0 (the number zero) means consider all windows on all visible
2410 : and iconified frames on the current terminal.
2411 :
2412 : - A frame means consider all windows on that frame only.
2413 :
2414 : Anything else means consider all windows on the selected frame
2415 : and no others."
2416 0 : (catch 'found
2417 0 : (dolist (window (window-list-1
2418 0 : (next-window nil minibuf all-frames)
2419 0 : minibuf all-frames))
2420 0 : (when (funcall predicate window)
2421 0 : (throw 'found window)))
2422 0 : default))
2423 :
2424 : (defalias 'some-window 'get-window-with-predicate)
2425 :
2426 : (defun get-lru-window (&optional all-frames dedicated not-selected)
2427 : "Return the least recently used window on frames specified by ALL-FRAMES.
2428 : Return a full-width window if possible. A minibuffer window is
2429 : never a candidate. A dedicated window is never a candidate
2430 : unless DEDICATED is non-nil, so if all windows are dedicated, the
2431 : value is nil. Avoid returning the selected window if possible.
2432 : Optional argument NOT-SELECTED non-nil means never return the
2433 : selected window.
2434 :
2435 : The following non-nil values of the optional argument ALL-FRAMES
2436 : have special meanings:
2437 :
2438 : - t means consider all windows on all existing frames.
2439 :
2440 : - `visible' means consider all windows on all visible frames on
2441 : the current terminal.
2442 :
2443 : - 0 (the number zero) means consider all windows on all visible
2444 : and iconified frames on the current terminal.
2445 :
2446 : - A frame means consider all windows on that frame only.
2447 :
2448 : Any other value of ALL-FRAMES means consider all windows on the
2449 : selected frame and no others."
2450 16 : (let (best-window best-time second-best-window second-best-time time)
2451 16 : (dolist (window (window-list-1 nil 'nomini all-frames))
2452 32 : (when (and (or dedicated (not (window-dedicated-p window)))
2453 32 : (or (not not-selected) (not (eq window (selected-window)))))
2454 32 : (setq time (window-use-time window))
2455 32 : (if (or (eq window (selected-window))
2456 32 : (not (window-full-width-p window)))
2457 16 : (when (or (not second-best-time) (< time second-best-time))
2458 16 : (setq second-best-time time)
2459 16 : (setq second-best-window window))
2460 16 : (when (or (not best-time) (< time best-time))
2461 16 : (setq best-time time)
2462 32 : (setq best-window window)))))
2463 16 : (or best-window second-best-window)))
2464 :
2465 : (defun get-mru-window (&optional all-frames dedicated not-selected)
2466 : "Return the most recently used window on frames specified by ALL-FRAMES.
2467 : A minibuffer window is never a candidate. A dedicated window is
2468 : never a candidate unless DEDICATED is non-nil, so if all windows
2469 : are dedicated, the value is nil. Optional argument NOT-SELECTED
2470 : non-nil means never return the selected window.
2471 :
2472 : The following non-nil values of the optional argument ALL-FRAMES
2473 : have special meanings:
2474 :
2475 : - t means consider all windows on all existing frames.
2476 :
2477 : - `visible' means consider all windows on all visible frames on
2478 : the current terminal.
2479 :
2480 : - 0 (the number zero) means consider all windows on all visible
2481 : and iconified frames on the current terminal.
2482 :
2483 : - A frame means consider all windows on that frame only.
2484 :
2485 : Any other value of ALL-FRAMES means consider all windows on the
2486 : selected frame and no others."
2487 0 : (let (best-window best-time time)
2488 0 : (dolist (window (window-list-1 nil 'nomini all-frames))
2489 0 : (setq time (window-use-time window))
2490 0 : (when (and (or dedicated (not (window-dedicated-p window)))
2491 0 : (or (not not-selected) (not (eq window (selected-window))))
2492 0 : (or (not best-time) (> time best-time)))
2493 0 : (setq best-time time)
2494 0 : (setq best-window window)))
2495 0 : best-window))
2496 :
2497 : (defun get-largest-window (&optional all-frames dedicated not-selected)
2498 : "Return the largest window on frames specified by ALL-FRAMES.
2499 : A minibuffer window is never a candidate. A dedicated window is
2500 : never a candidate unless DEDICATED is non-nil, so if all windows
2501 : are dedicated, the value is nil. Optional argument NOT-SELECTED
2502 : non-nil means never return the selected window.
2503 :
2504 : The following non-nil values of the optional argument ALL-FRAMES
2505 : have special meanings:
2506 :
2507 : - t means consider all windows on all existing frames.
2508 :
2509 : - `visible' means consider all windows on all visible frames on
2510 : the current terminal.
2511 :
2512 : - 0 (the number zero) means consider all windows on all visible
2513 : and iconified frames on the current terminal.
2514 :
2515 : - A frame means consider all windows on that frame only.
2516 :
2517 : Any other value of ALL-FRAMES means consider all windows on the
2518 : selected frame and no others."
2519 11 : (let ((best-size 0)
2520 : best-window size)
2521 11 : (dolist (window (window-list-1 nil 'nomini all-frames))
2522 19 : (when (and (or dedicated (not (window-dedicated-p window)))
2523 19 : (or (not not-selected) (not (eq window (selected-window)))))
2524 19 : (setq size (* (window-pixel-height window)
2525 19 : (window-pixel-width window)))
2526 19 : (when (> size best-size)
2527 11 : (setq best-size size)
2528 19 : (setq best-window window))))
2529 11 : best-window))
2530 :
2531 : (defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
2532 : "Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
2533 : BUFFER-OR-NAME may be a buffer or the name of an existing buffer
2534 : and defaults to the current buffer. If the selected window displays
2535 : BUFFER-OR-NAME, it will be the first in the resulting list.
2536 :
2537 : MINIBUF t means include the minibuffer window even if the
2538 : minibuffer is not active. MINIBUF nil or omitted means include
2539 : the minibuffer window only if the minibuffer is active. Any
2540 : other value means do not include the minibuffer window even if
2541 : the minibuffer is active.
2542 :
2543 : ALL-FRAMES nil or omitted means consider all windows on the
2544 : selected frame, plus the minibuffer window if specified by the
2545 : MINIBUF argument. If the minibuffer counts, consider all windows
2546 : on all frames that share that minibuffer too. The following
2547 : non-nil values of ALL-FRAMES have special meanings:
2548 :
2549 : - t means consider all windows on all existing frames.
2550 :
2551 : - `visible' means consider all windows on all visible frames on
2552 : the current terminal.
2553 :
2554 : - 0 (the number zero) means consider all windows on all visible
2555 : and iconified frames on the current terminal.
2556 :
2557 : - A frame means consider all windows on that frame only.
2558 :
2559 : Anything else means consider all windows on the selected frame
2560 : and no others."
2561 39 : (let ((buffer (window-normalize-buffer buffer-or-name))
2562 : windows)
2563 39 : (dolist (window (window-list-1 (selected-window) minibuf all-frames))
2564 73 : (when (eq (window-buffer window) buffer)
2565 73 : (setq windows (cons window windows))))
2566 39 : (nreverse windows)))
2567 :
2568 : (defun minibuffer-window-active-p (window)
2569 : "Return t if WINDOW is the currently active minibuffer window."
2570 117 : (eq window (active-minibuffer-window)))
2571 :
2572 : (defun count-windows (&optional minibuf)
2573 : "Return the number of live windows on the selected frame.
2574 : The optional argument MINIBUF specifies whether the minibuffer
2575 : window shall be counted. See `walk-windows' for the precise
2576 : meaning of this argument."
2577 0 : (length (window-list-1 nil minibuf)))
2578 :
2579 : ;;; Resizing windows.
2580 : (defun window--size-to-pixel (window size &optional horizontal pixelwise round-maybe)
2581 : "For WINDOW convert SIZE lines to pixels.
2582 : SIZE is supposed to specify a height of WINDOW in terms of text
2583 : lines. The return value is the number of pixels specifying that
2584 : height.
2585 :
2586 : WINDOW must be a valid window. Optional argument HORIZONTAL
2587 : non-nil means convert SIZE columns to pixels.
2588 :
2589 : Optional argument PIXELWISE non-nil means SIZE already specifies
2590 : pixels but may have to be adjusted to a multiple of the character
2591 : size of WINDOW's frame. Optional argument ROUND-MAYBE non-nil
2592 : means round to the nearest multiple of the character size of
2593 : WINDOW's frame if the option `window-resize-pixelwise' is nil."
2594 0 : (setq window (window-normalize-window window))
2595 0 : (let ((char-size (frame-char-size window horizontal)))
2596 0 : (if pixelwise
2597 0 : (if (and round-maybe (not window-resize-pixelwise))
2598 0 : (* (round size char-size) char-size)
2599 0 : size)
2600 0 : (* size char-size))))
2601 :
2602 : (defun window--pixel-to-total-1 (window horizontal char-size)
2603 : "Subroutine of `window--pixel-to-total'."
2604 9 : (let ((child (window-child window)))
2605 9 : (if (window-combination-p window horizontal)
2606 : ;; In an iso-combination distribute sizes proportionally.
2607 3 : (let ((remainder (window-new-total window))
2608 : size best-child rem best-rem)
2609 : ;; Initialize total sizes to each child's floor.
2610 9 : (while child
2611 6 : (setq size (max (/ (window-size child horizontal t) char-size) 1))
2612 6 : (set-window-new-total child size)
2613 6 : (setq remainder (- remainder size))
2614 6 : (setq child (window-next-sibling child)))
2615 : ;; Distribute remainder.
2616 3 : (while (> remainder 0)
2617 0 : (setq child (window-last-child window))
2618 0 : (setq best-child nil)
2619 0 : (setq best-rem 0)
2620 0 : (while child
2621 0 : (when (and (<= (window-new-total child)
2622 0 : (/ (window-size child horizontal t) char-size))
2623 0 : (> (setq rem (% (window-size child horizontal t)
2624 0 : char-size))
2625 0 : best-rem))
2626 0 : (setq best-child child)
2627 0 : (setq best-rem rem))
2628 0 : (setq child (window-prev-sibling child)))
2629 : ;; We MUST have a best-child here.
2630 0 : (set-window-new-total best-child 1 t)
2631 3 : (setq remainder (1- remainder)))
2632 : ;; Recurse.
2633 3 : (setq child (window-child window))
2634 9 : (while child
2635 6 : (window--pixel-to-total-1 child horizontal char-size)
2636 6 : (setq child (window-next-sibling child))))
2637 : ;; In an ortho-combination assign new sizes directly.
2638 6 : (let ((size (window-new-total window)))
2639 6 : (while child
2640 0 : (set-window-new-total child size)
2641 0 : (window--pixel-to-total-1 child horizontal char-size)
2642 9 : (setq child (window-next-sibling child)))))))
2643 :
2644 : (defun window--pixel-to-total (&optional frame horizontal)
2645 : "On FRAME assign new total window heights from pixel heights.
2646 : FRAME must be a live frame and defaults to the selected frame.
2647 :
2648 : Optional argument HORIZONTAL non-nil means assign new total
2649 : window widths from pixel widths."
2650 3 : (setq frame (window-normalize-frame frame))
2651 3 : (let* ((char-size (frame-char-size frame horizontal))
2652 3 : (root (frame-root-window frame))
2653 3 : (root-size (window-size root horizontal t))
2654 : ;; We have to care about the minibuffer window only if it
2655 : ;; appears together with the root window on this frame.
2656 3 : (mini (let ((mini (minibuffer-window frame)))
2657 3 : (and (eq (window-frame mini) frame)
2658 3 : (not (eq mini root)) mini)))
2659 3 : (mini-size (and mini (window-size mini horizontal t))))
2660 : ;; We round the line/column sizes of windows here to the nearest
2661 : ;; integer. In some cases this can make windows appear _larger_
2662 : ;; than the containing frame (line/column-wise) because the latter's
2663 : ;; sizes are not (yet) rounded. We might eventually fix that.
2664 3 : (if (and mini (not horizontal))
2665 3 : (let (lines)
2666 3 : (set-window-new-total root (max (/ root-size char-size) 1))
2667 3 : (set-window-new-total mini (max (/ mini-size char-size) 1))
2668 3 : (setq lines (- (round (+ root-size mini-size) char-size)
2669 3 : (+ (window-new-total root) (window-new-total mini))))
2670 3 : (while (> lines 0)
2671 0 : (if (>= (% root-size (window-new-total root))
2672 0 : (% mini-size (window-new-total mini)))
2673 0 : (set-window-new-total root 1 t)
2674 0 : (set-window-new-total mini 1 t))
2675 3 : (setq lines (1- lines))))
2676 0 : (set-window-new-total root (round root-size char-size))
2677 0 : (when mini
2678 : ;; This is taken in the horizontal case only.
2679 3 : (set-window-new-total mini (round mini-size char-size))))
2680 3 : (unless (window-buffer root)
2681 3 : (window--pixel-to-total-1 root horizontal char-size))
2682 : ;; Apply the new sizes.
2683 3 : (window-resize-apply-total frame horizontal)))
2684 :
2685 : (defun window--resize-reset (&optional frame horizontal)
2686 : "Reset resize values for all windows on FRAME.
2687 : FRAME defaults to the selected frame.
2688 :
2689 : This function stores the current value of `window-size' applied
2690 : with argument HORIZONTAL in the new total size of all windows on
2691 : FRAME. It also resets the new normal size of each of these
2692 : windows."
2693 3 : (window--resize-reset-1
2694 3 : (frame-root-window (window-normalize-frame frame)) horizontal))
2695 :
2696 : (defun window--resize-reset-1 (window horizontal)
2697 : "Internal function of `window--resize-reset'."
2698 : ;; Register old size in the new total size.
2699 3 : (set-window-new-pixel window (window-size window horizontal t))
2700 3 : (set-window-new-total window (window-size window horizontal))
2701 : ;; Reset new normal size.
2702 3 : (set-window-new-normal window)
2703 3 : (when (window-child window)
2704 3 : (window--resize-reset-1 (window-child window) horizontal))
2705 3 : (when (window-right window)
2706 3 : (window--resize-reset-1 (window-right window) horizontal)))
2707 :
2708 : (defun window--resize-mini-window (window delta)
2709 : "Resize minibuffer window WINDOW by DELTA pixels.
2710 : If WINDOW cannot be resized by DELTA pixels make it as large (or
2711 : as small) as possible, but don't signal an error."
2712 0 : (when (window-minibuffer-p window)
2713 0 : (let* ((frame (window-frame window))
2714 0 : (root (frame-root-window frame))
2715 0 : (height (window-pixel-height window))
2716 : (min-delta
2717 0 : (- (window-pixel-height root)
2718 0 : (window-min-size root nil nil t))))
2719 : ;; Sanitize DELTA.
2720 0 : (cond
2721 0 : ((<= (+ height delta) 0)
2722 0 : (setq delta (- (frame-char-height (window-frame window)) height)))
2723 0 : ((> delta min-delta)
2724 0 : (setq delta min-delta)))
2725 :
2726 0 : (unless (zerop delta)
2727 : ;; Resize now.
2728 0 : (window--resize-reset frame)
2729 : ;; Ideally we should be able to resize just the last child of root
2730 : ;; here. See the comment in `resize-root-window-vertically' for
2731 : ;; why we do not do that.
2732 0 : (window--resize-this-window root (- delta) nil nil t)
2733 0 : (set-window-new-pixel window (+ height delta))
2734 : ;; The following routine catches the case where we want to resize
2735 : ;; a minibuffer-only frame.
2736 0 : (when (resize-mini-window-internal window)
2737 0 : (window--pixel-to-total frame)
2738 0 : (run-window-configuration-change-hook frame))))))
2739 :
2740 : (defun window--resize-apply-p (frame &optional horizontal)
2741 : "Return t when a window on FRAME shall be resized vertically.
2742 : Optional argument HORIZONTAL non-nil means return t when a window
2743 : shall be resized horizontally."
2744 0 : (catch 'apply
2745 0 : (walk-window-tree
2746 : (lambda (window)
2747 0 : (unless (= (window-new-pixel window)
2748 0 : (window-size window horizontal t))
2749 0 : (throw 'apply t)))
2750 0 : frame t)
2751 0 : nil))
2752 :
2753 : (defun window-resize (window delta &optional horizontal ignore pixelwise)
2754 : "Resize WINDOW vertically by DELTA lines.
2755 : WINDOW can be an arbitrary window and defaults to the selected
2756 : one. An attempt to resize the root window of a frame will raise
2757 : an error though.
2758 :
2759 : DELTA a positive number means WINDOW shall be enlarged by DELTA
2760 : lines. DELTA negative means WINDOW shall be shrunk by -DELTA
2761 : lines.
2762 :
2763 : Optional argument HORIZONTAL non-nil means resize WINDOW
2764 : horizontally by DELTA columns. In this case a positive DELTA
2765 : means enlarge WINDOW by DELTA columns. DELTA negative means
2766 : WINDOW shall be shrunk by -DELTA columns.
2767 :
2768 : Optional argument IGNORE, if non-nil, means to ignore restraints
2769 : induced by fixed size windows or the values of the variables
2770 : `window-min-height' and `window-min-width'. The following values
2771 : have special meanings: `safe' means that in addition live windows
2772 : are allowed to get as small as `window-safe-min-height' lines and
2773 : `window-safe-min-width' columns. `preserved' means to ignore
2774 : only restrictions induced by `window-preserve-size'. If IGNORE
2775 : is a window, then ignore restrictions for that window only.
2776 :
2777 : Optional argument PIXELWISE non-nil means resize WINDOW by DELTA
2778 : pixels.
2779 :
2780 : This function resizes other windows proportionally and never
2781 : deletes any windows. If you want to move only the low (right)
2782 : edge of WINDOW consider using `adjust-window-trailing-edge'
2783 : instead."
2784 0 : (setq window (window-normalize-window window))
2785 0 : (let* ((frame (window-frame window))
2786 0 : (minibuffer-window (minibuffer-window frame))
2787 : sibling)
2788 0 : (setq delta (window--size-to-pixel
2789 0 : window delta horizontal pixelwise t))
2790 0 : (cond
2791 0 : ((eq window (frame-root-window frame))
2792 0 : (error "Cannot resize the root window of a frame"))
2793 0 : ((window-minibuffer-p window)
2794 0 : (if horizontal
2795 0 : (error "Cannot resize minibuffer window horizontally")
2796 0 : (window--resize-mini-window window delta)))
2797 0 : ((and (not horizontal)
2798 0 : (window-full-height-p window)
2799 0 : (eq (window-frame minibuffer-window) frame)
2800 0 : (or (not resize-mini-windows)
2801 0 : (eq minibuffer-window (active-minibuffer-window))))
2802 : ;; If WINDOW is full height and either `resize-mini-windows' is
2803 : ;; nil or the minibuffer window is active, resize the minibuffer
2804 : ;; window.
2805 0 : (window--resize-mini-window minibuffer-window (- delta)))
2806 0 : ((or (window--resizable-p
2807 0 : window delta horizontal ignore nil nil nil t)
2808 0 : (and (not ignore)
2809 0 : (setq ignore 'preserved)
2810 0 : (window--resizable-p
2811 0 : window delta horizontal ignore nil nil nil t)))
2812 0 : (window--resize-reset frame horizontal)
2813 0 : (window--resize-this-window window delta horizontal ignore t)
2814 0 : (if (and (not (eq window-combination-resize t))
2815 0 : (window-combined-p window horizontal)
2816 0 : (setq sibling (or (window-right window) (window-left window)))
2817 0 : (window-sizable-p
2818 0 : sibling (- delta) horizontal ignore t))
2819 : ;; If window-combination-resize is nil, WINDOW is part of an
2820 : ;; iso-combination, and WINDOW's neighboring right or left
2821 : ;; sibling can be resized as requested, resize that sibling.
2822 0 : (let ((normal-delta
2823 0 : (/ (float delta)
2824 0 : (window-size (window-parent window) horizontal t))))
2825 0 : (window--resize-this-window sibling (- delta) horizontal nil t)
2826 0 : (set-window-new-normal
2827 0 : window (+ (window-normal-size window horizontal)
2828 0 : normal-delta))
2829 0 : (set-window-new-normal
2830 0 : sibling (- (window-normal-size sibling horizontal)
2831 0 : normal-delta)))
2832 : ;; Otherwise, resize all other windows in the same combination.
2833 0 : (window--resize-siblings window delta horizontal ignore))
2834 0 : (when (window--resize-apply-p frame horizontal)
2835 0 : (if (window-resize-apply frame horizontal)
2836 0 : (progn
2837 0 : (window--pixel-to-total frame horizontal)
2838 0 : (run-window-configuration-change-hook frame))
2839 0 : (error "Failed to apply resizing %s" window))))
2840 : (t
2841 0 : (error "Cannot resize window %s" window)))))
2842 :
2843 : (defun window-resize-no-error (window delta &optional horizontal ignore pixelwise)
2844 : "Resize WINDOW vertically if it is resizable by DELTA lines.
2845 : This function is like `window-resize' but does not signal an
2846 : error when WINDOW cannot be resized. For the meaning of the
2847 : optional arguments see the documentation of `window-resize'."
2848 0 : (when (window--resizable-p
2849 0 : window delta horizontal ignore nil nil nil pixelwise)
2850 0 : (window-resize window delta horizontal ignore pixelwise)))
2851 :
2852 : (defun window--resize-child-windows-skip-p (window)
2853 : "Return non-nil if WINDOW shall be skipped by resizing routines."
2854 0 : (memq (window-new-normal window) '(ignore stuck skip)))
2855 :
2856 : (defun window--resize-child-windows-normal (parent horizontal window this-delta &optional trail other-delta)
2857 : "Recursively set new normal height of child windows of window PARENT.
2858 : HORIZONTAL non-nil means set the new normal width of these
2859 : windows. WINDOW specifies a child window of PARENT that has been
2860 : resized by THIS-DELTA lines (columns).
2861 :
2862 : Optional argument TRAIL either `before' or `after' means set values
2863 : only for windows before or after WINDOW. Optional argument
2864 : OTHER-DELTA, a number, specifies that this many lines (columns)
2865 : have been obtained from (or returned to) an ancestor window of
2866 : PARENT in order to resize WINDOW."
2867 0 : (let* ((delta-normal
2868 0 : (if (and (= (- this-delta)
2869 0 : (window-size window horizontal t))
2870 0 : (zerop other-delta))
2871 : ;; When WINDOW gets deleted and we can return its entire
2872 : ;; space to its siblings, use WINDOW's normal size as the
2873 : ;; normal delta.
2874 0 : (- (window-normal-size window horizontal))
2875 : ;; In any other case calculate the normal delta from the
2876 : ;; relation of THIS-DELTA to the total size of PARENT.
2877 0 : (/ (float this-delta)
2878 0 : (window-size parent horizontal t))))
2879 0 : (sub (window-child parent))
2880 : (parent-normal 0.0)
2881 0 : (skip (eq trail 'after)))
2882 :
2883 : ;; Set parent-normal to the sum of the normal sizes of all child
2884 : ;; windows of PARENT that shall be resized, excluding only WINDOW
2885 : ;; and any windows specified by the optional TRAIL argument.
2886 0 : (while sub
2887 0 : (cond
2888 0 : ((eq sub window)
2889 0 : (setq skip (eq trail 'before)))
2890 0 : (skip)
2891 : (t
2892 0 : (setq parent-normal
2893 0 : (+ parent-normal (window-normal-size sub horizontal)))))
2894 0 : (setq sub (window-right sub)))
2895 :
2896 : ;; Set the new normal size of all child windows of PARENT from what
2897 : ;; they should have contributed for recovering THIS-DELTA lines
2898 : ;; (columns).
2899 0 : (setq sub (window-child parent))
2900 0 : (setq skip (eq trail 'after))
2901 0 : (while sub
2902 0 : (cond
2903 0 : ((eq sub window)
2904 0 : (setq skip (eq trail 'before)))
2905 0 : (skip)
2906 : (t
2907 0 : (let ((old-normal (window-normal-size sub horizontal)))
2908 0 : (set-window-new-normal
2909 0 : sub (min 1.0 ; Don't get larger than 1.
2910 0 : (max (- old-normal
2911 0 : (* (/ old-normal parent-normal)
2912 0 : delta-normal))
2913 : ;; Don't drop below 0.
2914 0 : 0.0))))))
2915 0 : (setq sub (window-right sub)))
2916 :
2917 0 : (when (numberp other-delta)
2918 : ;; Set the new normal size of windows from what they should have
2919 : ;; contributed for recovering OTHER-DELTA lines (columns).
2920 0 : (setq delta-normal (/ (float (window-size parent horizontal t))
2921 0 : (+ (window-size parent horizontal t)
2922 0 : other-delta)))
2923 0 : (setq sub (window-child parent))
2924 0 : (setq skip (eq trail 'after))
2925 0 : (while sub
2926 0 : (cond
2927 0 : ((eq sub window)
2928 0 : (setq skip (eq trail 'before)))
2929 0 : (skip)
2930 : (t
2931 0 : (set-window-new-normal
2932 0 : sub (min 1.0 ; Don't get larger than 1.
2933 0 : (max (* (window-new-normal sub) delta-normal)
2934 : ;; Don't drop below 0.
2935 0 : 0.0)))))
2936 0 : (setq sub (window-right sub))))
2937 :
2938 : ;; Set the new normal size of WINDOW to what is left by the sum of
2939 : ;; the normal sizes of its siblings.
2940 0 : (set-window-new-normal
2941 0 : window
2942 0 : (let ((sum 0))
2943 0 : (setq sub (window-child parent))
2944 0 : (while sub
2945 0 : (cond
2946 0 : ((eq sub window))
2947 0 : ((not (numberp (window-new-normal sub)))
2948 0 : (setq sum (+ sum (window-normal-size sub horizontal))))
2949 : (t
2950 0 : (setq sum (+ sum (window-new-normal sub)))))
2951 0 : (setq sub (window-right sub)))
2952 : ;; Don't get larger than 1 or smaller than 0.
2953 0 : (min 1.0 (max (- 1.0 sum) 0.0))))))
2954 :
2955 : (defun window--resize-child-windows (parent delta &optional horizontal window ignore trail edge char-size)
2956 : "Resize child windows of window PARENT vertically by DELTA pixels.
2957 : PARENT must be a vertically combined internal window.
2958 :
2959 : Optional argument HORIZONTAL non-nil means resize child windows
2960 : of PARENT horizontally by DELTA pixels. In this case PARENT must
2961 : be a horizontally combined internal window.
2962 :
2963 : WINDOW, if specified, must denote a child window of PARENT that
2964 : is resized by DELTA pixels.
2965 :
2966 : The optional argument IGNORE has the same meaning as for
2967 : `window-resizable'.
2968 :
2969 : Optional arguments TRAIL and EDGE, when non-nil, restrict the set
2970 : of windows that shall be resized. If TRAIL equals `before',
2971 : resize only windows on the left or above EDGE. If TRAIL equals
2972 : `after', resize only windows on the right or below EDGE. Also,
2973 : preferably only resize windows adjacent to EDGE.
2974 :
2975 : If the optional argument CHAR-SIZE is a positive integer, it specifies
2976 : the number of pixels by which windows are incrementally resized.
2977 : If CHAR-SIZE is nil, this means to use the value of
2978 : `frame-char-height' or `frame-char-width' of WINDOW's frame.
2979 :
2980 : Return the symbol `normalized' if new normal sizes have been
2981 : already set by this routine."
2982 0 : (let* ((first (window-child parent))
2983 0 : (last (window-last-child parent))
2984 0 : (parent-total (+ (window-size parent horizontal t)
2985 0 : delta))
2986 0 : (char-size (or char-size
2987 0 : (and window-resize-pixelwise 1)
2988 0 : (frame-char-size window horizontal)))
2989 : sub best-window best-value best-delta)
2990 :
2991 0 : (if (and edge (memq trail '(before after))
2992 0 : (progn
2993 0 : (setq sub first)
2994 0 : (while (and (window-right sub)
2995 0 : (or (and (eq trail 'before)
2996 0 : (not (window--resize-child-windows-skip-p
2997 0 : (window-right sub))))
2998 0 : (and (eq trail 'after)
2999 0 : (window--resize-child-windows-skip-p sub))))
3000 0 : (setq sub (window-right sub)))
3001 0 : sub)
3002 0 : (if horizontal
3003 0 : (if (eq trail 'before)
3004 0 : (= (+ (window-pixel-left sub) (window-pixel-width sub))
3005 0 : edge)
3006 0 : (= (window-pixel-left sub) edge))
3007 0 : (if (eq trail 'before)
3008 0 : (= (+ (window-pixel-top sub) (window-pixel-height sub))
3009 0 : edge)
3010 0 : (= (window-pixel-top sub) edge)))
3011 0 : (window-sizable-p sub delta horizontal ignore t))
3012 : ;; Resize only windows adjacent to EDGE.
3013 0 : (progn
3014 0 : (window--resize-this-window
3015 0 : sub delta horizontal ignore t trail edge)
3016 0 : (if (and window (eq (window-parent sub) parent))
3017 0 : (progn
3018 : ;; Assign new normal sizes.
3019 0 : (set-window-new-normal
3020 0 : sub (/ (float (window-new-pixel sub)) parent-total))
3021 0 : (set-window-new-normal
3022 0 : window (- (window-normal-size window horizontal)
3023 0 : (- (window-new-normal sub)
3024 0 : (window-normal-size sub horizontal)))))
3025 0 : (window--resize-child-windows-normal
3026 0 : parent horizontal sub 0 trail delta))
3027 : ;; Return 'normalized to notify `window--resize-siblings' that
3028 : ;; normal sizes have been already set.
3029 0 : 'normalized)
3030 : ;; Resize all windows proportionally.
3031 0 : (setq sub last)
3032 0 : (while sub
3033 0 : (cond
3034 0 : ((or (window--resize-child-windows-skip-p sub)
3035 : ;; Ignore windows to skip and fixed-size child windows -
3036 : ;; in the latter case make it a window to skip.
3037 0 : (and (not ignore)
3038 0 : (window-size-fixed-p sub horizontal ignore)
3039 0 : (set-window-new-normal sub 'ignore))))
3040 0 : ((< delta 0)
3041 : ;; When shrinking store the number of lines/cols we can get
3042 : ;; from this window here together with the total/normal size
3043 : ;; factor.
3044 0 : (set-window-new-normal
3045 0 : sub
3046 0 : (cons
3047 : ;; We used to call this with NODOWN t, "fixed" 2011-05-11.
3048 0 : (window-min-delta sub horizontal ignore trail t nil t)
3049 0 : (- (/ (float (window-size sub horizontal t))
3050 0 : parent-total)
3051 0 : (window-normal-size sub horizontal)))))
3052 0 : ((> delta 0)
3053 : ;; When enlarging store the total/normal size factor only
3054 0 : (set-window-new-normal
3055 0 : sub
3056 0 : (- (/ (float (window-size sub horizontal t))
3057 0 : parent-total)
3058 0 : (window-normal-size sub horizontal)))))
3059 :
3060 0 : (setq sub (window-left sub)))
3061 :
3062 0 : (cond
3063 0 : ((< delta 0)
3064 : ;; Shrink windows by delta.
3065 0 : (setq best-window t)
3066 0 : (while (and best-window (not (zerop delta)))
3067 0 : (setq sub last)
3068 0 : (setq best-window nil)
3069 0 : (setq best-value most-negative-fixnum)
3070 0 : (while sub
3071 0 : (when (and (consp (window-new-normal sub))
3072 0 : (not (<= (car (window-new-normal sub)) 0))
3073 0 : (> (cdr (window-new-normal sub)) best-value))
3074 0 : (setq best-window sub)
3075 0 : (setq best-value (cdr (window-new-normal sub))))
3076 :
3077 0 : (setq sub (window-left sub)))
3078 :
3079 0 : (when best-window
3080 0 : (setq best-delta (min (car (window-new-normal best-window))
3081 0 : char-size (- delta)))
3082 0 : (setq delta (+ delta best-delta))
3083 0 : (set-window-new-pixel best-window (- best-delta) t)
3084 0 : (set-window-new-normal
3085 0 : best-window
3086 0 : (if (= (car (window-new-normal best-window)) best-delta)
3087 : 'skip ; We can't shrink best-window any further.
3088 0 : (cons (- (car (window-new-normal best-window)) best-delta)
3089 0 : (- (/ (float (window-new-pixel best-window))
3090 0 : parent-total)
3091 0 : (window-normal-size best-window horizontal))))))))
3092 0 : ((> delta 0)
3093 : ;; Enlarge windows by delta.
3094 0 : (setq best-window t)
3095 0 : (while (and best-window (not (zerop delta)))
3096 0 : (setq sub last)
3097 0 : (setq best-window nil)
3098 0 : (setq best-value most-positive-fixnum)
3099 0 : (while sub
3100 0 : (when (and (numberp (window-new-normal sub))
3101 0 : (< (window-new-normal sub) best-value))
3102 0 : (setq best-window sub)
3103 0 : (setq best-value (window-new-normal sub)))
3104 :
3105 0 : (setq sub (window-left sub)))
3106 :
3107 0 : (when best-window
3108 0 : (setq best-delta (min delta char-size))
3109 0 : (setq delta (- delta best-delta))
3110 0 : (set-window-new-pixel best-window best-delta t)
3111 0 : (set-window-new-normal
3112 0 : best-window
3113 0 : (- (/ (float (window-new-pixel best-window))
3114 0 : parent-total)
3115 0 : (window-normal-size best-window horizontal)))))))
3116 :
3117 0 : (when best-window
3118 0 : (setq sub last)
3119 0 : (while sub
3120 0 : (when (or (consp (window-new-normal sub))
3121 0 : (numberp (window-new-normal sub)))
3122 : ;; Reset new normal size fields so `window-resize-apply'
3123 : ;; won't use them to apply new sizes.
3124 0 : (set-window-new-normal sub))
3125 :
3126 0 : (unless (eq (window-new-normal sub) 'ignore)
3127 : ;; Resize this window's child windows (back-engineering
3128 : ;; delta from sub's old and new total sizes).
3129 0 : (let ((delta (- (window-new-pixel sub)
3130 0 : (window-size sub horizontal t))))
3131 0 : (unless (and (zerop delta) (not trail))
3132 : ;; For the TRAIL non-nil case we have to resize SUB
3133 : ;; recursively even if it's size does not change.
3134 0 : (window--resize-this-window
3135 0 : sub delta horizontal ignore nil trail edge))))
3136 0 : (setq sub (window-left sub)))))))
3137 :
3138 : (defun window--resize-siblings (window delta &optional horizontal ignore trail edge char-size)
3139 : "Resize other windows when WINDOW is resized vertically by DELTA pixels.
3140 : Optional argument HORIZONTAL non-nil means resize other windows
3141 : when WINDOW is resized horizontally by DELTA pixels. WINDOW
3142 : itself is not resized by this function.
3143 :
3144 : The optional argument IGNORE has the same meaning as for
3145 : `window-resizable'.
3146 :
3147 : Optional arguments TRAIL and EDGE, when non-nil, refine the set
3148 : of windows that shall be resized. If TRAIL equals `before',
3149 : resize only windows on the left or above EDGE. If TRAIL equals
3150 : `after', resize only windows on the right or below EDGE. Also,
3151 : preferably only resize windows adjacent to EDGE."
3152 0 : (when (window-parent window)
3153 0 : (let* ((parent (window-parent window))
3154 0 : (sub (window-child parent)))
3155 0 : (if (window-combined-p sub horizontal)
3156 : ;; In an iso-combination try to extract DELTA from WINDOW's
3157 : ;; siblings.
3158 0 : (let ((skip (eq trail 'after))
3159 : this-delta other-delta)
3160 : ;; Decide which windows shall be left alone.
3161 0 : (while sub
3162 0 : (cond
3163 0 : ((eq sub window)
3164 : ;; Make sure WINDOW is left alone when
3165 : ;; resizing its siblings.
3166 0 : (set-window-new-normal sub 'ignore)
3167 0 : (setq skip (eq trail 'before)))
3168 0 : (skip
3169 : ;; Make sure this sibling is left alone when
3170 : ;; resizing its siblings.
3171 0 : (set-window-new-normal sub 'ignore))
3172 0 : ((not (window-size-fixed-p sub horizontal ignore))
3173 : ;; Set this-delta to t to signal that we found a sibling
3174 : ;; of WINDOW whose size is not fixed.
3175 0 : (setq this-delta t)))
3176 :
3177 0 : (setq sub (window-right sub)))
3178 :
3179 : ;; Set this-delta to what we can get from WINDOW's siblings.
3180 0 : (if (= (- delta) (window-size window horizontal t))
3181 : ;; A deletion, presumably. We must handle this case
3182 : ;; specially since `window--resizable' can't be used.
3183 0 : (if this-delta
3184 : ;; There's at least one resizable sibling we can
3185 : ;; give WINDOW's size to.
3186 0 : (setq this-delta delta)
3187 : ;; No resizable sibling exists.
3188 0 : (setq this-delta 0))
3189 : ;; Any other form of resizing.
3190 0 : (setq this-delta
3191 0 : (window--resizable
3192 0 : window delta horizontal ignore trail t nil t)))
3193 :
3194 : ;; Set other-delta to what we still have to get from
3195 : ;; ancestor windows of parent.
3196 0 : (setq other-delta (- delta this-delta))
3197 0 : (unless (zerop other-delta)
3198 : ;; Unless we got everything from WINDOW's siblings, PARENT
3199 : ;; must be resized by other-delta lines or columns.
3200 0 : (set-window-new-pixel parent other-delta 'add))
3201 :
3202 0 : (if (zerop this-delta)
3203 : ;; We haven't got anything from WINDOW's siblings but we
3204 : ;; must update the normal sizes to respect other-delta.
3205 0 : (window--resize-child-windows-normal
3206 0 : parent horizontal window this-delta trail other-delta)
3207 : ;; We did get something from WINDOW's siblings which means
3208 : ;; we have to resize their child windows.
3209 0 : (unless (eq (window--resize-child-windows
3210 0 : parent (- this-delta) horizontal
3211 0 : window ignore trail edge char-size)
3212 : ;; If `window--resize-child-windows' returns
3213 : ;; 'normalized, this means it has set the
3214 : ;; normal sizes already.
3215 0 : 'normalized)
3216 : ;; Set the normal sizes.
3217 0 : (window--resize-child-windows-normal
3218 0 : parent horizontal window this-delta trail other-delta))
3219 : ;; Set DELTA to what we still have to get from ancestor
3220 : ;; windows.
3221 0 : (setq delta other-delta)))
3222 :
3223 : ;; In an ortho-combination all siblings of WINDOW must be
3224 : ;; resized by DELTA.
3225 0 : (set-window-new-pixel parent delta 'add)
3226 0 : (while sub
3227 0 : (unless (eq sub window)
3228 0 : (window--resize-this-window
3229 0 : sub delta horizontal ignore t))
3230 0 : (setq sub (window-right sub))))
3231 :
3232 0 : (unless (zerop delta)
3233 : ;; "Go up."
3234 0 : (window--resize-siblings
3235 0 : parent delta horizontal ignore trail edge char-size)))))
3236 :
3237 : (defun window--resize-this-window (window delta &optional horizontal ignore add trail edge char-size)
3238 : "Resize WINDOW vertically by DELTA pixels.
3239 : Optional argument HORIZONTAL non-nil means resize WINDOW
3240 : horizontally by DELTA pixels.
3241 :
3242 : The optional argument IGNORE has the same meaning as for
3243 : `window-resizable'. Optional argument ADD non-nil means add
3244 : DELTA to the new total size of WINDOW.
3245 :
3246 : Optional arguments TRAIL and EDGE, when non-nil, refine the set
3247 : of windows that shall be resized. If TRAIL equals `before',
3248 : resize only windows on the left or above EDGE. If TRAIL equals
3249 : `after', resize only windows on the right or below EDGE. Also,
3250 : preferably only resize windows adjacent to EDGE.
3251 :
3252 : If the optional argument CHAR-SIZE is a positive integer, it specifies
3253 : the number of pixels by which windows are incrementally resized.
3254 : If CHAR-SIZE is nil, this means to use the value of
3255 : `frame-char-height' or `frame-char-width' of WINDOW's frame.
3256 :
3257 : This function recursively resizes WINDOW's child windows to fit the
3258 : new size. Make sure that WINDOW is `window--resizable' before
3259 : calling this function. Note that this function does not resize
3260 : siblings of WINDOW or WINDOW's parent window. You have to
3261 : eventually call `window-resize-apply' in order to make resizing
3262 : actually take effect."
3263 3 : (when add
3264 : ;; Add DELTA to the new total size of WINDOW.
3265 3 : (set-window-new-pixel window delta t))
3266 :
3267 3 : (let ((sub (window-child window)))
3268 3 : (cond
3269 3 : ((not sub))
3270 0 : ((window-combined-p sub horizontal)
3271 : ;; In an iso-combination resize child windows according to their
3272 : ;; normal sizes.
3273 0 : (window--resize-child-windows
3274 0 : window delta horizontal nil ignore trail edge char-size))
3275 : ;; In an ortho-combination resize each child window by DELTA.
3276 : (t
3277 0 : (while sub
3278 0 : (window--resize-this-window
3279 0 : sub delta horizontal ignore t trail edge char-size)
3280 3 : (setq sub (window-right sub)))))))
3281 :
3282 : (defun window--resize-root-window (window delta horizontal ignore pixelwise)
3283 : "Resize root window WINDOW vertically by DELTA lines.
3284 : HORIZONTAL non-nil means resize root window WINDOW horizontally
3285 : by DELTA columns.
3286 :
3287 : IGNORE non-nil means ignore any restrictions imposed by fixed
3288 : size windows, `window-min-height' or `window-min-width' settings.
3289 :
3290 : This function is only called by the frame resizing routines. It
3291 : resizes windows proportionally and never deletes any windows."
3292 0 : (when (and (windowp window) (numberp delta))
3293 0 : (let ((pixel-delta
3294 0 : (if pixelwise
3295 0 : delta
3296 0 : (window--size-to-pixel window delta horizontal))))
3297 0 : (when (window-sizable-p window pixel-delta horizontal ignore t)
3298 0 : (window--resize-reset (window-frame window) horizontal)
3299 0 : (window--resize-this-window
3300 0 : window pixel-delta horizontal ignore t)))))
3301 :
3302 : (defun window--resize-root-window-vertically (window delta pixelwise)
3303 : "Resize root window WINDOW vertically by DELTA lines.
3304 : If DELTA is less than zero and we can't shrink WINDOW by DELTA
3305 : lines, shrink it as much as possible. If DELTA is greater than
3306 : zero, this function can resize fixed-size windows in order to
3307 : recover the necessary lines. Return the number of lines that
3308 : were recovered.
3309 :
3310 : Third argument PIXELWISE non-nil means to interpret DELTA as
3311 : pixels and return the number of pixels that were recovered.
3312 :
3313 : This function is called by the minibuffer window resizing
3314 : routines."
3315 0 : (let* ((frame (window-frame window))
3316 : (pixel-delta
3317 0 : (cond
3318 0 : (pixelwise
3319 0 : delta)
3320 0 : ((numberp delta)
3321 0 : (* (frame-char-height frame) delta))
3322 0 : (t 0)))
3323 : ignore)
3324 0 : (cond
3325 0 : ((zerop pixel-delta))
3326 0 : ((< pixel-delta 0)
3327 0 : (setq pixel-delta (window-sizable window pixel-delta nil nil pixelwise))
3328 0 : (window--resize-reset frame)
3329 : ;; When shrinking the root window, emulate an edge drag in order
3330 : ;; to not resize other windows if we can avoid it (Bug#12419).
3331 0 : (window--resize-this-window
3332 0 : window pixel-delta nil ignore t 'before
3333 0 : (+ (window-pixel-top window) (window-pixel-height window)))
3334 : ;; Don't record new normal sizes to make sure that shrinking back
3335 : ;; proportionally works as intended.
3336 0 : (walk-window-tree
3337 0 : (lambda (window) (set-window-new-normal window 'ignore)) frame t))
3338 0 : ((> pixel-delta 0)
3339 0 : (window--resize-reset frame)
3340 0 : (unless (window-sizable window pixel-delta nil nil pixelwise)
3341 0 : (setq ignore t))
3342 : ;; When growing the root window, resize proportionally. This
3343 : ;; should give windows back their original sizes (hopefully).
3344 0 : (window--resize-this-window
3345 0 : window pixel-delta nil ignore t)))
3346 : ;; Return the possibly adjusted DELTA.
3347 0 : (if pixelwise
3348 0 : pixel-delta
3349 0 : (/ pixel-delta (frame-char-height frame)))))
3350 :
3351 : (defun window--sanitize-window-sizes (horizontal)
3352 : "Assert that all windows on selected frame are large enough.
3353 : If necessary and possible, make sure that every window on frame
3354 : FRAME has its minimum height. Optional argument HORIZONTAL
3355 : non-nil means to make sure that every window on frame FRAME has
3356 : its minimum width. The minimum height/width of a window is the
3357 : respective value returned by `window-min-size' for that window.
3358 :
3359 : Return t if all windows were resized appropriately. Return nil
3360 : if at least one window could not be resized as requested, which
3361 : may happen when the FRAME is not large enough to accommodate it."
3362 111 : (let ((value t))
3363 111 : (walk-window-tree
3364 : (lambda (window)
3365 114 : (let ((delta (- (window-min-size window horizontal nil t)
3366 114 : (window-size window horizontal t))))
3367 114 : (when (> delta 0)
3368 0 : (if (window-resizable-p window delta horizontal nil t)
3369 0 : (window-resize window delta horizontal nil t)
3370 225 : (setq value nil))))))
3371 111 : value))
3372 :
3373 : (defun adjust-window-trailing-edge (window delta &optional horizontal pixelwise)
3374 : "Move WINDOW's bottom edge by DELTA lines.
3375 : Optional argument HORIZONTAL non-nil means move WINDOW's right
3376 : edge by DELTA columns. WINDOW must be a valid window and
3377 : defaults to the selected one.
3378 :
3379 : Optional argument PIXELWISE non-nil means interpret DELTA as
3380 : number of pixels.
3381 :
3382 : If DELTA is greater than zero, move the edge downwards or to the
3383 : right. If DELTA is less than zero, move the edge upwards or to
3384 : the left. If the edge can't be moved by DELTA lines or columns,
3385 : move it as far as possible in the desired direction."
3386 0 : (setq window (window-normalize-window window))
3387 0 : (let* ((frame (window-frame window))
3388 0 : (minibuffer-window (minibuffer-window frame))
3389 0 : (right window)
3390 : left first-left first-right this-delta min-delta max-delta ignore)
3391 :
3392 0 : (unless pixelwise
3393 0 : (setq pixelwise t)
3394 0 : (setq delta (* delta (frame-char-size window horizontal))))
3395 :
3396 : ;; Find the edge we want to move.
3397 0 : (while (and (or (not (window-combined-p right horizontal))
3398 0 : (not (window-right right)))
3399 0 : (setq right (window-parent right))))
3400 0 : (cond
3401 0 : ((and (not right) (not horizontal)
3402 : ;; Resize the minibuffer window if it's on the same frame as
3403 : ;; and immediately below WINDOW and it's either active or
3404 : ;; `resize-mini-windows' is nil.
3405 0 : (eq (window-frame minibuffer-window) frame)
3406 0 : (= (nth 1 (window-pixel-edges minibuffer-window))
3407 0 : (nth 3 (window-pixel-edges window)))
3408 0 : (or (not resize-mini-windows)
3409 0 : (eq minibuffer-window (active-minibuffer-window))))
3410 0 : (window--resize-mini-window minibuffer-window (- delta)))
3411 0 : ((or (not (setq left right)) (not (setq right (window-right right))))
3412 0 : (if horizontal
3413 0 : (user-error "No window on the right of this one")
3414 0 : (user-error "No window below this one")))
3415 : (t
3416 : ;; Set LEFT to the first resizable window on the left. This step is
3417 : ;; needed to handle fixed-size windows.
3418 0 : (setq first-left left)
3419 0 : (while (and left
3420 0 : (or (window-size-fixed-p left horizontal)
3421 0 : (and (< delta 0)
3422 0 : (<= (window-size left horizontal t)
3423 0 : (window-min-size left horizontal nil t)))))
3424 0 : (setq left
3425 0 : (or (window-left left)
3426 0 : (progn
3427 0 : (while (and (setq left (window-parent left))
3428 0 : (not (window-combined-p left horizontal))))
3429 0 : (window-left left)))))
3430 0 : (unless left
3431 : ;; We have to resize a size-preserved window. Start again with
3432 : ;; the window initially on the left.
3433 0 : (setq ignore 'preserved)
3434 0 : (setq left first-left)
3435 0 : (while (and left
3436 0 : (or (window-size-fixed-p left horizontal 'preserved)
3437 0 : (and (< delta 0)
3438 0 : (<= (window-size left horizontal t)
3439 0 : (window-min-size
3440 0 : left horizontal 'preserved t)))))
3441 0 : (setq left
3442 0 : (or (window-left left)
3443 0 : (progn
3444 0 : (while (and (setq left (window-parent left))
3445 0 : (not (window-combined-p left horizontal))))
3446 0 : (window-left left)))))
3447 :
3448 0 : (unless left
3449 0 : (if horizontal
3450 0 : (user-error "No resizable window on the left of this one")
3451 0 : (user-error "No resizable window above this one"))))
3452 :
3453 : ;; Set RIGHT to the first resizable window on the right. This step
3454 : ;; is needed to handle fixed-size windows.
3455 0 : (setq first-right right)
3456 0 : (while (and right
3457 0 : (or (window-size-fixed-p right horizontal)
3458 0 : (and (> delta 0)
3459 0 : (<= (window-size right horizontal t)
3460 0 : (window-min-size
3461 0 : right horizontal 'preserved t)))))
3462 0 : (setq right
3463 0 : (or (window-right right)
3464 0 : (progn
3465 0 : (while (and (setq right (window-parent right))
3466 0 : (not (window-combined-p right horizontal))))
3467 0 : (window-right right)))))
3468 0 : (unless right
3469 : ;; We have to resize a size-preserved window. Start again with
3470 : ;; the window initially on the right.
3471 0 : (setq ignore 'preserved)
3472 0 : (setq right first-right)
3473 0 : (while (and right
3474 0 : (or (window-size-fixed-p right horizontal 'preserved)
3475 0 : (and (> delta 0)
3476 0 : (<= (window-size right horizontal t)
3477 0 : (window-min-size
3478 0 : right horizontal 'preserved t)))))
3479 0 : (setq right
3480 0 : (or (window-right right)
3481 0 : (progn
3482 0 : (while (and (setq right (window-parent right))
3483 0 : (not (window-combined-p right horizontal))))
3484 0 : (window-right right)))))
3485 0 : (unless right
3486 0 : (if horizontal
3487 0 : (user-error "No resizable window on the right of this one")
3488 0 : (user-error "No resizable window below this one"))))
3489 :
3490 : ;; LEFT and RIGHT (which might be both internal windows) are now the
3491 : ;; two windows we want to resize.
3492 0 : (cond
3493 0 : ((> delta 0)
3494 0 : (setq max-delta
3495 0 : (window--max-delta-1
3496 0 : left 0 horizontal ignore 'after nil pixelwise))
3497 0 : (setq min-delta
3498 0 : (window--min-delta-1
3499 0 : right (- delta) horizontal ignore 'before nil pixelwise))
3500 0 : (when (or (< max-delta delta) (> min-delta (- delta)))
3501 : ;; We can't get the whole DELTA - move as far as possible.
3502 0 : (setq delta (min max-delta (- min-delta))))
3503 0 : (unless (zerop delta)
3504 : ;; Start resizing.
3505 0 : (window--resize-reset frame horizontal)
3506 : ;; Try to enlarge LEFT first.
3507 0 : (setq this-delta
3508 0 : (window--resizable
3509 0 : left delta horizontal ignore 'after nil nil pixelwise))
3510 0 : (unless (zerop this-delta)
3511 0 : (window--resize-this-window
3512 0 : left this-delta horizontal ignore t 'before
3513 0 : (if horizontal
3514 0 : (+ (window-pixel-left left) (window-pixel-width left))
3515 0 : (+ (window-pixel-top left) (window-pixel-height left)))))
3516 : ;; Shrink windows on right of LEFT.
3517 0 : (window--resize-siblings
3518 0 : left delta horizontal ignore 'after
3519 0 : (if horizontal
3520 0 : (window-pixel-left right)
3521 0 : (window-pixel-top right)))))
3522 0 : ((< delta 0)
3523 0 : (setq max-delta
3524 0 : (window--max-delta-1
3525 0 : right 0 horizontal ignore 'before nil pixelwise))
3526 0 : (setq min-delta
3527 0 : (window--min-delta-1
3528 0 : left delta horizontal ignore 'after nil pixelwise))
3529 0 : (when (or (< max-delta (- delta)) (> min-delta delta))
3530 : ;; We can't get the whole DELTA - move as far as possible.
3531 0 : (setq delta (max (- max-delta) min-delta)))
3532 0 : (unless (zerop delta)
3533 : ;; Start resizing.
3534 0 : (window--resize-reset frame horizontal)
3535 : ;; Try to enlarge RIGHT.
3536 0 : (setq this-delta
3537 0 : (window--resizable
3538 0 : right (- delta) horizontal ignore 'before nil nil pixelwise))
3539 0 : (unless (zerop this-delta)
3540 0 : (window--resize-this-window
3541 0 : right this-delta horizontal ignore t 'after
3542 0 : (if horizontal
3543 0 : (window-pixel-left right)
3544 0 : (window-pixel-top right))))
3545 : ;; Shrink windows on left of RIGHT.
3546 0 : (window--resize-siblings
3547 0 : right (- delta) horizontal ignore 'before
3548 0 : (if horizontal
3549 0 : (+ (window-pixel-left left) (window-pixel-width left))
3550 0 : (+ (window-pixel-top left) (window-pixel-height left)))))))
3551 0 : (unless (zerop delta)
3552 : ;; Don't report an error in the standard case.
3553 0 : (when (window--resize-apply-p frame horizontal)
3554 0 : (if (window-resize-apply frame horizontal)
3555 0 : (progn
3556 0 : (window--pixel-to-total frame horizontal)
3557 0 : (run-window-configuration-change-hook frame))
3558 : ;; But do report an error if applying the changes fails.
3559 0 : (error "Failed adjusting window %s" window))))))))
3560 :
3561 : (defun enlarge-window (delta &optional horizontal)
3562 : "Make the selected window DELTA lines taller.
3563 : Interactively, if no argument is given, make the selected window
3564 : one line taller. If optional argument HORIZONTAL is non-nil,
3565 : make selected window wider by DELTA columns. If DELTA is
3566 : negative, shrink selected window by -DELTA lines or columns."
3567 : (interactive "p")
3568 0 : (let ((minibuffer-window (minibuffer-window)))
3569 0 : (when (window-preserved-size nil horizontal)
3570 0 : (window-preserve-size nil horizontal))
3571 0 : (cond
3572 0 : ((zerop delta))
3573 0 : ((window-size-fixed-p nil horizontal)
3574 0 : (user-error "Selected window has fixed size"))
3575 0 : ((window-minibuffer-p)
3576 0 : (if horizontal
3577 0 : (user-error "Cannot resize minibuffer window horizontally")
3578 0 : (window--resize-mini-window
3579 0 : (selected-window) (* delta (frame-char-height)))))
3580 0 : ((and (not horizontal)
3581 0 : (window-full-height-p)
3582 0 : (eq (window-frame minibuffer-window) (selected-frame))
3583 0 : (not resize-mini-windows))
3584 : ;; If the selected window is full height and `resize-mini-windows'
3585 : ;; is nil, resize the minibuffer window.
3586 0 : (window--resize-mini-window
3587 0 : minibuffer-window (* (- delta) (frame-char-height))))
3588 0 : ((window--resizable-p nil delta horizontal)
3589 0 : (window-resize nil delta horizontal))
3590 0 : ((window--resizable-p nil delta horizontal 'preserved)
3591 0 : (window-resize nil delta horizontal 'preserved))
3592 0 : ((eq this-command
3593 0 : (if horizontal 'enlarge-window-horizontally 'enlarge-window))
3594 : ;; For backward compatibility don't signal an error unless this
3595 : ;; command is `enlarge-window(-horizontally)'.
3596 0 : (user-error "Cannot enlarge selected window"))
3597 : (t
3598 0 : (window-resize
3599 0 : nil (if (> delta 0)
3600 0 : (window-max-delta nil horizontal)
3601 0 : (- (window-min-delta nil horizontal)))
3602 0 : horizontal)))))
3603 :
3604 : (defun shrink-window (delta &optional horizontal)
3605 : "Make the selected window DELTA lines smaller.
3606 : Interactively, if no argument is given, make the selected window
3607 : one line smaller. If optional argument HORIZONTAL is non-nil,
3608 : make selected window narrower by DELTA columns. If DELTA is
3609 : negative, enlarge selected window by -DELTA lines or columns."
3610 : (interactive "p")
3611 0 : (let ((minibuffer-window (minibuffer-window)))
3612 0 : (when (window-preserved-size nil horizontal)
3613 0 : (window-preserve-size nil horizontal))
3614 0 : (cond
3615 0 : ((zerop delta))
3616 0 : ((window-size-fixed-p nil horizontal)
3617 0 : (user-error "Selected window has fixed size"))
3618 0 : ((window-minibuffer-p)
3619 0 : (if horizontal
3620 0 : (user-error "Cannot resize minibuffer window horizontally")
3621 0 : (window--resize-mini-window
3622 0 : (selected-window) (* (- delta) (frame-char-height)))))
3623 0 : ((and (not horizontal)
3624 0 : (window-full-height-p)
3625 0 : (eq (window-frame minibuffer-window) (selected-frame))
3626 0 : (not resize-mini-windows))
3627 : ;; If the selected window is full height and `resize-mini-windows'
3628 : ;; is nil, resize the minibuffer window.
3629 0 : (window--resize-mini-window
3630 0 : minibuffer-window (* delta (frame-char-height))))
3631 0 : ((window--resizable-p nil (- delta) horizontal)
3632 0 : (window-resize nil (- delta) horizontal))
3633 0 : ((window--resizable-p nil (- delta) horizontal 'preserved)
3634 0 : (window-resize nil (- delta) horizontal 'preserved))
3635 0 : ((eq this-command
3636 0 : (if horizontal 'shrink-window-horizontally 'shrink-window))
3637 : ;; For backward compatibility don't signal an error unless this
3638 : ;; command is `shrink-window(-horizontally)'.
3639 0 : (user-error "Cannot shrink selected window"))
3640 : (t
3641 0 : (window-resize
3642 0 : nil (if (> delta 0)
3643 0 : (- (window-min-delta nil horizontal))
3644 0 : (window-max-delta nil horizontal))
3645 0 : horizontal)))))
3646 :
3647 : (defun maximize-window (&optional window)
3648 : "Maximize WINDOW.
3649 : Make WINDOW as large as possible without deleting any windows.
3650 : WINDOW must be a valid window and defaults to the selected one.
3651 :
3652 : If the option `window-resize-pixelwise' is non-nil maximize
3653 : WINDOW pixelwise."
3654 : (interactive)
3655 0 : (setq window (window-normalize-window window))
3656 0 : (window-resize
3657 0 : window (window-max-delta window nil nil nil nil nil window-resize-pixelwise)
3658 0 : nil nil window-resize-pixelwise)
3659 0 : (window-resize
3660 0 : window (window-max-delta window t nil nil nil nil window-resize-pixelwise)
3661 0 : t nil window-resize-pixelwise))
3662 :
3663 : (defun minimize-window (&optional window)
3664 : "Minimize WINDOW.
3665 : Make WINDOW as small as possible without deleting any windows.
3666 : WINDOW must be a valid window and defaults to the selected one.
3667 :
3668 : If the option `window-resize-pixelwise' is non-nil minimize
3669 : WINDOW pixelwise."
3670 : (interactive)
3671 0 : (setq window (window-normalize-window window))
3672 0 : (window-resize
3673 0 : window
3674 0 : (- (window-min-delta window nil nil nil nil nil window-resize-pixelwise))
3675 0 : nil nil window-resize-pixelwise)
3676 0 : (window-resize
3677 0 : window
3678 0 : (- (window-min-delta window t nil nil nil nil window-resize-pixelwise))
3679 0 : t nil window-resize-pixelwise))
3680 :
3681 : ;;; Window edges
3682 : (defun window-edges (&optional window body absolute pixelwise)
3683 : "Return a list of the edge distances of WINDOW.
3684 : WINDOW must be a valid window and defaults to the selected one.
3685 : The list returned has the form (LEFT TOP RIGHT BOTTOM).
3686 :
3687 : If the optional argument BODY is nil, this means to return the
3688 : edges corresponding to the total size of WINDOW. BODY non-nil
3689 : means to return the edges of WINDOW's body (aka text area). If
3690 : BODY is non-nil, WINDOW must specify a live window.
3691 :
3692 : Optional argument ABSOLUTE nil means to return edges relative to
3693 : the position of WINDOW's native frame. ABSOLUTE non-nil means to
3694 : return coordinates relative to the origin - the position (0, 0) -
3695 : of FRAME's display. On non-graphical systems this argument has
3696 : no effect.
3697 :
3698 : Optional argument PIXELWISE nil means to return the coordinates
3699 : in terms of the canonical character width and height of WINDOW's
3700 : frame, rounded if necessary. PIXELWISE non-nil means to return
3701 : the coordinates in pixels where the values for RIGHT and BOTTOM
3702 : are one more than the actual value of these edges. Note that if
3703 : ABSOLUTE is non-nil, PIXELWISE is implicitly non-nil too."
3704 0 : (let* ((window (window-normalize-window window body))
3705 0 : (frame (window-frame window))
3706 0 : (border-width (frame-internal-border-width frame))
3707 0 : (char-width (frame-char-width frame))
3708 0 : (char-height (frame-char-height frame))
3709 0 : (left (if pixelwise
3710 0 : (+ (window-pixel-left window) border-width)
3711 0 : (+ (window-left-column window)
3712 0 : (/ border-width char-width))))
3713 : (left-body
3714 0 : (when body
3715 0 : (+ (window-pixel-left window) border-width
3716 0 : (if (eq (car (window-current-scroll-bars window)) 'left)
3717 0 : (window-scroll-bar-width window)
3718 0 : 0)
3719 0 : (nth 0 (window-fringes window))
3720 0 : (* (or (nth 0 (window-margins window)) 0) char-width))))
3721 0 : (top (if pixelwise
3722 0 : (+ (window-pixel-top window) border-width)
3723 0 : (+ (window-top-line window)
3724 0 : (/ border-width char-height))))
3725 : (top-body
3726 0 : (when body
3727 0 : (+ (window-pixel-top window) border-width
3728 0 : (window-header-line-height window))))
3729 0 : (right (+ left (if pixelwise
3730 0 : (window-pixel-width window)
3731 0 : (window-total-width window))))
3732 0 : (right-body (and body (+ left-body (window-body-width window t))))
3733 0 : (bottom (+ top (if pixelwise
3734 0 : (window-pixel-height window)
3735 0 : (window-total-height window))))
3736 0 : (bottom-body (and body (+ top-body (window-body-height window t)))))
3737 0 : (if absolute
3738 0 : (let* ((native-edges (frame-edges frame 'native-edges))
3739 0 : (left-off (nth 0 native-edges))
3740 0 : (top-off (nth 1 native-edges)))
3741 0 : (if body
3742 0 : (list (+ left-body left-off) (+ top-body top-off)
3743 0 : (+ right-body left-off) (+ bottom-body top-off))
3744 0 : (list (+ left left-off) (+ top top-off)
3745 0 : (+ right left-off) (+ bottom top-off))))
3746 0 : (if body
3747 0 : (if pixelwise
3748 0 : (list left-body top-body right-body bottom-body)
3749 0 : (list (/ left-body char-width) (/ top-body char-height)
3750 : ;; Round up.
3751 0 : (/ (+ right-body char-width -1) char-width)
3752 0 : (/ (+ bottom-body char-height -1) char-height)))
3753 0 : (list left top right bottom)))))
3754 :
3755 : (defun window-body-edges (&optional window)
3756 : "Return a list of the edge coordinates of WINDOW's body.
3757 : The return value is that of `window-edges' called with argument
3758 : BODY non-nil."
3759 0 : (window-edges window t))
3760 : (defalias 'window-inside-edges 'window-body-edges)
3761 :
3762 : (defun window-pixel-edges (&optional window)
3763 : "Return a list of the edge pixel coordinates of WINDOW.
3764 : The return value is that of `window-edges' called with argument
3765 : PIXELWISE non-nil."
3766 0 : (window-edges window nil nil t))
3767 :
3768 : (defun window-body-pixel-edges (&optional window)
3769 : "Return a list of the edge pixel coordinates of WINDOW's body.
3770 : The return value is that of `window-edges' called with arguments
3771 : BODY and PIXELWISE non-nil."
3772 0 : (window-edges window t nil t))
3773 : (defalias 'window-inside-pixel-edges 'window-body-pixel-edges)
3774 :
3775 : (defun window-absolute-pixel-edges (&optional window)
3776 : "Return a list of the edge pixel coordinates of WINDOW.
3777 : The return value is that of `window-edges' called with argument
3778 : ABSOLUTE non-nil."
3779 0 : (window-edges window nil t t))
3780 :
3781 : (defun window-absolute-body-pixel-edges (&optional window)
3782 : "Return a list of the edge pixel coordinates of WINDOW's text area.
3783 : The return value is that of `window-edges' called with arguments
3784 : BODY and ABSOLUTE non-nil."
3785 0 : (window-edges window t t t))
3786 : (defalias 'window-inside-absolute-pixel-edges 'window-absolute-body-pixel-edges)
3787 :
3788 : (defun window-absolute-pixel-position (&optional position window)
3789 : "Return display coordinates of POSITION in WINDOW.
3790 : If the buffer position POSITION is visible in window WINDOW,
3791 : return the display coordinates of the upper/left corner of the
3792 : glyph at POSITION. The return value is a cons of the X- and
3793 : Y-coordinates of that corner, relative to an origin at (0, 0) of
3794 : WINDOW's display. Return nil if POSITION is not visible in
3795 : WINDOW.
3796 :
3797 : WINDOW must be a live window and defaults to the selected window.
3798 : POSITION defaults to the value of `window-point' of WINDOW."
3799 0 : (let* ((window (window-normalize-window window t))
3800 : (pos-in-window
3801 0 : (pos-visible-in-window-p
3802 0 : (or position (window-point window)) window t)))
3803 0 : (when pos-in-window
3804 0 : (let ((edges (window-absolute-body-pixel-edges window)))
3805 0 : (cons (+ (nth 0 edges) (nth 0 pos-in-window))
3806 0 : (+ (nth 1 edges) (nth 1 pos-in-window)))))))
3807 :
3808 : (defun frame-root-window-p (window)
3809 : "Return non-nil if WINDOW is the root window of its frame."
3810 0 : (eq window (frame-root-window window)))
3811 :
3812 : (defun window--subtree (window &optional next)
3813 : "Return window subtree rooted at WINDOW.
3814 : Optional argument NEXT non-nil means include WINDOW's right
3815 : siblings in the return value.
3816 :
3817 : See the documentation of `window-tree' for a description of the
3818 : return value."
3819 0 : (let (list)
3820 0 : (while window
3821 0 : (setq list
3822 0 : (cons
3823 0 : (cond
3824 0 : ((window-top-child window)
3825 0 : (cons t (cons (window-edges window)
3826 0 : (window--subtree (window-top-child window) t))))
3827 0 : ((window-left-child window)
3828 0 : (cons nil (cons (window-edges window)
3829 0 : (window--subtree (window-left-child window) t))))
3830 0 : (t window))
3831 0 : list))
3832 0 : (setq window (when next (window-next-sibling window))))
3833 0 : (nreverse list)))
3834 :
3835 : (defun window-tree (&optional frame)
3836 : "Return the window tree of frame FRAME.
3837 : FRAME must be a live frame and defaults to the selected frame.
3838 : The return value is a list of the form (ROOT MINI), where ROOT
3839 : represents the window tree of the frame's root window, and MINI
3840 : is the frame's minibuffer window.
3841 :
3842 : If the root window is not split, ROOT is the root window itself.
3843 : Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil
3844 : for a horizontal split, and t for a vertical split. EDGES gives
3845 : the combined size and position of the child windows in the split,
3846 : and the rest of the elements are the child windows in the split.
3847 : Each of the child windows may again be a window or a list
3848 : representing a window split, and so on. EDGES is a list (LEFT
3849 : TOP RIGHT BOTTOM) as returned by `window-edges'."
3850 0 : (setq frame (window-normalize-frame frame))
3851 0 : (window--subtree (frame-root-window frame) t))
3852 :
3853 : (defun other-window (count &optional all-frames)
3854 : "Select another window in cyclic ordering of windows.
3855 : COUNT specifies the number of windows to skip, starting with the
3856 : selected window, before making the selection. If COUNT is
3857 : positive, skip COUNT windows forwards. If COUNT is negative,
3858 : skip -COUNT windows backwards. COUNT zero means do not skip any
3859 : window, so select the selected window. In an interactive call,
3860 : COUNT is the numeric prefix argument. Return nil.
3861 :
3862 : If the `other-window' parameter of the selected window is a
3863 : function and `ignore-window-parameters' is nil, call that
3864 : function with the arguments COUNT and ALL-FRAMES.
3865 :
3866 : This function does not select a window whose `no-other-window'
3867 : window parameter is non-nil.
3868 :
3869 : This function uses `next-window' for finding the window to
3870 : select. The argument ALL-FRAMES has the same meaning as in
3871 : `next-window', but the MINIBUF argument of `next-window' is
3872 : always effectively nil."
3873 : (interactive "p")
3874 0 : (let* ((window (selected-window))
3875 0 : (function (and (not ignore-window-parameters)
3876 0 : (window-parameter window 'other-window)))
3877 : old-window old-count)
3878 0 : (if (functionp function)
3879 0 : (funcall function count all-frames)
3880 : ;; `next-window' and `previous-window' may return a window we are
3881 : ;; not allowed to select. Hence we need an exit strategy in case
3882 : ;; all windows are non-selectable.
3883 0 : (catch 'exit
3884 0 : (while (> count 0)
3885 0 : (setq window (next-window window nil all-frames))
3886 0 : (cond
3887 0 : ((eq window old-window)
3888 0 : (when (= count old-count)
3889 : ;; Keep out of infinite loops. When COUNT has not changed
3890 : ;; since we last looked at `window' we're probably in one.
3891 0 : (throw 'exit nil)))
3892 0 : ((window-parameter window 'no-other-window)
3893 0 : (unless old-window
3894 : ;; The first non-selectable window `next-window' got us:
3895 : ;; Remember it and the current value of COUNT.
3896 0 : (setq old-window window)
3897 0 : (setq old-count count)))
3898 : (t
3899 0 : (setq count (1- count)))))
3900 0 : (while (< count 0)
3901 0 : (setq window (previous-window window nil all-frames))
3902 0 : (cond
3903 0 : ((eq window old-window)
3904 0 : (when (= count old-count)
3905 : ;; Keep out of infinite loops. When COUNT has not changed
3906 : ;; since we last looked at `window' we're probably in one.
3907 0 : (throw 'exit nil)))
3908 0 : ((window-parameter window 'no-other-window)
3909 0 : (unless old-window
3910 : ;; The first non-selectable window `previous-window' got
3911 : ;; us: Remember it and the current value of COUNT.
3912 0 : (setq old-window window)
3913 0 : (setq old-count count)))
3914 : (t
3915 0 : (setq count (1+ count)))))
3916 :
3917 0 : (select-window window)
3918 : ;; Always return nil.
3919 0 : nil))))
3920 :
3921 : ;; This should probably return non-nil when the selected window is part
3922 : ;; of an atomic window whose root is the frame's root window.
3923 : (defun one-window-p (&optional nomini all-frames)
3924 : "Return non-nil if the selected window is the only window.
3925 : Optional arg NOMINI non-nil means don't count the minibuffer
3926 : even if it is active. Otherwise, the minibuffer is counted
3927 : when it is active.
3928 :
3929 : Optional argument ALL-FRAMES specifies the set of frames to
3930 : consider, see also `next-window'. ALL-FRAMES nil or omitted
3931 : means consider windows on the selected frame only, plus the
3932 : minibuffer window if specified by the NOMINI argument. If the
3933 : minibuffer counts, consider all windows on all frames that share
3934 : that minibuffer too. The remaining non-nil values of ALL-FRAMES
3935 : with a special meaning are:
3936 :
3937 : - t means consider all windows on all existing frames.
3938 :
3939 : - `visible' means consider all windows on all visible frames on
3940 : the current terminal.
3941 :
3942 : - 0 (the number zero) means consider all windows on all visible
3943 : and iconified frames on the current terminal.
3944 :
3945 : - A frame means consider all windows on that frame only.
3946 :
3947 : Anything else means consider all windows on the selected frame
3948 : and no others."
3949 0 : (let ((base-window (selected-window)))
3950 0 : (if (and nomini (eq base-window (minibuffer-window)))
3951 0 : (setq base-window (next-window base-window)))
3952 0 : (eq base-window
3953 0 : (next-window base-window (if nomini 'arg) all-frames))))
3954 :
3955 : ;;; Deleting windows.
3956 : (defun window-deletable-p (&optional window)
3957 : "Return t if WINDOW can be safely deleted from its frame.
3958 : WINDOW must be a valid window and defaults to the selected one.
3959 :
3960 : Return `frame' if WINDOW is the root window of its frame and that
3961 : frame can be safely deleted."
3962 0 : (setq window (window-normalize-window window))
3963 :
3964 0 : (unless (or ignore-window-parameters
3965 0 : (eq (window-parameter window 'delete-window) t))
3966 : ;; Handle atomicity.
3967 0 : (when (window-parameter window 'window-atom)
3968 0 : (setq window (window-atom-root window))))
3969 :
3970 0 : (let ((frame (window-frame window)))
3971 0 : (cond
3972 0 : ((frame-root-window-p window)
3973 : ;; WINDOW's frame can be deleted only if there are other frames
3974 : ;; on the same terminal, and it does not contain the active
3975 : ;; minibuffer.
3976 0 : (unless (or (eq frame (next-frame frame 0))
3977 : ;; We can delete our frame only if no other frame
3978 : ;; currently uses our minibuffer window.
3979 0 : (catch 'other
3980 0 : (dolist (other (frame-list))
3981 0 : (when (and (not (eq other frame))
3982 0 : (eq (window-frame (minibuffer-window other))
3983 0 : frame))
3984 0 : (throw 'other t))))
3985 0 : (let ((minibuf (active-minibuffer-window)))
3986 0 : (and minibuf (eq frame (window-frame minibuf)))))
3987 0 : 'frame))
3988 0 : ((window-minibuffer-p window)
3989 : ;; If WINDOW is the minibuffer window of a non-minibuffer-only
3990 : ;; frame, it cannot be deleted separately.
3991 : nil)
3992 0 : ((or ignore-window-parameters
3993 0 : (not (eq window (window-main-window frame))))
3994 : ;; Otherwise, WINDOW can be deleted unless it is the main window
3995 : ;; of its frame.
3996 0 : t))))
3997 :
3998 : (defun window--in-subtree-p (window root)
3999 : "Return t if WINDOW is either ROOT or a member of ROOT's subtree."
4000 0 : (or (eq window root)
4001 0 : (let ((parent (window-parent window)))
4002 0 : (catch 'done
4003 0 : (while parent
4004 0 : (if (eq parent root)
4005 0 : (throw 'done t)
4006 0 : (setq parent (window-parent parent))))))))
4007 :
4008 : (defun delete-window (&optional window)
4009 : "Delete WINDOW.
4010 : WINDOW must be a valid window and defaults to the selected one.
4011 : Return nil.
4012 :
4013 : If the variable `ignore-window-parameters' is non-nil or the
4014 : `delete-window' parameter of WINDOW equals t, do not process any
4015 : parameters of WINDOW. Otherwise, if the `delete-window'
4016 : parameter of WINDOW specifies a function, call that function with
4017 : WINDOW as its sole argument and return the value returned by that
4018 : function.
4019 :
4020 : Otherwise, if WINDOW is part of an atomic window, call
4021 : `delete-window' with the root of the atomic window as its
4022 : argument. Signal an error if WINDOW is either the only window on
4023 : its frame, the last non-side window, or part of an atomic window
4024 : that is its frame's root window."
4025 : (interactive)
4026 0 : (setq window (window-normalize-window window))
4027 0 : (let* ((frame (window-frame window))
4028 0 : (function (window-parameter window 'delete-window))
4029 0 : (parent (window-parent window))
4030 : atom-root)
4031 0 : (window--check frame)
4032 0 : (catch 'done
4033 : ;; Handle window parameters.
4034 0 : (cond
4035 : ;; Ignore window parameters if `ignore-window-parameters' tells
4036 : ;; us so or `delete-window' equals t.
4037 0 : ((or ignore-window-parameters (eq function t)))
4038 0 : ((functionp function)
4039 : ;; The `delete-window' parameter specifies the function to call.
4040 : ;; If that function is `ignore' nothing is done. It's up to the
4041 : ;; function called here to avoid infinite recursion.
4042 0 : (throw 'done (funcall function window)))
4043 0 : ((and (window-parameter window 'window-atom)
4044 0 : (setq atom-root (window-atom-root window))
4045 0 : (not (eq atom-root window)))
4046 0 : (if (eq atom-root (frame-root-window frame))
4047 0 : (error "Root of atomic window is root window of its frame")
4048 0 : (throw 'done (delete-window atom-root))))
4049 0 : ((not parent)
4050 0 : (error "Attempt to delete minibuffer or sole ordinary window"))
4051 0 : ((eq window (window-main-window frame))
4052 0 : (error "Attempt to delete main window of frame %s" frame)))
4053 :
4054 0 : (let* ((horizontal (window-left-child parent))
4055 0 : (size (window-size window horizontal t))
4056 : (window-combination-resize
4057 0 : (or window-combination-resize
4058 0 : (window-parameter parent 'window-side)))
4059 : (frame-selected
4060 0 : (window--in-subtree-p (frame-selected-window frame) window))
4061 : ;; Emacs 23 preferably gives WINDOW's space to its left
4062 : ;; sibling.
4063 0 : (sibling (or (window-left window) (window-right window))))
4064 0 : (window--resize-reset frame horizontal)
4065 0 : (cond
4066 0 : ((and (not (eq window-combination-resize t))
4067 0 : sibling (window-sizable-p sibling size horizontal nil t))
4068 : ;; Resize WINDOW's sibling.
4069 0 : (window--resize-this-window sibling size horizontal nil t)
4070 0 : (set-window-new-normal
4071 0 : sibling (+ (window-normal-size sibling horizontal)
4072 0 : (window-normal-size window horizontal))))
4073 0 : ((window--resizable-p window (- size) horizontal nil nil nil t t)
4074 : ;; Can do without resizing fixed-size windows.
4075 0 : (window--resize-siblings window (- size) horizontal))
4076 : (t
4077 : ;; Can't do without resizing fixed-size windows.
4078 0 : (window--resize-siblings window (- size) horizontal t)))
4079 : ;; Actually delete WINDOW.
4080 0 : (delete-window-internal window)
4081 0 : (window--pixel-to-total frame horizontal)
4082 0 : (when (and frame-selected
4083 0 : (window-parameter
4084 0 : (frame-selected-window frame) 'no-other-window))
4085 : ;; `delete-window-internal' has selected a window that should
4086 : ;; not be selected, fix this here.
4087 0 : (other-window -1 frame))
4088 0 : (run-window-configuration-change-hook frame)
4089 0 : (window--check frame)
4090 : ;; Always return nil.
4091 0 : nil))))
4092 :
4093 : (defun delete-other-windows (&optional window)
4094 : "Make WINDOW fill its frame.
4095 : WINDOW must be a valid window and defaults to the selected one.
4096 : Return nil.
4097 :
4098 : If the variable `ignore-window-parameters' is non-nil or the
4099 : `delete-other-windows' parameter of WINDOW equals t, do not pay
4100 : attention to any other parameters of WINDOW. Otherwise, if the
4101 : `delete-other-windows' parameter of WINDOW specifies a function,
4102 : call that function with WINDOW as its sole argument and return
4103 : the value returned by that function.
4104 :
4105 : Else, if WINDOW is part of an atomic window, call this function
4106 : with the root of the atomic window as its argument. Signal an
4107 : error if that root window is the root window of WINDOW's frame.
4108 : Also signal an error if WINDOW is a side window. Do not delete
4109 : any window whose `no-delete-other-windows' parameter is non-nil."
4110 : (interactive)
4111 0 : (setq window (window-normalize-window window))
4112 0 : (let* ((frame (window-frame window))
4113 0 : (function (window-parameter window 'delete-other-windows))
4114 : atom-root main)
4115 0 : (window--check frame)
4116 0 : (catch 'done
4117 0 : (cond
4118 : ;; Ignore window parameters if `ignore-window-parameters' is t or
4119 : ;; `delete-other-windows' is t.
4120 0 : ((or ignore-window-parameters (eq function t)))
4121 0 : ((functionp function)
4122 : ;; The `delete-other-windows' parameter specifies the function
4123 : ;; to call. If the function is `ignore' no windows are deleted.
4124 : ;; It's up to the function called to avoid infinite recursion.
4125 0 : (throw 'done (funcall function window)))
4126 0 : ((and (window-parameter window 'window-atom)
4127 0 : (setq atom-root (window-atom-root window))
4128 0 : (not (eq atom-root window)))
4129 0 : (if (eq atom-root (frame-root-window frame))
4130 0 : (error "Root of atomic window is root window of its frame")
4131 0 : (throw 'done (delete-other-windows atom-root))))
4132 0 : ((window-parameter window 'window-side)
4133 0 : (error "Cannot make side window the only window"))
4134 0 : ((and (window-minibuffer-p window)
4135 0 : (not (eq window (frame-root-window window))))
4136 0 : (error "Can't expand minibuffer to full frame")))
4137 :
4138 0 : (cond
4139 0 : ((or ignore-window-parameters
4140 0 : (not (window-with-parameter 'no-delete-other-windows nil frame)))
4141 0 : (setq main (frame-root-window frame)))
4142 0 : ((catch 'tag
4143 0 : (walk-window-tree
4144 : (lambda (other)
4145 0 : (when (or (and (window-parameter other 'window-side)
4146 0 : (not (window-parameter
4147 0 : other 'no-delete-other-windows)))
4148 0 : (and (not (window-parameter other 'window-side))
4149 0 : (window-parameter
4150 0 : other 'no-delete-other-windows)))
4151 0 : (throw 'tag nil))))
4152 0 : t)
4153 0 : (setq main (window-main-window frame)))
4154 : (t
4155 : ;; Delete windows via `delete-window' because we found either a
4156 : ;; deletable side window or a non-deletable non-side-window.
4157 0 : (dolist (other (window-list frame))
4158 0 : (when (and (window-live-p other)
4159 0 : (not (eq other window))
4160 0 : (not (window-parameter
4161 0 : other 'no-delete-other-windows))
4162 : ;; When WINDOW and the other window are part of the
4163 : ;; same atomic window, don't delete the other.
4164 0 : (or (not atom-root)
4165 0 : (not (eq (window-atom-root other) atom-root))))
4166 0 : (condition-case nil
4167 0 : (delete-window other)
4168 0 : (error nil))))
4169 0 : (throw 'done nil)))
4170 :
4171 : ;; If WINDOW is the main window of its frame do nothing.
4172 0 : (unless (eq window main)
4173 0 : (delete-other-windows-internal window main)
4174 0 : (run-window-configuration-change-hook frame)
4175 0 : (window--check frame))
4176 : ;; Always return nil.
4177 0 : nil)))
4178 :
4179 : (defun delete-other-windows-vertically (&optional window)
4180 : "Delete the windows in the same column with WINDOW, but not WINDOW itself.
4181 : This may be a useful alternative binding for \\[delete-other-windows]
4182 : if you often split windows horizontally."
4183 : (interactive)
4184 0 : (let* ((window (or window (selected-window)))
4185 0 : (edges (window-edges window))
4186 0 : (w window) delenda)
4187 0 : (while (not (eq (setq w (next-window w 1)) window))
4188 0 : (let ((e (window-edges w)))
4189 0 : (when (and (= (car e) (car edges))
4190 0 : (= (nth 2 e) (nth 2 edges)))
4191 0 : (push w delenda))))
4192 0 : (mapc 'delete-window delenda)))
4193 :
4194 : ;;; Windows and buffers.
4195 :
4196 : ;; `prev-buffers' and `next-buffers' are two reserved window slots used
4197 : ;; for (1) determining which buffer to show in the window when its
4198 : ;; buffer shall be buried or killed and (2) which buffer to show for
4199 : ;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
4200 :
4201 : ;; `prev-buffers' consists of <buffer, window-start, window-point>
4202 : ;; triples. The entries on this list are ordered by the time their
4203 : ;; buffer has been removed from the window, the most recently removed
4204 : ;; buffer's entry being first. The window-start and window-point
4205 : ;; components are `window-start' and `window-point' at the time the
4206 : ;; buffer was removed from the window which implies that the entry must
4207 : ;; be added when `set-window-buffer' removes the buffer from the window.
4208 :
4209 : ;; `next-buffers' is the list of buffers that have been replaced
4210 : ;; recently by `switch-to-prev-buffer'. These buffers are the least
4211 : ;; preferred candidates of `switch-to-prev-buffer' and the preferred
4212 : ;; candidates of `switch-to-next-buffer' to switch to. This list is
4213 : ;; reset to nil by any action changing the window's buffer with the
4214 : ;; exception of `switch-to-prev-buffer' and `switch-to-next-buffer'.
4215 : ;; `switch-to-prev-buffer' pushes the buffer it just replaced on it,
4216 : ;; `switch-to-next-buffer' pops the last pushed buffer from it.
4217 :
4218 : ;; Both `prev-buffers' and `next-buffers' may reference killed buffers
4219 : ;; if such a buffer was killed while the window was hidden within a
4220 : ;; window configuration. Such killed buffers get removed whenever
4221 : ;; `switch-to-prev-buffer' or `switch-to-next-buffer' encounter them.
4222 :
4223 : ;; The following function is called by `set-window-buffer' _before_ it
4224 : ;; replaces the buffer of the argument window with the new buffer.
4225 : (defun record-window-buffer (&optional window)
4226 : "Record WINDOW's buffer.
4227 : WINDOW must be a live window and defaults to the selected one."
4228 173 : (let* ((window (window-normalize-window window t))
4229 173 : (buffer (window-buffer window))
4230 173 : (entry (assq buffer (window-prev-buffers window))))
4231 : ;; Reset WINDOW's next buffers. If needed, they are resurrected by
4232 : ;; `switch-to-prev-buffer' and `switch-to-next-buffer'.
4233 173 : (set-window-next-buffers window nil)
4234 :
4235 173 : (when entry
4236 : ;; Remove all entries for BUFFER from WINDOW's previous buffers.
4237 8 : (set-window-prev-buffers
4238 173 : window (assq-delete-all buffer (window-prev-buffers window))))
4239 :
4240 : ;; Don't record insignificant buffers.
4241 173 : (unless (eq (aref (buffer-name buffer) 0) ?\s)
4242 : ;; Add an entry for buffer to WINDOW's previous buffers.
4243 163 : (with-current-buffer buffer
4244 163 : (let ((start (window-start window))
4245 163 : (point (window-point window)))
4246 163 : (setq entry
4247 163 : (cons buffer
4248 163 : (if entry
4249 : ;; We have an entry, update marker positions.
4250 8 : (list (set-marker (nth 1 entry) start)
4251 8 : (set-marker (nth 2 entry) point))
4252 : ;; Make new markers.
4253 155 : (list (copy-marker start)
4254 155 : (copy-marker
4255 : ;; Preserve window-point-insertion-type
4256 : ;; (Bug#12588).
4257 163 : point window-point-insertion-type)))))
4258 163 : (set-window-prev-buffers
4259 163 : window (cons entry (window-prev-buffers window)))))
4260 :
4261 173 : (run-hooks 'buffer-list-update-hook))))
4262 :
4263 : (defun unrecord-window-buffer (&optional window buffer)
4264 : "Unrecord BUFFER in WINDOW.
4265 : WINDOW must be a live window and defaults to the selected one.
4266 : BUFFER must be a live buffer and defaults to the buffer of
4267 : WINDOW."
4268 2453 : (let* ((window (window-normalize-window window t))
4269 2453 : (buffer (or buffer (window-buffer window))))
4270 2453 : (set-window-prev-buffers
4271 2453 : window (assq-delete-all buffer (window-prev-buffers window)))
4272 2453 : (set-window-next-buffers
4273 2453 : window (delq buffer (window-next-buffers window)))))
4274 :
4275 : (defun set-window-buffer-start-and-point (window buffer &optional start point)
4276 : "Set WINDOW's buffer to BUFFER.
4277 : WINDOW must be a live window and defaults to the selected one.
4278 : Optional argument START non-nil means set WINDOW's start position
4279 : to START. Optional argument POINT non-nil means set WINDOW's
4280 : point to POINT. If WINDOW is selected this also sets BUFFER's
4281 : `point' to POINT. If WINDOW is selected and the buffer it showed
4282 : before was current this also makes BUFFER the current buffer."
4283 11 : (setq window (window-normalize-window window t))
4284 11 : (let ((selected (eq window (selected-window)))
4285 11 : (current (eq (window-buffer window) (current-buffer))))
4286 11 : (set-window-buffer window buffer)
4287 11 : (when (and selected current)
4288 11 : (set-buffer buffer))
4289 11 : (when start
4290 : ;; Don't force window-start here (even if POINT is nil).
4291 11 : (set-window-start window start t))
4292 11 : (when point
4293 11 : (set-window-point window point))))
4294 :
4295 : (defcustom switch-to-visible-buffer t
4296 : "If non-nil, allow switching to an already visible buffer.
4297 : If this variable is non-nil, `switch-to-prev-buffer' and
4298 : `switch-to-next-buffer' may switch to an already visible buffer.
4299 : If this variable is nil, `switch-to-prev-buffer' and
4300 : `switch-to-next-buffer' always try to avoid switching to a buffer
4301 : that is already visible in another window on the same frame."
4302 : :type 'boolean
4303 : :version "24.1"
4304 : :group 'windows)
4305 :
4306 : (defun switch-to-prev-buffer (&optional window bury-or-kill)
4307 : "In WINDOW switch to previous buffer.
4308 : WINDOW must be a live window and defaults to the selected one.
4309 : Return the buffer switched to, nil if no suitable buffer could be
4310 : found.
4311 :
4312 : Optional argument BURY-OR-KILL non-nil means the buffer currently
4313 : shown in WINDOW is about to be buried or killed and consequently
4314 : shall not be switched to in future invocations of this command.
4315 :
4316 : As a special case, if BURY-OR-KILL equals `append', this means to
4317 : move the buffer to the end of WINDOW's previous buffers list so a
4318 : future invocation of `switch-to-prev-buffer' less likely switches
4319 : to it."
4320 : (interactive)
4321 11 : (let* ((window (window-normalize-window window t))
4322 11 : (frame (window-frame window))
4323 11 : (window-side (window-parameter window 'window-side))
4324 11 : (old-buffer (window-buffer window))
4325 : ;; Save this since it's destroyed by `set-window-buffer'.
4326 11 : (next-buffers (window-next-buffers window))
4327 11 : (pred (frame-parameter frame 'buffer-predicate))
4328 : entry new-buffer killed-buffers visible)
4329 11 : (when (window-minibuffer-p window)
4330 : ;; Don't switch in minibuffer window.
4331 0 : (unless (setq window (minibuffer-selected-window))
4332 11 : (error "Window %s is a minibuffer window" window)))
4333 :
4334 11 : (unless (memq (window-dedicated-p window) '(nil side))
4335 : ;; Don't switch in dedicated window.
4336 11 : (error "Window %s is dedicated to buffer %s" window old-buffer))
4337 :
4338 11 : (catch 'found
4339 : ;; Scan WINDOW's previous buffers first, skipping entries of next
4340 : ;; buffers.
4341 11 : (dolist (entry (window-prev-buffers window))
4342 8 : (when (and (setq new-buffer (car entry))
4343 8 : (or (buffer-live-p new-buffer)
4344 0 : (not (setq killed-buffers
4345 8 : (cons new-buffer killed-buffers))))
4346 8 : (not (eq new-buffer old-buffer))
4347 8 : (or (null pred) (funcall pred new-buffer))
4348 : ;; When BURY-OR-KILL is nil, avoid switching to a
4349 : ;; buffer in WINDOW's next buffers list.
4350 8 : (or bury-or-kill (not (memq new-buffer next-buffers))))
4351 8 : (if (and (not switch-to-visible-buffer)
4352 8 : (get-buffer-window new-buffer frame))
4353 : ;; Try to avoid showing a buffer visible in some other
4354 : ;; window.
4355 0 : (setq visible new-buffer)
4356 8 : (set-window-buffer-start-and-point
4357 8 : window new-buffer (nth 1 entry) (nth 2 entry))
4358 8 : (throw 'found t))))
4359 : ;; Scan reverted buffer list of WINDOW's frame next, skipping
4360 : ;; entries of next buffers. Note that when we bury or kill a
4361 : ;; buffer we don't reverse the global buffer list to avoid showing
4362 : ;; a buried buffer instead. Otherwise, we must reverse the global
4363 : ;; buffer list in order to make sure that switching to the
4364 : ;; previous/next buffer traverse it in opposite directions. Skip
4365 : ;; this step for side windows.
4366 3 : (unless window-side
4367 3 : (dolist (buffer (if bury-or-kill
4368 3 : (buffer-list frame)
4369 3 : (nreverse (buffer-list frame))))
4370 4 : (when (and (buffer-live-p buffer)
4371 4 : (not (eq buffer old-buffer))
4372 3 : (or (null pred) (funcall pred buffer))
4373 3 : (not (eq (aref (buffer-name buffer) 0) ?\s))
4374 : ;; Don't show a buffer shown in a side window before.
4375 3 : (not (buffer-local-value 'window--sides-shown buffer))
4376 4 : (or bury-or-kill (not (memq buffer next-buffers))))
4377 3 : (if (and (not switch-to-visible-buffer)
4378 3 : (get-buffer-window buffer frame))
4379 : ;; Try to avoid showing a buffer visible in some other window.
4380 0 : (unless visible
4381 0 : (setq visible buffer))
4382 3 : (setq new-buffer buffer)
4383 3 : (set-window-buffer-start-and-point window new-buffer)
4384 3 : (throw 'found t)))))
4385 0 : (unless bury-or-kill
4386 : ;; Scan reverted next buffers last (must not use nreverse
4387 : ;; here!).
4388 0 : (dolist (buffer (reverse next-buffers))
4389 : ;; Actually, buffer _must_ be live here since otherwise it
4390 : ;; would have been caught in the scan of previous buffers.
4391 0 : (when (and (or (buffer-live-p buffer)
4392 0 : (not (setq killed-buffers
4393 0 : (cons buffer killed-buffers))))
4394 0 : (not (eq buffer old-buffer))
4395 0 : (or (null pred) (funcall pred buffer))
4396 0 : (setq entry (assq buffer (window-prev-buffers window))))
4397 0 : (setq new-buffer buffer)
4398 0 : (set-window-buffer-start-and-point
4399 0 : window new-buffer (nth 1 entry) (nth 2 entry))
4400 0 : (throw 'found t))))
4401 :
4402 : ;; Show a buffer visible in another window.
4403 0 : (when visible
4404 0 : (setq new-buffer visible)
4405 11 : (set-window-buffer-start-and-point window new-buffer)))
4406 :
4407 11 : (if bury-or-kill
4408 11 : (let ((entry (and (eq bury-or-kill 'append)
4409 11 : (assq old-buffer (window-prev-buffers window)))))
4410 : ;; Remove `old-buffer' from WINDOW's previous and (restored list
4411 : ;; of) next buffers.
4412 11 : (set-window-prev-buffers
4413 11 : window (assq-delete-all old-buffer (window-prev-buffers window)))
4414 11 : (set-window-next-buffers window (delq old-buffer next-buffers))
4415 11 : (when entry
4416 : ;; Append old-buffer's entry to list of WINDOW's previous
4417 : ;; buffers so it's less likely to get switched to soon but
4418 : ;; `display-buffer-in-previous-window' can nevertheless find
4419 : ;; it.
4420 0 : (set-window-prev-buffers
4421 11 : window (append (window-prev-buffers window) (list entry)))))
4422 : ;; Move `old-buffer' to head of WINDOW's restored list of next
4423 : ;; buffers.
4424 0 : (set-window-next-buffers
4425 11 : window (cons old-buffer (delq old-buffer next-buffers))))
4426 :
4427 : ;; Remove killed buffers from WINDOW's previous and next buffers.
4428 11 : (when killed-buffers
4429 0 : (dolist (buffer killed-buffers)
4430 0 : (set-window-prev-buffers
4431 0 : window (assq-delete-all buffer (window-prev-buffers window)))
4432 0 : (set-window-next-buffers
4433 11 : window (delq buffer (window-next-buffers window)))))
4434 :
4435 : ;; Return new-buffer.
4436 11 : new-buffer))
4437 :
4438 : (defun switch-to-next-buffer (&optional window)
4439 : "In WINDOW switch to next buffer.
4440 : WINDOW must be a live window and defaults to the selected one.
4441 : Return the buffer switched to, nil if no suitable buffer could be
4442 : found."
4443 : (interactive)
4444 0 : (let* ((window (window-normalize-window window t))
4445 0 : (frame (window-frame window))
4446 0 : (window-side (window-parameter window 'window-side))
4447 0 : (old-buffer (window-buffer window))
4448 0 : (next-buffers (window-next-buffers window))
4449 0 : (pred (frame-parameter frame 'buffer-predicate))
4450 : new-buffer entry killed-buffers visible)
4451 0 : (when (window-minibuffer-p window)
4452 : ;; Don't switch in minibuffer window.
4453 0 : (unless (setq window (minibuffer-selected-window))
4454 0 : (error "Window %s is a minibuffer window" window)))
4455 :
4456 0 : (unless (memq (window-dedicated-p window) '(nil side))
4457 : ;; Don't switch in dedicated window.
4458 0 : (error "Window %s is dedicated to buffer %s" window old-buffer))
4459 :
4460 0 : (catch 'found
4461 : ;; Scan WINDOW's next buffers first.
4462 0 : (dolist (buffer next-buffers)
4463 0 : (when (and (or (buffer-live-p buffer)
4464 0 : (not (setq killed-buffers
4465 0 : (cons buffer killed-buffers))))
4466 0 : (not (eq buffer old-buffer))
4467 0 : (or (null pred) (funcall pred buffer))
4468 0 : (setq entry (assq buffer (window-prev-buffers window))))
4469 0 : (setq new-buffer buffer)
4470 0 : (set-window-buffer-start-and-point
4471 0 : window new-buffer (nth 1 entry) (nth 2 entry))
4472 0 : (throw 'found t)))
4473 : ;; Scan the buffer list of WINDOW's frame next, skipping previous
4474 : ;; buffers entries. Skip this step for side windows.
4475 0 : (unless window-side
4476 0 : (dolist (buffer (buffer-list frame))
4477 0 : (when (and (buffer-live-p buffer)
4478 0 : (not (eq buffer old-buffer))
4479 0 : (or (null pred) (funcall pred buffer))
4480 0 : (not (eq (aref (buffer-name buffer) 0) ?\s))
4481 : ;; Don't show a buffer shown in a side window before.
4482 0 : (not (buffer-local-value 'window--sides-shown buffer))
4483 0 : (not (assq buffer (window-prev-buffers window))))
4484 0 : (if (and (not switch-to-visible-buffer)
4485 0 : (get-buffer-window buffer frame))
4486 : ;; Try to avoid showing a buffer visible in some other window.
4487 0 : (setq visible buffer)
4488 0 : (setq new-buffer buffer)
4489 0 : (set-window-buffer-start-and-point window new-buffer)
4490 0 : (throw 'found t)))))
4491 : ;; Scan WINDOW's reverted previous buffers last (must not use
4492 : ;; nreverse here!)
4493 0 : (dolist (entry (reverse (window-prev-buffers window)))
4494 0 : (when (and (setq new-buffer (car entry))
4495 0 : (or (buffer-live-p new-buffer)
4496 0 : (not (setq killed-buffers
4497 0 : (cons new-buffer killed-buffers))))
4498 0 : (not (eq new-buffer old-buffer))
4499 0 : (or (null pred) (funcall pred new-buffer)))
4500 0 : (if (and (not switch-to-visible-buffer)
4501 0 : (get-buffer-window new-buffer frame))
4502 : ;; Try to avoid showing a buffer visible in some other window.
4503 0 : (unless visible
4504 0 : (setq visible new-buffer))
4505 0 : (set-window-buffer-start-and-point
4506 0 : window new-buffer (nth 1 entry) (nth 2 entry))
4507 0 : (throw 'found t))))
4508 :
4509 : ;; Show a buffer visible in another window.
4510 0 : (when visible
4511 0 : (setq new-buffer visible)
4512 0 : (set-window-buffer-start-and-point window new-buffer)))
4513 :
4514 : ;; Remove `new-buffer' from and restore WINDOW's next buffers.
4515 0 : (set-window-next-buffers window (delq new-buffer next-buffers))
4516 :
4517 : ;; Remove killed buffers from WINDOW's previous and next buffers.
4518 0 : (when killed-buffers
4519 0 : (dolist (buffer killed-buffers)
4520 0 : (set-window-prev-buffers
4521 0 : window (assq-delete-all buffer (window-prev-buffers window)))
4522 0 : (set-window-next-buffers
4523 0 : window (delq buffer (window-next-buffers window)))))
4524 :
4525 : ;; Return new-buffer.
4526 0 : new-buffer))
4527 :
4528 : (defun get-next-valid-buffer (list &optional buffer visible-ok frame)
4529 : "Search LIST for a valid buffer to display in FRAME.
4530 : Return nil when all buffers in LIST are undesirable for display,
4531 : otherwise return the first suitable buffer in LIST.
4532 :
4533 : Buffers not visible in windows are preferred to visible buffers,
4534 : unless VISIBLE-OK is non-nil.
4535 : If the optional argument FRAME is nil, it defaults to the selected frame.
4536 : If BUFFER is non-nil, ignore occurrences of that buffer in LIST."
4537 : ;; This logic is more or less copied from other-buffer.
4538 0 : (setq frame (or frame (selected-frame)))
4539 0 : (let ((pred (frame-parameter frame 'buffer-predicate))
4540 : found buf)
4541 0 : (while (and (not found) list)
4542 0 : (setq buf (car list))
4543 0 : (if (and (not (eq buffer buf))
4544 0 : (buffer-live-p buf)
4545 0 : (or (null pred) (funcall pred buf))
4546 0 : (not (eq (aref (buffer-name buf) 0) ?\s))
4547 0 : (or visible-ok (null (get-buffer-window buf 'visible))))
4548 0 : (setq found buf)
4549 0 : (setq list (cdr list))))
4550 0 : (car list)))
4551 :
4552 : (defun last-buffer (&optional buffer visible-ok frame)
4553 : "Return the last buffer in FRAME's buffer list.
4554 : If BUFFER is the last buffer, return the preceding buffer
4555 : instead. Buffers not visible in windows are preferred to visible
4556 : buffers, unless optional argument VISIBLE-OK is non-nil.
4557 : Optional third argument FRAME nil or omitted means use the
4558 : selected frame's buffer list. If no such buffer exists, return
4559 : the buffer `*scratch*', creating it if necessary."
4560 0 : (setq frame (or frame (selected-frame)))
4561 0 : (or (get-next-valid-buffer (nreverse (buffer-list frame))
4562 0 : buffer visible-ok frame)
4563 0 : (get-buffer "*scratch*")
4564 0 : (let ((scratch (get-buffer-create "*scratch*")))
4565 0 : (set-buffer-major-mode scratch)
4566 0 : scratch)))
4567 :
4568 : (defcustom frame-auto-hide-function #'iconify-frame
4569 : "Function called to automatically hide frames.
4570 : The function is called with one argument - a frame.
4571 :
4572 : Functions affected by this option are those that bury a buffer
4573 : shown in a separate frame like `quit-window' and `bury-buffer'."
4574 : :type '(choice (const :tag "Iconify" iconify-frame)
4575 : (const :tag "Make invisible" make-frame-invisible)
4576 : (const :tag "Delete" delete-frame)
4577 : (const :tag "Do nothing" ignore)
4578 : function)
4579 : :group 'windows
4580 : :group 'frames
4581 : :version "26.1")
4582 :
4583 : (defun window--delete (&optional window dedicated-only kill)
4584 : "Delete WINDOW if possible.
4585 : WINDOW must be a live window and defaults to the selected one.
4586 : Optional argument DEDICATED-ONLY non-nil means to delete WINDOW
4587 : only if it's dedicated to its buffer. Optional argument KILL
4588 : means the buffer shown in window will be killed. Return non-nil
4589 : if WINDOW gets deleted or its frame is auto-hidden."
4590 11 : (setq window (window-normalize-window window t))
4591 11 : (unless (and dedicated-only (not (window-dedicated-p window)))
4592 0 : (let ((deletable (window-deletable-p window)))
4593 0 : (cond
4594 0 : ((eq deletable 'frame)
4595 0 : (let ((frame (window-frame window)))
4596 0 : (cond
4597 0 : (kill
4598 0 : (delete-frame frame))
4599 0 : ((functionp (frame-parameter frame 'auto-hide-function))
4600 0 : (funcall (frame-parameter frame 'auto-hide-function)))
4601 0 : ((functionp frame-auto-hide-function)
4602 0 : (funcall frame-auto-hide-function frame))))
4603 : 'frame)
4604 0 : (deletable
4605 0 : (delete-window window)
4606 11 : t)))))
4607 :
4608 : (defun bury-buffer (&optional buffer-or-name)
4609 : "Put BUFFER-OR-NAME at the end of the list of all buffers.
4610 : There it is the least likely candidate for `other-buffer' to
4611 : return; thus, the least likely buffer for \\[switch-to-buffer] to
4612 : select by default.
4613 :
4614 : You can specify a buffer name as BUFFER-OR-NAME, or an actual
4615 : buffer object. If BUFFER-OR-NAME is nil or omitted, bury the
4616 : current buffer. Also, if BUFFER-OR-NAME is nil or omitted,
4617 : remove the current buffer from the selected window if it is
4618 : displayed there."
4619 : (interactive)
4620 0 : (let* ((buffer (window-normalize-buffer buffer-or-name)))
4621 : ;; If `buffer-or-name' is not on the selected frame we unrecord it
4622 : ;; although it's not "here" (call it a feature).
4623 0 : (bury-buffer-internal buffer)
4624 : ;; Handle case where `buffer-or-name' is nil and the current buffer
4625 : ;; is shown in the selected window.
4626 0 : (cond
4627 0 : ((or buffer-or-name (not (eq buffer (window-buffer)))))
4628 0 : ((window--delete nil t))
4629 : (t
4630 : ;; Switch to another buffer in window.
4631 0 : (set-window-dedicated-p nil nil)
4632 0 : (switch-to-prev-buffer nil 'bury)))
4633 :
4634 : ;; Always return nil.
4635 0 : nil))
4636 :
4637 : (defun unbury-buffer ()
4638 : "Switch to the last buffer in the buffer list."
4639 : (interactive)
4640 0 : (switch-to-buffer (last-buffer)))
4641 :
4642 : (defun next-buffer ()
4643 : "In selected window switch to next buffer."
4644 : (interactive)
4645 0 : (cond
4646 0 : ((window-minibuffer-p)
4647 0 : (error "Cannot switch buffers in minibuffer window"))
4648 0 : ((eq (window-dedicated-p) t)
4649 0 : (error "Window is strongly dedicated to its buffer"))
4650 : (t
4651 0 : (switch-to-next-buffer))))
4652 :
4653 : (defun previous-buffer ()
4654 : "In selected window switch to previous buffer."
4655 : (interactive)
4656 0 : (cond
4657 0 : ((window-minibuffer-p)
4658 0 : (error "Cannot switch buffers in minibuffer window"))
4659 0 : ((eq (window-dedicated-p) t)
4660 0 : (error "Window is strongly dedicated to its buffer"))
4661 : (t
4662 0 : (switch-to-prev-buffer))))
4663 :
4664 : (defun delete-windows-on (&optional buffer-or-name frame)
4665 : "Delete all windows showing BUFFER-OR-NAME.
4666 : BUFFER-OR-NAME may be a buffer or the name of an existing buffer
4667 : and defaults to the current buffer.
4668 :
4669 : The following non-nil values of the optional argument FRAME
4670 : have special meanings:
4671 :
4672 : - t means consider all windows on the selected frame only.
4673 :
4674 : - `visible' means consider all windows on all visible frames on
4675 : the current terminal.
4676 :
4677 : - 0 (the number zero) means consider all windows on all visible
4678 : and iconified frames on the current terminal.
4679 :
4680 : - A frame means consider all windows on that frame only.
4681 :
4682 : Any other value of FRAME means consider all windows on all
4683 : frames.
4684 :
4685 : When a window showing BUFFER-OR-NAME is dedicated and the only
4686 : window of its frame, that frame is deleted when there are other
4687 : frames left."
4688 : (interactive "BDelete windows on (buffer):\nP")
4689 0 : (let ((buffer (window-normalize-buffer buffer-or-name))
4690 : ;; Handle the "inverted" meaning of the FRAME argument wrt other
4691 : ;; `window-list-1' based function.
4692 0 : (all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
4693 0 : (dolist (window (window-list-1 nil nil all-frames))
4694 0 : (if (eq (window-buffer window) buffer)
4695 0 : (let ((deletable (window-deletable-p window)))
4696 0 : (cond
4697 0 : ((and (eq deletable 'frame) (window-dedicated-p window))
4698 : ;; Delete frame if and only if window is dedicated.
4699 0 : (delete-frame (window-frame window)))
4700 0 : ((eq deletable t)
4701 : ;; Delete window.
4702 0 : (delete-window window))
4703 : (t
4704 : ;; In window switch to previous buffer.
4705 0 : (set-window-dedicated-p window nil)
4706 0 : (switch-to-prev-buffer window 'bury))))
4707 : ;; If a window doesn't show BUFFER, unrecord BUFFER in it.
4708 0 : (unrecord-window-buffer window buffer)))))
4709 :
4710 : (defun replace-buffer-in-windows (&optional buffer-or-name)
4711 : "Replace BUFFER-OR-NAME with some other buffer in all windows showing it.
4712 : BUFFER-OR-NAME may be a buffer or the name of an existing buffer
4713 : and defaults to the current buffer.
4714 :
4715 : When a window showing BUFFER-OR-NAME is dedicated, that window is
4716 : deleted. If that window is the only window on its frame, the
4717 : frame is deleted too when there are other frames left. If there
4718 : are no other frames left, some other buffer is displayed in that
4719 : window.
4720 :
4721 : This function removes the buffer denoted by BUFFER-OR-NAME from
4722 : all window-local buffer lists."
4723 : (interactive "bBuffer to replace: ")
4724 2425 : (let ((buffer (window-normalize-buffer buffer-or-name)))
4725 2425 : (dolist (window (window-list-1 nil nil t))
4726 2464 : (if (eq (window-buffer window) buffer)
4727 11 : (unless (window--delete window t t)
4728 : ;; Switch to another buffer in window.
4729 11 : (set-window-dedicated-p window nil)
4730 11 : (switch-to-prev-buffer window 'kill))
4731 : ;; Unrecord BUFFER in WINDOW.
4732 2464 : (unrecord-window-buffer window buffer)))))
4733 :
4734 : (defun quit-restore-window (&optional window bury-or-kill)
4735 : "Quit WINDOW and deal with its buffer.
4736 : WINDOW must be a live window and defaults to the selected one.
4737 :
4738 : According to information stored in WINDOW's `quit-restore' window
4739 : parameter either (1) delete WINDOW and its frame, (2) delete
4740 : WINDOW, (3) restore the buffer previously displayed in WINDOW,
4741 : or (4) make WINDOW display some other buffer than the present
4742 : one. If non-nil, reset `quit-restore' parameter to nil.
4743 :
4744 : Optional second argument BURY-OR-KILL tells how to proceed with
4745 : the buffer of WINDOW. The following values are handled:
4746 :
4747 : nil means to not handle the buffer in a particular way. This
4748 : means that if WINDOW is not deleted by this function, invoking
4749 : `switch-to-prev-buffer' will usually show the buffer again.
4750 :
4751 : `append' means that if WINDOW is not deleted, move its buffer to
4752 : the end of WINDOW's previous buffers so it's less likely that a
4753 : future invocation of `switch-to-prev-buffer' will switch to it.
4754 : Also, move the buffer to the end of the frame's buffer list.
4755 :
4756 : `bury' means that if WINDOW is not deleted, remove its buffer
4757 : from WINDOW'S list of previous buffers. Also, move the buffer
4758 : to the end of the frame's buffer list. This value provides the
4759 : most reliable remedy to not have `switch-to-prev-buffer' switch
4760 : to this buffer again without killing the buffer.
4761 :
4762 : `kill' means to kill WINDOW's buffer."
4763 0 : (setq window (window-normalize-window window t))
4764 0 : (let* ((buffer (window-buffer window))
4765 0 : (quit-restore (window-parameter window 'quit-restore))
4766 : (prev-buffer
4767 0 : (let* ((prev-buffers (window-prev-buffers window))
4768 0 : (prev-buffer (caar prev-buffers)))
4769 0 : (and (or (not (eq prev-buffer buffer))
4770 0 : (and (cdr prev-buffers)
4771 0 : (not (eq (setq prev-buffer (cadr prev-buffers))
4772 0 : buffer))))
4773 0 : prev-buffer)))
4774 : quad entry)
4775 0 : (cond
4776 0 : ((and (not prev-buffer)
4777 0 : (or (eq (nth 1 quit-restore) 'frame)
4778 0 : (and (eq (nth 1 quit-restore) 'window)
4779 : ;; If the window has been created on an existing
4780 : ;; frame and ended up as the sole window on that
4781 : ;; frame, do not delete it (Bug#12764).
4782 0 : (not (eq window (frame-root-window window)))))
4783 0 : (eq (nth 3 quit-restore) buffer)
4784 : ;; Delete WINDOW if possible.
4785 0 : (window--delete window nil (eq bury-or-kill 'kill)))
4786 : ;; If the previously selected window is still alive, select it.
4787 0 : (when (window-live-p (nth 2 quit-restore))
4788 0 : (select-window (nth 2 quit-restore))))
4789 0 : ((and (listp (setq quad (nth 1 quit-restore)))
4790 0 : (buffer-live-p (car quad))
4791 0 : (eq (nth 3 quit-restore) buffer))
4792 : ;; Show another buffer stored in quit-restore parameter.
4793 0 : (when (and (integerp (nth 3 quad))
4794 0 : (if (window-combined-p window)
4795 0 : (/= (nth 3 quad) (window-total-height window))
4796 0 : (/= (nth 3 quad) (window-total-width window))))
4797 : ;; Try to resize WINDOW to its old height but don't signal an
4798 : ;; error.
4799 0 : (condition-case nil
4800 0 : (window-resize
4801 0 : window
4802 0 : (- (nth 3 quad) (if (window-combined-p window)
4803 0 : (window-total-height window)
4804 0 : (window-total-width window)))
4805 0 : (window-combined-p window t))
4806 0 : (error nil)))
4807 0 : (set-window-dedicated-p window nil)
4808 : ;; Restore WINDOW's previous buffer, start and point position.
4809 0 : (set-window-buffer-start-and-point
4810 0 : window (nth 0 quad) (nth 1 quad) (nth 2 quad))
4811 : ;; Deal with the buffer we just removed from WINDOW.
4812 0 : (setq entry (and (eq bury-or-kill 'append)
4813 0 : (assq buffer (window-prev-buffers window))))
4814 0 : (when bury-or-kill
4815 : ;; Remove buffer from WINDOW's previous and next buffers.
4816 0 : (set-window-prev-buffers
4817 0 : window (assq-delete-all buffer (window-prev-buffers window)))
4818 0 : (set-window-next-buffers
4819 0 : window (delq buffer (window-next-buffers window))))
4820 0 : (when entry
4821 : ;; Append old buffer's entry to list of WINDOW's previous
4822 : ;; buffers so it's less likely to get switched to soon but
4823 : ;; `display-buffer-in-previous-window' can nevertheless find it.
4824 0 : (set-window-prev-buffers
4825 0 : window (append (window-prev-buffers window) (list entry))))
4826 : ;; Reset the quit-restore parameter.
4827 0 : (set-window-parameter window 'quit-restore nil)
4828 : ;; Select old window.
4829 0 : (when (window-live-p (nth 2 quit-restore))
4830 0 : (select-window (nth 2 quit-restore))))
4831 : (t
4832 : ;; Show some other buffer in WINDOW and reset the quit-restore
4833 : ;; parameter.
4834 0 : (set-window-parameter window 'quit-restore nil)
4835 : ;; Make sure that WINDOW is no more dedicated.
4836 0 : (set-window-dedicated-p window nil)
4837 0 : (switch-to-prev-buffer window bury-or-kill)))
4838 :
4839 : ;; Deal with the buffer.
4840 0 : (cond
4841 0 : ((not (buffer-live-p buffer)))
4842 0 : ((eq bury-or-kill 'kill)
4843 0 : (kill-buffer buffer))
4844 0 : (bury-or-kill
4845 0 : (bury-buffer-internal buffer)))))
4846 :
4847 : (defun quit-window (&optional kill window)
4848 : "Quit WINDOW and bury its buffer.
4849 : WINDOW must be a live window and defaults to the selected one.
4850 : With prefix argument KILL non-nil, kill the buffer instead of
4851 : burying it.
4852 :
4853 : According to information stored in WINDOW's `quit-restore' window
4854 : parameter either (1) delete WINDOW and its frame, (2) delete
4855 : WINDOW, (3) restore the buffer previously displayed in WINDOW,
4856 : or (4) make WINDOW display some other buffer than the present
4857 : one. If non-nil, reset `quit-restore' parameter to nil."
4858 : (interactive "P")
4859 0 : (quit-restore-window window (if kill 'kill 'bury)))
4860 :
4861 : (defun quit-windows-on (&optional buffer-or-name kill frame)
4862 : "Quit all windows showing BUFFER-OR-NAME.
4863 : BUFFER-OR-NAME may be a buffer or the name of an existing buffer
4864 : and defaults to the current buffer. Optional argument KILL
4865 : non-nil means to kill BUFFER-OR-NAME. KILL nil means to bury
4866 : BUFFER-OR-NAME. Optional argument FRAME is handled as by
4867 : `delete-windows-on'.
4868 :
4869 : This function calls `quit-window' on all candidate windows
4870 : showing BUFFER-OR-NAME."
4871 : (interactive "BQuit windows on (buffer):\nP")
4872 0 : (let ((buffer (window-normalize-buffer buffer-or-name))
4873 : ;; Handle the "inverted" meaning of the FRAME argument wrt other
4874 : ;; `window-list-1' based function.
4875 0 : (all-frames (cond ((not frame) t) ((eq frame t) nil) (t frame))))
4876 0 : (dolist (window (window-list-1 nil nil all-frames))
4877 0 : (if (eq (window-buffer window) buffer)
4878 0 : (quit-window kill window)
4879 : ;; If a window doesn't show BUFFER, unrecord BUFFER in it.
4880 0 : (unrecord-window-buffer window buffer)))))
4881 :
4882 : (defun split-window (&optional window size side pixelwise)
4883 : "Make a new window adjacent to WINDOW.
4884 : WINDOW must be a valid window and defaults to the selected one.
4885 : Return the new window which is always a live window.
4886 :
4887 : Optional argument SIZE a positive number means make WINDOW SIZE
4888 : lines or columns tall. If SIZE is negative, make the new window
4889 : -SIZE lines or columns tall. If and only if SIZE is non-nil, its
4890 : absolute value can be less than `window-min-height' or
4891 : `window-min-width'; so this command can make a new window as
4892 : small as one line or two columns. SIZE defaults to half of
4893 : WINDOW's size.
4894 :
4895 : Optional third argument SIDE nil (or `below') specifies that the
4896 : new window shall be located below WINDOW. SIDE `above' means the
4897 : new window shall be located above WINDOW. In both cases SIZE
4898 : specifies the new number of lines for WINDOW (or the new window
4899 : if SIZE is negative) including space reserved for the mode and/or
4900 : header line.
4901 :
4902 : SIDE t (or `right') specifies that the new window shall be
4903 : located on the right side of WINDOW. SIDE `left' means the new
4904 : window shall be located on the left of WINDOW. In both cases
4905 : SIZE specifies the new number of columns for WINDOW (or the new
4906 : window provided SIZE is negative) including space reserved for
4907 : fringes and the scrollbar or a divider column. Any other non-nil
4908 : value for SIDE is currently handled like t (or `right').
4909 :
4910 : PIXELWISE, if non-nil, means to interpret SIZE pixelwise.
4911 :
4912 : If the variable `ignore-window-parameters' is non-nil or the
4913 : `split-window' parameter of WINDOW equals t, do not process any
4914 : parameters of WINDOW. Otherwise, if the `split-window' parameter
4915 : of WINDOW specifies a function, call that function with all three
4916 : arguments and return the value returned by that function.
4917 :
4918 : Otherwise, if WINDOW is part of an atomic window, \"split\" the
4919 : root of that atomic window. The new window does not become a
4920 : member of that atomic window.
4921 :
4922 : If WINDOW is live, properties of the new window like margins and
4923 : scrollbars are inherited from WINDOW. If WINDOW is an internal
4924 : window, these properties as well as the buffer displayed in the
4925 : new window are inherited from the window selected on WINDOW's
4926 : frame. The selected window is not changed by this function."
4927 3 : (setq window (window-normalize-window window))
4928 3 : (let* ((side (cond
4929 3 : ((not side) 'below)
4930 0 : ((memq side '(below above right left)) side)
4931 3 : (t 'right)))
4932 3 : (horizontal (not (memq side '(below above))))
4933 3 : (frame (window-frame window))
4934 3 : (parent (window-parent window))
4935 3 : (function (window-parameter window 'split-window))
4936 3 : (window-side (window-parameter window 'window-side))
4937 : ;; Rebind the following two variables since in some cases we
4938 : ;; have to override their value.
4939 3 : (window-combination-limit window-combination-limit)
4940 3 : (window-combination-resize window-combination-resize)
4941 3 : (char-size (frame-char-size window horizontal))
4942 : (pixel-size
4943 3 : (when (numberp size)
4944 3 : (window--size-to-pixel window size horizontal pixelwise t)))
4945 3 : (divider-width (if horizontal
4946 0 : (frame-right-divider-width frame)
4947 3 : (frame-bottom-divider-width frame)))
4948 : atom-root ignore)
4949 3 : (window--check frame)
4950 3 : (catch 'done
4951 3 : (cond
4952 : ;; Ignore window parameters if either `ignore-window-parameters'
4953 : ;; is t or the `split-window' parameter equals t.
4954 3 : ((or ignore-window-parameters (eq function t)))
4955 3 : ((functionp function)
4956 : ;; The `split-window' parameter specifies the function to call.
4957 : ;; If that function is `ignore', do nothing.
4958 0 : (throw 'done (funcall function window size side)))
4959 : ;; If WINDOW is part of an atomic window, split the root window
4960 : ;; of that atomic window instead.
4961 3 : ((and (window-parameter window 'window-atom)
4962 0 : (setq atom-root (window-atom-root window))
4963 3 : (not (eq atom-root window)))
4964 0 : (throw 'done (split-window atom-root size side pixelwise)))
4965 : ;; If WINDOW is a side window or its first or last child is a
4966 : ;; side window, throw an error unless `window-combination-resize'
4967 : ;; equals 'side.
4968 3 : ((and (not (eq window-combination-resize 'side))
4969 3 : (window-parameter window 'window-side))
4970 0 : (error "Cannot split side window or parent of side window"))
4971 : ;; If `window-combination-resize' is 'side and window has a side
4972 : ;; window sibling, bind `window-combination-limit' to t.
4973 3 : ((and (not (eq window-combination-resize 'side))
4974 3 : (or (and (window-prev-sibling window)
4975 0 : (window-parameter
4976 3 : (window-prev-sibling window) 'window-side))
4977 3 : (and (window-next-sibling window)
4978 3 : (window-parameter
4979 3 : (window-next-sibling window) 'window-side))))
4980 3 : (setq window-combination-limit t)))
4981 :
4982 : ;; If `window-combination-resize' is t and SIZE is non-negative,
4983 : ;; bind `window-combination-limit' to t.
4984 3 : (when (and (eq window-combination-resize t)
4985 3 : pixel-size (> pixel-size 0))
4986 3 : (setq window-combination-limit t))
4987 :
4988 3 : (let* ((parent-pixel-size
4989 : ;; `parent-pixel-size' is the pixel size of WINDOW's
4990 : ;; parent, provided it has one.
4991 3 : (when parent (window-size parent horizontal t)))
4992 : ;; `resize' non-nil means we are supposed to resize other
4993 : ;; windows in WINDOW's combination.
4994 : (resize
4995 3 : (and window-combination-resize
4996 0 : (or (window-parameter window 'window-side)
4997 0 : (not (eq window-combination-resize 'side)))
4998 0 : (not (eq window-combination-limit t))
4999 : ;; Resize makes sense in iso-combinations only.
5000 3 : (window-combined-p window horizontal)))
5001 : ;; `old-pixel-size' is the current pixel size of WINDOW.
5002 3 : (old-pixel-size (window-size window horizontal t))
5003 : ;; `new-size' is the specified or calculated size of the
5004 : ;; new window.
5005 : new-pixel-size new-parent new-normal)
5006 3 : (cond
5007 3 : ((not pixel-size)
5008 3 : (setq new-pixel-size
5009 3 : (if resize
5010 : ;; When resizing try to give the new window the
5011 : ;; average size of a window in its combination.
5012 0 : (max (min (- parent-pixel-size
5013 0 : (window-min-size parent horizontal nil t))
5014 0 : (/ parent-pixel-size
5015 0 : (1+ (window-combinations parent horizontal))))
5016 0 : (window-min-pixel-size))
5017 : ;; Else try to give the new window half the size
5018 : ;; of WINDOW (plus an eventual odd pixel).
5019 3 : (/ old-pixel-size 2)))
5020 3 : (unless window-resize-pixelwise
5021 : ;; Round to nearest char-size multiple.
5022 3 : (setq new-pixel-size
5023 3 : (* char-size (round new-pixel-size char-size)))))
5024 0 : ((>= pixel-size 0)
5025 : ;; SIZE non-negative specifies the new size of WINDOW.
5026 :
5027 : ;; Note: Specifying a non-negative SIZE is practically
5028 : ;; always done as workaround for making the new window
5029 : ;; appear above or on the left of the new window (the
5030 : ;; ispell window is a typical example of that). In all
5031 : ;; these cases the SIDE argument should be set to 'above
5032 : ;; or 'left in order to support the 'resize option.
5033 : ;; Here we have to nest the windows instead, see above.
5034 0 : (setq new-pixel-size (- old-pixel-size pixel-size)))
5035 : (t
5036 : ;; SIZE negative specifies the size of the new window.
5037 3 : (setq new-pixel-size (- pixel-size))))
5038 :
5039 : ;; Check SIZE.
5040 3 : (cond
5041 3 : ((not pixel-size)
5042 3 : (cond
5043 3 : (resize
5044 : ;; SIZE unspecified, resizing.
5045 0 : (unless (or (window-sizable-p
5046 0 : parent (- (+ new-pixel-size divider-width)) horizontal
5047 0 : nil t)
5048 0 : (window-sizable-p
5049 0 : parent (- (+ new-pixel-size divider-width)) horizontal
5050 0 : (setq ignore 'preserved) t))
5051 0 : (error "Window %s too small for splitting" parent)))
5052 3 : ((and (> (+ new-pixel-size divider-width
5053 3 : (window-min-size window horizontal nil t))
5054 3 : old-pixel-size)
5055 0 : (> (+ new-pixel-size divider-width
5056 0 : (window-min-size
5057 0 : window horizontal (setq ignore 'preserved) t))
5058 3 : old-pixel-size))
5059 : ;; SIZE unspecified, no resizing.
5060 3 : (error "Window %s too small for splitting" window))))
5061 0 : ((and (>= pixel-size 0)
5062 0 : (or (>= pixel-size old-pixel-size)
5063 0 : (< new-pixel-size
5064 0 : (window-safe-min-pixel-size window horizontal))))
5065 : ;; SIZE specified as new size of old window. If the new size
5066 : ;; is larger than the old size or the size of the new window
5067 : ;; would be less than the safe minimum, signal an error.
5068 0 : (error "Window %s too small for splitting" window))
5069 0 : (resize
5070 : ;; SIZE specified, resizing.
5071 0 : (unless (or (window-sizable-p
5072 0 : parent (- (+ new-pixel-size divider-width)) horizontal
5073 0 : nil t)
5074 0 : (window-sizable-p
5075 0 : parent (- (+ new-pixel-size divider-width)) horizontal
5076 0 : (setq ignore 'preserved) t))
5077 : ;; If we cannot resize the parent give up.
5078 0 : (error "Window %s too small for splitting" parent)))
5079 0 : ((or (< new-pixel-size
5080 0 : (window-safe-min-pixel-size window horizontal))
5081 0 : (< (- old-pixel-size new-pixel-size)
5082 0 : (window-safe-min-pixel-size window horizontal)))
5083 : ;; SIZE specification violates minimum size restrictions.
5084 3 : (error "Window %s too small for splitting" window)))
5085 :
5086 3 : (window--resize-reset frame horizontal)
5087 :
5088 3 : (setq new-parent
5089 : ;; Make new-parent non-nil if we need a new parent window;
5090 : ;; either because we want to nest or because WINDOW is not
5091 : ;; iso-combined.
5092 3 : (or (eq window-combination-limit t)
5093 3 : (not (window-combined-p window horizontal))))
5094 3 : (setq new-normal
5095 : ;; Make new-normal the normal size of the new window.
5096 3 : (cond
5097 3 : (pixel-size (/ (float new-pixel-size)
5098 0 : (if new-parent old-pixel-size parent-pixel-size)))
5099 3 : (new-parent 0.5)
5100 0 : (resize (/ 1.0 (1+ (window-combinations parent horizontal))))
5101 3 : (t (/ (window-normal-size window horizontal) 2.0))))
5102 :
5103 3 : (if resize
5104 : ;; Try to get space from OLD's siblings. We could go "up" and
5105 : ;; try getting additional space from surrounding windows but
5106 : ;; we won't be able to return space to those windows when we
5107 : ;; delete the one we create here. Hence we do not go up.
5108 0 : (progn
5109 0 : (window--resize-child-windows
5110 0 : parent (- new-pixel-size) horizontal nil ignore)
5111 0 : (let* ((normal (- 1.0 new-normal))
5112 0 : (sub (window-child parent)))
5113 0 : (while sub
5114 0 : (set-window-new-normal
5115 0 : sub (* (window-normal-size sub horizontal) normal))
5116 0 : (setq sub (window-right sub)))))
5117 : ;; Get entire space from WINDOW.
5118 3 : (set-window-new-pixel
5119 3 : window (- old-pixel-size new-pixel-size))
5120 3 : (window--resize-this-window
5121 3 : window (- new-pixel-size) horizontal ignore)
5122 3 : (set-window-new-normal
5123 3 : window (- (if new-parent 1.0 (window-normal-size window horizontal))
5124 3 : new-normal)))
5125 :
5126 3 : (let* ((new (split-window-internal window new-pixel-size side new-normal)))
5127 3 : (window--pixel-to-total frame horizontal)
5128 : ;; Assign window-side parameters, if any.
5129 3 : (cond
5130 3 : ((eq window-combination-resize 'side)
5131 0 : (let ((window-side
5132 0 : (cond
5133 0 : (window-side window-side)
5134 0 : ((eq side 'above) 'top)
5135 0 : ((eq side 'below) 'bottom)
5136 0 : (t side))))
5137 : ;; We made a new side window.
5138 0 : (set-window-parameter new 'window-side window-side)
5139 0 : (when (and new-parent (window-parameter window 'window-side))
5140 : ;; We've been splitting a side root window. Give the
5141 : ;; new parent the same window-side parameter.
5142 0 : (set-window-parameter
5143 0 : (window-parent new) 'window-side window-side))))
5144 3 : ((eq window-combination-resize 'atom)
5145 : ;; Make sure `window--check-frame' won't destroy an existing
5146 : ;; atomic window in case the new window gets nested inside.
5147 0 : (unless (window-parameter window 'window-atom)
5148 0 : (set-window-parameter window 'window-atom t))
5149 0 : (when new-parent
5150 0 : (set-window-parameter (window-parent new) 'window-atom t))
5151 3 : (set-window-parameter new 'window-atom t)))
5152 :
5153 : ;; Sanitize sizes unless SIZE was specified.
5154 3 : (unless size
5155 3 : (window--sanitize-window-sizes horizontal))
5156 :
5157 3 : (run-window-configuration-change-hook frame)
5158 3 : (run-window-scroll-functions new)
5159 3 : (window--check frame)
5160 : ;; Always return the new window.
5161 3 : new)))))
5162 :
5163 : (defun split-window-no-error (&optional window size side pixelwise)
5164 : "Make a new window adjacent to WINDOW.
5165 : This function is like `split-window' but does not signal an error
5166 : when WINDOW cannot be split.
5167 :
5168 : For the meaning of all arguments see the documentation of
5169 : `split-window'."
5170 0 : (condition-case nil
5171 0 : (split-window window size side pixelwise)
5172 0 : (error nil)))
5173 :
5174 : ;; I think this should be the default; I think people will prefer it--rms.
5175 : (defcustom split-window-keep-point t
5176 : "If non-nil, \\[split-window-below] preserves point in the new window.
5177 : If nil, adjust point in the two windows to minimize redisplay.
5178 : This option applies only to `split-window-below' and functions
5179 : that call it. The low-level `split-window' function always keeps
5180 : the original point in both windows."
5181 : :type 'boolean
5182 : :group 'windows)
5183 :
5184 : (defun split-window-below (&optional size)
5185 : "Split the selected window into two windows, one above the other.
5186 : The selected window is above. The newly split-off window is
5187 : below and displays the same buffer. Return the new window.
5188 :
5189 : If optional argument SIZE is omitted or nil, both windows get the
5190 : same height, or close to it. If SIZE is positive, the upper
5191 : \(selected) window gets SIZE lines. If SIZE is negative, the
5192 : lower (new) window gets -SIZE lines.
5193 :
5194 : If the variable `split-window-keep-point' is non-nil, both
5195 : windows get the same value of point as the selected window.
5196 : Otherwise, the window starts are chosen so as to minimize the
5197 : amount of redisplay; this is convenient on slow terminals."
5198 : (interactive "P")
5199 3 : (let ((old-window (selected-window))
5200 3 : (old-point (window-point))
5201 3 : (size (and size (prefix-numeric-value size)))
5202 : moved-by-window-height moved new-window bottom)
5203 3 : (when (and size (< size 0) (< (- size) window-min-height))
5204 : ;; `split-window' would not signal an error here.
5205 3 : (error "Size of new window too small"))
5206 3 : (setq new-window (split-window nil size))
5207 3 : (unless split-window-keep-point
5208 0 : (with-current-buffer (window-buffer)
5209 : ;; Use `save-excursion' around vertical movements below
5210 : ;; (Bug#10971). Note: When the selected window's buffer has a
5211 : ;; header line, up to two lines of the buffer may not show up
5212 : ;; in the resulting configuration.
5213 0 : (save-excursion
5214 0 : (goto-char (window-start))
5215 0 : (setq moved (vertical-motion (window-height)))
5216 0 : (set-window-start new-window (point))
5217 0 : (when (> (point) (window-point new-window))
5218 0 : (set-window-point new-window (point)))
5219 0 : (when (= moved (window-height))
5220 0 : (setq moved-by-window-height t)
5221 0 : (vertical-motion -1))
5222 0 : (setq bottom (point)))
5223 0 : (and moved-by-window-height
5224 0 : (<= bottom (point))
5225 0 : (set-window-point old-window (1- bottom)))
5226 0 : (and moved-by-window-height
5227 0 : (<= (window-start new-window) old-point)
5228 0 : (set-window-point new-window old-point)
5229 3 : (select-window new-window))))
5230 : ;; Always copy quit-restore parameter in interactive use.
5231 3 : (let ((quit-restore (window-parameter old-window 'quit-restore)))
5232 3 : (when quit-restore
5233 3 : (set-window-parameter new-window 'quit-restore quit-restore)))
5234 3 : new-window))
5235 :
5236 : (defalias 'split-window-vertically 'split-window-below)
5237 :
5238 : (defun split-window-right (&optional size)
5239 : "Split the selected window into two side-by-side windows.
5240 : The selected window is on the left. The newly split-off window
5241 : is on the right and displays the same buffer. Return the new
5242 : window.
5243 :
5244 : If optional argument SIZE is omitted or nil, both windows get the
5245 : same width, or close to it. If SIZE is positive, the left-hand
5246 : \(selected) window gets SIZE columns. If SIZE is negative, the
5247 : right-hand (new) window gets -SIZE columns. Here, SIZE includes
5248 : the width of the window's scroll bar; if there are no scroll
5249 : bars, it includes the width of the divider column to the window's
5250 : right, if any."
5251 : (interactive "P")
5252 0 : (let ((old-window (selected-window))
5253 0 : (size (and size (prefix-numeric-value size)))
5254 : new-window)
5255 0 : (when (and size (< size 0) (< (- size) window-min-width))
5256 : ;; `split-window' would not signal an error here.
5257 0 : (error "Size of new window too small"))
5258 0 : (setq new-window (split-window nil size t))
5259 : ;; Always copy quit-restore parameter in interactive use.
5260 0 : (let ((quit-restore (window-parameter old-window 'quit-restore)))
5261 0 : (when quit-restore
5262 0 : (set-window-parameter new-window 'quit-restore quit-restore)))
5263 0 : new-window))
5264 :
5265 : (defalias 'split-window-horizontally 'split-window-right)
5266 :
5267 : ;;; Balancing windows.
5268 :
5269 : ;; The following routine uses the recycled code from an old version of
5270 : ;; `window--resize-child-windows'. It's not very pretty, but coding it the way the
5271 : ;; new `window--resize-child-windows' code does would hardly make it any shorter or
5272 : ;; more readable (FWIW we'd need three loops - one to calculate the
5273 : ;; minimum sizes per window, one to enlarge or shrink windows until the
5274 : ;; new parent-size matches, and one where we shrink the largest/enlarge
5275 : ;; the smallest window).
5276 : (defun balance-windows-2 (window horizontal)
5277 : "Subroutine of `balance-windows-1'.
5278 : WINDOW must be a vertical combination (horizontal if HORIZONTAL
5279 : is non-nil)."
5280 0 : (let* ((char-size (if window-resize-pixelwise
5281 : 1
5282 0 : (frame-char-size window horizontal)))
5283 0 : (first (window-child window))
5284 0 : (sub first)
5285 : (number-of-children 0)
5286 0 : (parent-size (window-new-pixel window))
5287 0 : (total-sum parent-size)
5288 : failed size sub-total sub-delta sub-amount rest)
5289 0 : (while sub
5290 0 : (setq number-of-children (1+ number-of-children))
5291 0 : (when (window-size-fixed-p sub horizontal)
5292 0 : (setq total-sum
5293 0 : (- total-sum (window-size sub horizontal t)))
5294 0 : (set-window-new-normal sub 'ignore))
5295 0 : (setq sub (window-right sub)))
5296 :
5297 0 : (setq failed t)
5298 0 : (while (and failed (> number-of-children 0))
5299 0 : (setq size (/ total-sum number-of-children))
5300 0 : (setq failed nil)
5301 0 : (setq sub first)
5302 0 : (while (and sub (not failed))
5303 : ;; Ignore child windows that should be ignored or are stuck.
5304 0 : (unless (window--resize-child-windows-skip-p sub)
5305 0 : (setq sub-total (window-size sub horizontal t))
5306 0 : (setq sub-delta (- size sub-total))
5307 0 : (setq sub-amount
5308 0 : (window-sizable sub sub-delta horizontal nil t))
5309 : ;; Register the new total size for this child window.
5310 0 : (set-window-new-pixel sub (+ sub-total sub-amount))
5311 0 : (unless (= sub-amount sub-delta)
5312 0 : (setq total-sum (- total-sum sub-total sub-amount))
5313 0 : (setq number-of-children (1- number-of-children))
5314 : ;; We failed and need a new round.
5315 0 : (setq failed t)
5316 0 : (set-window-new-normal sub 'skip)))
5317 0 : (setq sub (window-right sub))))
5318 :
5319 : ;; How can we be sure that `number-of-children' is NOT zero here ?
5320 0 : (setq rest (% total-sum number-of-children))
5321 : ;; Fix rounding by trying to enlarge non-stuck windows by one line
5322 : ;; (column) until `rest' is zero.
5323 0 : (setq sub first)
5324 0 : (while (and sub (> rest 0))
5325 0 : (unless (window--resize-child-windows-skip-p window)
5326 0 : (set-window-new-pixel sub (min rest char-size) t)
5327 0 : (setq rest (- rest char-size)))
5328 0 : (setq sub (window-right sub)))
5329 :
5330 : ;; Fix rounding by trying to enlarge stuck windows by one line
5331 : ;; (column) until `rest' equals zero.
5332 0 : (setq sub first)
5333 0 : (while (and sub (> rest 0))
5334 0 : (unless (eq (window-new-normal sub) 'ignore)
5335 0 : (set-window-new-pixel sub (min rest char-size) t)
5336 0 : (setq rest (- rest char-size)))
5337 0 : (setq sub (window-right sub)))
5338 :
5339 0 : (setq sub first)
5340 0 : (while sub
5341 : ;; Record new normal sizes.
5342 0 : (set-window-new-normal
5343 0 : sub (/ (if (eq (window-new-normal sub) 'ignore)
5344 0 : (window-size sub horizontal t)
5345 0 : (window-new-pixel sub))
5346 0 : (float parent-size)))
5347 : ;; Recursively balance each window's child windows.
5348 0 : (balance-windows-1 sub horizontal)
5349 0 : (setq sub (window-right sub)))))
5350 :
5351 : (defun balance-windows-1 (window &optional horizontal)
5352 : "Subroutine of `balance-windows'."
5353 0 : (if (window-child window)
5354 0 : (let ((sub (window-child window)))
5355 0 : (if (window-combined-p sub horizontal)
5356 0 : (balance-windows-2 window horizontal)
5357 0 : (let ((size (window-new-pixel window)))
5358 0 : (while sub
5359 0 : (set-window-new-pixel sub size)
5360 0 : (balance-windows-1 sub horizontal)
5361 0 : (setq sub (window-right sub))))))))
5362 :
5363 : (defun balance-windows (&optional window-or-frame)
5364 : "Balance the sizes of windows of WINDOW-OR-FRAME.
5365 : WINDOW-OR-FRAME is optional and defaults to the selected frame.
5366 : If WINDOW-OR-FRAME denotes a frame, balance the sizes of all
5367 : windows of that frame. If WINDOW-OR-FRAME denotes a window,
5368 : recursively balance the sizes of all child windows of that
5369 : window."
5370 : (interactive)
5371 0 : (let* ((window
5372 0 : (cond
5373 0 : ((or (not window-or-frame)
5374 0 : (frame-live-p window-or-frame))
5375 0 : (frame-root-window window-or-frame))
5376 0 : ((or (window-live-p window-or-frame)
5377 0 : (window-child window-or-frame))
5378 0 : window-or-frame)
5379 : (t
5380 0 : (error "Not a window or frame %s" window-or-frame))))
5381 0 : (frame (window-frame window)))
5382 : ;; Balance vertically.
5383 0 : (window--resize-reset (window-frame window))
5384 0 : (balance-windows-1 window)
5385 0 : (when (window--resize-apply-p frame)
5386 0 : (window-resize-apply frame)
5387 0 : (window--pixel-to-total frame)
5388 0 : (run-window-configuration-change-hook frame))
5389 : ;; Balance horizontally.
5390 0 : (window--resize-reset (window-frame window) t)
5391 0 : (balance-windows-1 window t)
5392 0 : (when (window--resize-apply-p frame t)
5393 0 : (window-resize-apply frame t)
5394 0 : (window--pixel-to-total frame t)
5395 0 : (run-window-configuration-change-hook frame))))
5396 :
5397 : (defun window-fixed-size-p (&optional window direction)
5398 : "Return t if WINDOW cannot be resized in DIRECTION.
5399 : WINDOW defaults to the selected window. DIRECTION can be
5400 : nil (i.e. any), `height' or `width'."
5401 0 : (with-current-buffer (window-buffer window)
5402 0 : (when (and (boundp 'window-size-fixed) window-size-fixed)
5403 0 : (not (and direction
5404 0 : (member (cons direction window-size-fixed)
5405 0 : '((height . width) (width . height))))))))
5406 :
5407 : ;;; A different solution to balance-windows.
5408 : (defvar window-area-factor 1
5409 : "Factor by which the window area should be over-estimated.
5410 : This is used by `balance-windows-area'.
5411 : Changing this globally has no effect.")
5412 : (make-variable-buffer-local 'window-area-factor)
5413 :
5414 : (defun balance-windows-area-adjust (window delta horizontal pixelwise)
5415 : "Wrapper around `window-resize' with error checking.
5416 : Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
5417 : ;; `window-resize' may fail if delta is too large.
5418 0 : (while (>= (abs delta) 1)
5419 0 : (condition-case nil
5420 0 : (progn
5421 : ;; It was wrong to use `window-resize' here. Somehow
5422 : ;; `balance-windows-area' depends on resizing windows
5423 : ;; asymmetrically.
5424 0 : (adjust-window-trailing-edge window delta horizontal pixelwise)
5425 0 : (setq delta 0))
5426 : (error
5427 : ;;(message "adjust: %s" (error-message-string err))
5428 0 : (setq delta (/ delta 2))))))
5429 :
5430 : (defun balance-windows-area ()
5431 : "Make all visible windows the same area (approximately).
5432 : See also `window-area-factor' to change the relative size of
5433 : specific buffers."
5434 : (interactive)
5435 0 : (let* ((unchanged 0) (carry 0) (round 0)
5436 : ;; Remove fixed-size windows.
5437 0 : (wins (delq nil (mapcar (lambda (win)
5438 0 : (if (not (window-fixed-size-p win)) win))
5439 0 : (window-list nil 'nomini))))
5440 : (changelog nil)
5441 0 : (pixelwise window-resize-pixelwise)
5442 : next)
5443 : ;; Resizing a window changes the size of surrounding windows in complex
5444 : ;; ways, so it's difficult to balance them all. The introduction of
5445 : ;; `adjust-window-trailing-edge' made it a bit easier, but it is still
5446 : ;; very difficult to do. `balance-window' above takes an off-line
5447 : ;; approach: get the whole window tree, then balance it, then try to
5448 : ;; adjust the windows so they fit the result.
5449 : ;; Here, instead, we take a "local optimization" approach, where we just
5450 : ;; go through all the windows several times until nothing needs to be
5451 : ;; changed. The main problem with this approach is that it's difficult
5452 : ;; to make sure it terminates, so we use some heuristic to try and break
5453 : ;; off infinite loops.
5454 : ;; After a round without any change, we allow a second, to give a chance
5455 : ;; to the carry to propagate a minor imbalance from the end back to
5456 : ;; the beginning.
5457 0 : (while (< unchanged 2)
5458 : ;; (message "New round")
5459 0 : (setq unchanged (1+ unchanged) round (1+ round))
5460 0 : (dolist (win wins)
5461 0 : (setq next win)
5462 0 : (while (progn (setq next (next-window next))
5463 0 : (window-fixed-size-p next)))
5464 : ;; (assert (eq next (or (cadr (member win wins)) (car wins))))
5465 0 : (let* ((horiz
5466 0 : (< (car (window-pixel-edges win)) (car (window-pixel-edges next))))
5467 0 : (areadiff (/ (- (* (window-size next nil pixelwise)
5468 0 : (window-size next t pixelwise)
5469 0 : (buffer-local-value 'window-area-factor
5470 0 : (window-buffer next)))
5471 0 : (* (window-size win nil pixelwise)
5472 0 : (window-size win t pixelwise)
5473 0 : (buffer-local-value 'window-area-factor
5474 0 : (window-buffer win))))
5475 0 : (max (buffer-local-value 'window-area-factor
5476 0 : (window-buffer win))
5477 0 : (buffer-local-value 'window-area-factor
5478 0 : (window-buffer next)))))
5479 0 : (edgesize (if horiz
5480 0 : (+ (window-size win nil pixelwise)
5481 0 : (window-size next nil pixelwise))
5482 0 : (+ (window-size win t pixelwise)
5483 0 : (window-size next t pixelwise))))
5484 0 : (diff (/ areadiff edgesize)))
5485 0 : (when (zerop diff)
5486 : ;; Maybe diff is actually closer to 1 than to 0.
5487 0 : (setq diff (/ (* 3 areadiff) (* 2 edgesize))))
5488 0 : (when (and (zerop diff) (not (zerop areadiff)))
5489 0 : (setq diff (/ (+ areadiff carry) edgesize))
5490 : ;; Change things smoothly.
5491 0 : (if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
5492 0 : (if (zerop diff)
5493 : ;; Make sure negligible differences don't accumulate to
5494 : ;; become significant.
5495 0 : (setq carry (+ carry areadiff))
5496 : ;; This used `adjust-window-trailing-edge' before and uses
5497 : ;; `window-resize' now. Error wrapping is still needed.
5498 0 : (balance-windows-area-adjust win diff horiz pixelwise)
5499 : ;; (sit-for 0.5)
5500 0 : (let ((change (cons win (window-pixel-edges win))))
5501 : ;; If the same change has been seen already for this window,
5502 : ;; we're most likely in an endless loop, so don't count it as
5503 : ;; a change.
5504 0 : (unless (member change changelog)
5505 0 : (push change changelog)
5506 0 : (setq unchanged 0 carry 0)))))))
5507 : ;; We've now basically balanced all the windows.
5508 : ;; But there may be some minor off-by-one imbalance left over,
5509 : ;; so let's do some fine tuning.
5510 : ;; (bw-finetune wins)
5511 : ;; (message "Done in %d rounds" round)
5512 0 : ))
5513 :
5514 : ;;; Window states, how to get them and how to put them in a window.
5515 : (defun window--state-get-1 (window &optional writable)
5516 : "Helper function for `window-state-get'."
5517 0 : (let* ((type
5518 0 : (cond
5519 0 : ((window-top-child window) 'vc)
5520 0 : ((window-left-child window) 'hc)
5521 0 : (t 'leaf)))
5522 0 : (buffer (window-buffer window))
5523 0 : (selected (eq window (selected-window)))
5524 : (head
5525 0 : `(,type
5526 0 : ,@(unless (window-next-sibling window) `((last . t)))
5527 0 : (pixel-width . ,(window-pixel-width window))
5528 0 : (pixel-height . ,(window-pixel-height window))
5529 0 : (total-width . ,(window-total-width window))
5530 0 : (total-height . ,(window-total-height window))
5531 0 : (normal-height . ,(window-normal-size window))
5532 0 : (normal-width . ,(window-normal-size window t))
5533 0 : ,@(unless (window-live-p window)
5534 0 : `((combination-limit . ,(window-combination-limit window))))
5535 0 : ,@(let ((parameters (window-parameters window))
5536 : list)
5537 : ;; Make copies of those window parameters whose
5538 : ;; persistence property is `writable' if WRITABLE is
5539 : ;; non-nil and non-nil if WRITABLE is nil.
5540 0 : (dolist (par parameters)
5541 0 : (let ((pers (cdr (assq (car par)
5542 0 : window-persistent-parameters))))
5543 0 : (when (and pers (or (not writable) (eq pers 'writable)))
5544 0 : (setq list (cons (cons (car par) (cdr par)) list)))))
5545 : ;; Add `clone-of' parameter if necessary.
5546 0 : (let ((pers (cdr (assq 'clone-of
5547 0 : window-persistent-parameters))))
5548 0 : (when (and pers (or (not writable) (eq pers 'writable))
5549 0 : (not (assq 'clone-of list)))
5550 0 : (setq list (cons (cons 'clone-of window) list))))
5551 0 : (when list
5552 0 : `((parameters . ,list))))
5553 0 : ,@(when buffer
5554 : ;; All buffer related things go in here.
5555 0 : (let ((point (window-point window))
5556 0 : (start (window-start window)))
5557 0 : `((buffer
5558 0 : ,(buffer-name buffer)
5559 0 : (selected . ,selected)
5560 0 : (hscroll . ,(window-hscroll window))
5561 0 : (fringes . ,(window-fringes window))
5562 0 : (margins . ,(window-margins window))
5563 0 : (scroll-bars . ,(window-scroll-bars window))
5564 0 : (vscroll . ,(window-vscroll window))
5565 0 : (dedicated . ,(window-dedicated-p window))
5566 0 : (point . ,(if writable
5567 0 : point
5568 0 : (with-current-buffer buffer
5569 0 : (copy-marker point
5570 0 : (buffer-local-value
5571 : 'window-point-insertion-type
5572 0 : buffer)))))
5573 0 : (start . ,(if writable
5574 0 : start
5575 0 : (with-current-buffer buffer
5576 0 : (copy-marker start))))))))))
5577 : (tail
5578 0 : (when (memq type '(vc hc))
5579 0 : (let (list)
5580 0 : (setq window (window-child window))
5581 0 : (while window
5582 0 : (setq list (cons (window--state-get-1 window writable) list))
5583 0 : (setq window (window-right window)))
5584 0 : (nreverse list)))))
5585 0 : (append head tail)))
5586 :
5587 : (defun window-state-get (&optional window writable)
5588 : "Return state of WINDOW as a Lisp object.
5589 : WINDOW can be any window and defaults to the root window of the
5590 : selected frame.
5591 :
5592 : Optional argument WRITABLE non-nil means do not use markers for
5593 : sampling `window-point' and `window-start'. Together, WRITABLE
5594 : and the variable `window-persistent-parameters' specify which
5595 : window parameters are saved by this function. WRITABLE should be
5596 : non-nil when the return value shall be written to a file and read
5597 : back in another session. Otherwise, an application may run into
5598 : an `invalid-read-syntax' error while attempting to read back the
5599 : value from file.
5600 :
5601 : The return value can be used as argument for `window-state-put'
5602 : to put the state recorded here into an arbitrary window. The
5603 : value can be also stored on disk and read back in a new session."
5604 0 : (setq window
5605 0 : (if window
5606 0 : (if (window-valid-p window)
5607 0 : window
5608 0 : (error "%s is not a live or internal window" window))
5609 0 : (frame-root-window)))
5610 : ;; The return value is a cons whose car specifies some constraints on
5611 : ;; the size of WINDOW. The cdr lists the states of the child windows
5612 : ;; of WINDOW.
5613 0 : (cons
5614 : ;; Frame related things would go into a function, say `frame-state',
5615 : ;; calling `window-state-get' to insert the frame's root window.
5616 0 : `((min-height . ,(window-min-size window))
5617 0 : (min-width . ,(window-min-size window t))
5618 0 : (min-height-ignore . ,(window-min-size window nil t))
5619 0 : (min-width-ignore . ,(window-min-size window t t))
5620 0 : (min-height-safe . ,(window-min-size window nil 'safe))
5621 0 : (min-width-safe . ,(window-min-size window t 'safe))
5622 0 : (min-pixel-height . ,(window-min-size window nil nil t))
5623 0 : (min-pixel-width . ,(window-min-size window t nil t))
5624 0 : (min-pixel-height-ignore . ,(window-min-size window nil t t))
5625 0 : (min-pixel-width-ignore . ,(window-min-size window t t t))
5626 0 : (min-pixel-height-safe . ,(window-min-size window nil 'safe t))
5627 0 : (min-pixel-width-safe . ,(window-min-size window t 'safe t)))
5628 0 : (window--state-get-1 window writable)))
5629 :
5630 : (defvar window-state-put-list nil
5631 : "Helper variable for `window-state-put'.")
5632 :
5633 : (defvar window-state-put-stale-windows nil
5634 : "Helper variable for `window-state-put'.")
5635 :
5636 : (defun window--state-put-1 (state &optional window ignore totals pixelwise)
5637 : "Helper function for `window-state-put'."
5638 0 : (let ((type (car state)))
5639 0 : (setq state (cdr state))
5640 0 : (cond
5641 0 : ((eq type 'leaf)
5642 : ;; For a leaf window just add unprocessed entries to
5643 : ;; `window-state-put-list'.
5644 0 : (push (cons window state) window-state-put-list))
5645 0 : ((memq type '(vc hc))
5646 0 : (let* ((horizontal (eq type 'hc))
5647 0 : (total (window-size window horizontal pixelwise))
5648 : (first t)
5649 0 : (window-combination-limit (cdr (assq 'combination-limit state)))
5650 : size new)
5651 0 : (dolist (item state)
5652 : ;; Find the next child window. WINDOW always points to the
5653 : ;; real window that we want to fill with what we find here.
5654 0 : (when (memq (car item) '(leaf vc hc))
5655 0 : (if (assq 'last item)
5656 : ;; The last child window. Below `window--state-put-1'
5657 : ;; will put into it whatever ITEM has in store.
5658 0 : (setq new nil)
5659 : ;; Not the last child window, prepare for splitting
5660 : ;; WINDOW. SIZE is the new (and final) size of the old
5661 : ;; window.
5662 0 : (setq size
5663 0 : (if totals
5664 : ;; Use total size.
5665 0 : (if pixelwise
5666 0 : (cdr (assq (if horizontal
5667 : 'pixel-width
5668 0 : 'pixel-height)
5669 0 : item))
5670 0 : (cdr (assq (if horizontal
5671 : 'total-width
5672 0 : 'total-height)
5673 0 : item)))
5674 : ;; Use normalized size and round.
5675 0 : (round
5676 0 : (* total
5677 0 : (cdr (assq (if horizontal 'normal-width 'normal-height)
5678 0 : item))))))
5679 :
5680 : ;; Use safe sizes, we try to resize later.
5681 0 : (setq size (max size
5682 0 : (if horizontal
5683 0 : (* window-safe-min-width
5684 0 : (if pixelwise
5685 0 : (frame-char-width (window-frame window))
5686 0 : 1))
5687 0 : (* window-safe-min-height
5688 0 : (if pixelwise
5689 0 : (frame-char-height (window-frame window))
5690 0 : 1)))))
5691 0 : (if (window-sizable-p window (- size) horizontal 'safe pixelwise)
5692 0 : (progn
5693 0 : (setq new (split-window-no-error
5694 0 : window size horizontal pixelwise))
5695 0 : (setq window-combination-limit nil))
5696 : ;; Give up if we can't resize window down to safe sizes.
5697 0 : (error "Cannot resize window %s" window))
5698 :
5699 0 : (when first
5700 0 : (setq first nil)
5701 : ;; When creating the first child window add for parent
5702 : ;; unprocessed entries to `window-state-put-list'.
5703 0 : (setq window-state-put-list
5704 0 : (cons (cons (window-parent window) state)
5705 0 : window-state-put-list))))
5706 :
5707 : ;; Now process the current window (either the one we've just
5708 : ;; split or the last child of its parent).
5709 0 : (window--state-put-1 item window ignore totals)
5710 : ;; Continue with the last window split off.
5711 0 : (setq window new))))))))
5712 :
5713 : (defun window--state-put-2 (ignore pixelwise)
5714 : "Helper function for `window-state-put'."
5715 0 : (dolist (item window-state-put-list)
5716 0 : (let ((window (car item))
5717 0 : (combination-limit (cdr (assq 'combination-limit item)))
5718 0 : (parameters (cdr (assq 'parameters item)))
5719 0 : (state (cdr (assq 'buffer item))))
5720 0 : (when combination-limit
5721 0 : (set-window-combination-limit window combination-limit))
5722 : ;; Reset window's parameters and assign saved ones (we might want
5723 : ;; a `remove-window-parameters' function here).
5724 0 : (dolist (parameter (window-parameters window))
5725 0 : (set-window-parameter window (car parameter) nil))
5726 0 : (when parameters
5727 0 : (dolist (parameter parameters)
5728 0 : (set-window-parameter window (car parameter) (cdr parameter))))
5729 : ;; Process buffer related state.
5730 0 : (when state
5731 0 : (let ((buffer (get-buffer (car state))))
5732 0 : (if buffer
5733 0 : (with-current-buffer buffer
5734 0 : (set-window-buffer window buffer)
5735 0 : (set-window-hscroll window (cdr (assq 'hscroll state)))
5736 0 : (apply 'set-window-fringes
5737 0 : (cons window (cdr (assq 'fringes state))))
5738 0 : (let ((margins (cdr (assq 'margins state))))
5739 0 : (set-window-margins window (car margins) (cdr margins)))
5740 0 : (let ((scroll-bars (cdr (assq 'scroll-bars state))))
5741 0 : (set-window-scroll-bars
5742 0 : window (car scroll-bars) (nth 2 scroll-bars)
5743 0 : (nth 3 scroll-bars) (nth 5 scroll-bars)))
5744 0 : (set-window-vscroll window (cdr (assq 'vscroll state)))
5745 : ;; Adjust vertically.
5746 0 : (if (or (memq window-size-fixed '(t height))
5747 0 : (window-preserved-size window))
5748 : ;; A fixed height window, try to restore the
5749 : ;; original size.
5750 0 : (let ((delta
5751 0 : (- (cdr (assq
5752 0 : (if pixelwise 'pixel-height 'total-height)
5753 0 : item))
5754 0 : (window-size window nil pixelwise)))
5755 : window-size-fixed)
5756 0 : (when (window--resizable-p
5757 0 : window delta nil nil nil nil nil pixelwise)
5758 0 : (window-resize window delta nil nil pixelwise)))
5759 : ;; Else check whether the window is not high enough.
5760 0 : (let* ((min-size
5761 0 : (window-min-size window nil ignore pixelwise))
5762 : (delta
5763 0 : (- min-size (window-size window nil pixelwise))))
5764 0 : (when (and (> delta 0)
5765 0 : (window--resizable-p
5766 0 : window delta nil ignore nil nil nil pixelwise))
5767 0 : (window-resize window delta nil ignore pixelwise))))
5768 : ;; Adjust horizontally.
5769 0 : (if (or (memq window-size-fixed '(t width))
5770 0 : (window-preserved-size window t))
5771 : ;; A fixed width window, try to restore the original
5772 : ;; size.
5773 0 : (let ((delta
5774 0 : (- (cdr (assq
5775 0 : (if pixelwise 'pixel-width 'total-width)
5776 0 : item))
5777 0 : (window-size window t pixelwise)))
5778 : window-size-fixed)
5779 0 : (when (window--resizable-p
5780 0 : window delta t nil nil nil nil pixelwise)
5781 0 : (window-resize window delta t nil pixelwise)))
5782 : ;; Else check whether the window is not wide enough.
5783 0 : (let* ((min-size (window-min-size window t ignore pixelwise))
5784 0 : (delta (- min-size (window-size window t pixelwise))))
5785 0 : (when (and (> delta 0)
5786 0 : (window--resizable-p
5787 0 : window delta t ignore nil nil nil pixelwise))
5788 0 : (window-resize window delta t ignore pixelwise))))
5789 : ;; Set dedicated status.
5790 0 : (set-window-dedicated-p window (cdr (assq 'dedicated state)))
5791 : ;; Install positions (maybe we should do this after all
5792 : ;; windows have been created and sized).
5793 0 : (ignore-errors
5794 : ;; Set 'noforce argument to avoid that window start
5795 : ;; overrides window point set below (Bug#24240).
5796 0 : (set-window-start window (cdr (assq 'start state)) 'noforce)
5797 0 : (set-window-point window (cdr (assq 'point state))))
5798 : ;; Select window if it's the selected one.
5799 0 : (when (cdr (assq 'selected state))
5800 0 : (select-window window)))
5801 : ;; We don't want to raise an error in case the buffer does
5802 : ;; not exist anymore, so we switch to a previous one and
5803 : ;; save the window with the intention of deleting it later
5804 : ;; if possible.
5805 0 : (switch-to-prev-buffer window)
5806 0 : (push window window-state-put-stale-windows)))))))
5807 :
5808 : (defun window-state-put (state &optional window ignore)
5809 : "Put window state STATE into WINDOW.
5810 : STATE should be the state of a window returned by an earlier
5811 : invocation of `window-state-get'. Optional argument WINDOW must
5812 : specify a valid window and defaults to the selected one. If
5813 : WINDOW is not live, replace WINDOW by a live one before putting
5814 : STATE into it.
5815 :
5816 : Optional argument IGNORE non-nil means ignore minimum window
5817 : sizes and fixed size restrictions. IGNORE equal `safe' means
5818 : windows can get as small as `window-safe-min-height' and
5819 : `window-safe-min-width'."
5820 0 : (setq window-state-put-stale-windows nil)
5821 0 : (setq window (window-normalize-window window))
5822 :
5823 : ;; When WINDOW is internal, reduce it to a live one to put STATE into,
5824 : ;; see Bug#16793.
5825 0 : (unless (window-live-p window)
5826 0 : (let ((root window))
5827 0 : (setq window (catch 'live
5828 0 : (walk-window-subtree
5829 : (lambda (window)
5830 0 : (when (and (window-live-p window)
5831 0 : (not (window-parameter window 'window-side)))
5832 0 : (throw 'live window)))
5833 0 : root)))
5834 0 : (delete-other-windows-internal window root)))
5835 :
5836 0 : (set-window-dedicated-p window nil)
5837 :
5838 0 : (let* ((frame (window-frame window))
5839 0 : (head (car state))
5840 : ;; We check here (1) whether the total sizes of root window of
5841 : ;; STATE and that of WINDOW are equal so we can avoid
5842 : ;; calculating new sizes, and (2) if we do have to resize
5843 : ;; whether we can do so without violating size restrictions.
5844 0 : (pixelwise (and (cdr (assq 'pixel-width state))
5845 0 : (cdr (assq 'pixel-height state))))
5846 0 : (totals (or (and pixelwise
5847 0 : (= (window-pixel-width window)
5848 0 : (cdr (assq 'pixel-width state)))
5849 0 : (= (window-pixel-height window)
5850 0 : (cdr (assq 'pixel-height state))))
5851 0 : (and (= (window-total-width window)
5852 0 : (cdr (assq 'total-width state)))
5853 0 : (= (window-total-height window)
5854 0 : (cdr (assq 'total-height state))))))
5855 0 : (min-height (cdr (assq
5856 0 : (if pixelwise 'min-pixel-height 'min-height)
5857 0 : head)))
5858 0 : (min-width (cdr (assq
5859 0 : (if pixelwise 'min-pixel-width 'min-weight)
5860 0 : head))))
5861 0 : (if (and (not totals)
5862 0 : (or (> min-height (window-size window nil pixelwise))
5863 0 : (> min-width (window-size window t pixelwise)))
5864 0 : (or (not ignore)
5865 0 : (and (setq min-height
5866 0 : (cdr (assq
5867 0 : (if pixelwise
5868 : 'min-pixel-height-ignore
5869 0 : 'min-height-ignore)
5870 0 : head)))
5871 0 : (setq min-width
5872 0 : (cdr (assq
5873 0 : (if pixelwise
5874 : 'min-pixel-width-ignore
5875 0 : 'min-width-ignore)
5876 0 : head)))
5877 0 : (or (> min-height
5878 0 : (window-size window nil pixelwise))
5879 0 : (> min-width
5880 0 : (window-size window t pixelwise)))
5881 0 : (or (not (eq ignore 'safe))
5882 0 : (and (setq min-height
5883 0 : (cdr (assq
5884 0 : (if pixelwise
5885 : 'min-pixel-height-safe
5886 0 : 'min-height-safe)
5887 0 : head)))
5888 0 : (setq min-width
5889 0 : (cdr (assq
5890 0 : (if pixelwise
5891 : 'min-pixel-width-safe
5892 0 : 'min-width-safe)
5893 0 : head)))
5894 0 : (or (> min-height
5895 0 : (window-size window nil pixelwise))
5896 0 : (> min-width
5897 0 : (window-size window t pixelwise))))))))
5898 : ;; The check above might not catch all errors due to rounding
5899 : ;; issues - so IGNORE equal 'safe might not always produce the
5900 : ;; minimum possible state. But such configurations hardly make
5901 : ;; sense anyway.
5902 0 : (error "Window %s too small to accommodate state" window)
5903 0 : (setq state (cdr state))
5904 0 : (setq window-state-put-list nil)
5905 : ;; Work on the windows of a temporary buffer to make sure that
5906 : ;; splitting proceeds regardless of any buffer local values of
5907 : ;; `window-size-fixed'. Release that buffer after the buffers of
5908 : ;; all live windows have been set by `window--state-put-2'.
5909 0 : (with-temp-buffer
5910 0 : (set-window-buffer window (current-buffer))
5911 0 : (window--state-put-1 state window nil totals pixelwise)
5912 0 : (window--state-put-2 ignore pixelwise))
5913 0 : (while window-state-put-stale-windows
5914 0 : (let ((window (pop window-state-put-stale-windows)))
5915 0 : (when (eq (window-deletable-p window) t)
5916 0 : (delete-window window))))
5917 0 : (window--check frame))))
5918 :
5919 : (defun window-swap-states (&optional window-1 window-2 size)
5920 : "Swap the states of live windows WINDOW-1 and WINDOW-2.
5921 : WINDOW-1 must specify a live window and defaults to the selected
5922 : one. WINDOW-2 must specify a live window and defaults to the
5923 : window following WINDOW-1 in the cyclic ordering of windows,
5924 : excluding minibuffer windows and including live windows on all
5925 : visible frames.
5926 :
5927 : Optional argument SIZE non-nil means to try swapping the sizes of
5928 : WINDOW-1 and WINDOW-2 as well. A value of `height' means to swap
5929 : heights only, a value of `width' means to swap widths only, while
5930 : t means to swap both widths and heights, if possible. Frames are
5931 : not resized by this function."
5932 : (interactive)
5933 0 : (setq window-1 (window-normalize-window window-1 t))
5934 0 : (if window-2
5935 0 : (unless (window-live-p window-2)
5936 0 : (error "%s is not a live window" window-2))
5937 0 : (setq window-2 (next-window window-1 'nomini 'visible)))
5938 0 : (unless (eq window-1 window-2)
5939 0 : (let* ((height (memq size '(t height)))
5940 0 : (width (memq size '(t width)))
5941 0 : (state-1 (window-state-get window-1))
5942 0 : (width-1 (and width (window-text-width window-1 t)))
5943 0 : (height-1 (and height (window-text-height window-1 t)))
5944 0 : (state-2 (window-state-get window-2))
5945 0 : (width-2 (and width (window-text-width window-2 t)))
5946 0 : (height-2 (and height (window-text-height window-2 t)))
5947 : old preserved)
5948 : ;; Swap basic states.
5949 0 : (window-state-put state-1 window-2 t)
5950 0 : (window-state-put state-2 window-1 t)
5951 : ;; Swap overlays with `window' property.
5952 0 : (with-current-buffer (window-buffer window-1)
5953 0 : (dolist (overlay (overlays-in (point-min) (point-max)))
5954 0 : (let ((window (overlay-get overlay 'window)))
5955 0 : (cond
5956 0 : ((not window))
5957 0 : ((eq window window-1)
5958 0 : (overlay-put overlay 'window window-2))
5959 0 : ((eq window window-2)
5960 0 : (overlay-put overlay 'window window-1))))))
5961 0 : (unless (eq (window-buffer window-1) (window-buffer window-2))
5962 0 : (with-current-buffer (window-buffer window-2)
5963 0 : (dolist (overlay (overlays-in (point-min) (point-max)))
5964 0 : (let ((window (overlay-get overlay 'window)))
5965 0 : (cond
5966 0 : ((not window))
5967 0 : ((eq window window-1)
5968 0 : (overlay-put overlay 'window window-2))
5969 0 : ((eq window window-2)
5970 0 : (overlay-put overlay 'window window-1)))))))
5971 : ;; Try to swap window sizes.
5972 0 : (when size
5973 0 : (unless (= (setq old (window-text-width window-1 t)) width-2)
5974 0 : (window-resize-no-error window-1 (- width-2 old) t t t))
5975 0 : (unless (= (setq old (window-text-width window-2 t)) width-1)
5976 0 : (setq preserved (window-preserved-size window-1 t))
5977 0 : (window-preserve-size window-1 t t)
5978 0 : (window-resize-no-error window-2 (- width-1 old) t t t)
5979 0 : (window-preserve-size window-1 t preserved))
5980 0 : (unless (= (setq old (window-text-height window-1 t)) height-2)
5981 0 : (window-resize-no-error window-1 (- height-2 old) nil t t))
5982 0 : (unless (= (setq old (window-text-height window-2 t)) height-1)
5983 0 : (setq preserved (window-preserved-size window-1))
5984 0 : (window-preserve-size window-1 nil t)
5985 0 : (window-resize-no-error window-2 (- height-1 old) nil t t)
5986 0 : (window-preserve-size window-1 nil preserved))))))
5987 :
5988 : (defun display-buffer-record-window (type window buffer)
5989 : "Record information for window used by `display-buffer'.
5990 : TYPE specifies the type of the calling operation and must be one
5991 : of the symbols `reuse' (when WINDOW existed already and was
5992 : reused for displaying BUFFER), `window' (when WINDOW was created
5993 : on an already existing frame), or `frame' (when WINDOW was
5994 : created on a new frame). WINDOW is the window used for or created
5995 : by the `display-buffer' routines. BUFFER is the buffer that
5996 : shall be displayed.
5997 :
5998 : This function installs or updates the quit-restore parameter of
5999 : WINDOW. The quit-restore parameter is a list of four elements:
6000 : The first element is one of the symbols `window', `frame', `same' or
6001 : `other'. The second element is either one of the symbols `window'
6002 : or `frame' or a list whose elements are the buffer previously
6003 : shown in the window, that buffer's window start and window point,
6004 : and the window's height. The third element is the window
6005 : selected at the time the parameter was created. The fourth
6006 : element is BUFFER."
6007 160 : (cond
6008 160 : ((eq type 'reuse)
6009 157 : (if (eq (window-buffer window) buffer)
6010 : ;; WINDOW shows BUFFER already. Update WINDOW's quit-restore
6011 : ;; parameter, if any.
6012 0 : (let ((quit-restore (window-parameter window 'quit-restore)))
6013 0 : (when (consp quit-restore)
6014 0 : (setcar quit-restore 'same)
6015 : ;; The selected-window might have changed in
6016 : ;; between (Bug#20353).
6017 0 : (unless (or (eq window (selected-window))
6018 0 : (eq window (nth 2 quit-restore)))
6019 0 : (setcar (cddr quit-restore) (selected-window)))))
6020 : ;; WINDOW shows another buffer.
6021 157 : (with-current-buffer (window-buffer window)
6022 157 : (set-window-parameter
6023 157 : window 'quit-restore
6024 157 : (list 'other
6025 : ;; A quadruple of WINDOW's buffer, start, point and height.
6026 157 : (list (current-buffer) (window-start window)
6027 : ;; Preserve window-point-insertion-type (Bug#12588).
6028 157 : (copy-marker
6029 157 : (window-point window) window-point-insertion-type)
6030 157 : (if (window-combined-p window)
6031 8 : (window-total-height window)
6032 157 : (window-total-width window)))
6033 157 : (selected-window) buffer)))))
6034 3 : ((eq type 'window)
6035 : ;; WINDOW has been created on an existing frame.
6036 3 : (set-window-parameter
6037 3 : window 'quit-restore
6038 3 : (list 'window 'window (selected-window) buffer)))
6039 0 : ((eq type 'frame)
6040 : ;; WINDOW has been created on a new frame.
6041 0 : (set-window-parameter
6042 0 : window 'quit-restore
6043 160 : (list 'frame 'frame (selected-window) buffer)))))
6044 :
6045 : (defcustom display-buffer-function nil
6046 : "If non-nil, function to call to handle `display-buffer'.
6047 : It will receive two args, the buffer and a flag which if non-nil
6048 : means that the currently selected window is not acceptable. It
6049 : should choose or create a window, display the specified buffer in
6050 : it, and return the window.
6051 :
6052 : The specified function should call `display-buffer-record-window'
6053 : with corresponding arguments to set up the quit-restore parameter
6054 : of the window used."
6055 : :type '(choice
6056 : (const nil)
6057 : (function :tag "function"))
6058 : :group 'windows)
6059 :
6060 : (make-obsolete-variable 'display-buffer-function
6061 : 'display-buffer-alist "24.3")
6062 :
6063 : ;; Eventually, we want to turn this into a defvar; instead of
6064 : ;; customizing this, the user should use a `pop-up-frame-parameters'
6065 : ;; alist entry in `display-buffer-base-action'.
6066 : (defcustom pop-up-frame-alist nil
6067 : "Alist of parameters for automatically generated new frames.
6068 : If non-nil, the value you specify here is used by the default
6069 : `pop-up-frame-function' for the creation of new frames.
6070 :
6071 : Since `pop-up-frame-function' is used by `display-buffer' for
6072 : making new frames, any value specified here by default affects
6073 : the automatic generation of new frames via `display-buffer' and
6074 : all functions based on it. The behavior of `make-frame' is not
6075 : affected by this variable."
6076 : :type '(repeat (cons :format "%v"
6077 : (symbol :tag "Parameter")
6078 : (sexp :tag "Value")))
6079 : :group 'frames)
6080 :
6081 : (defcustom pop-up-frame-function
6082 : (lambda () (make-frame pop-up-frame-alist))
6083 : "Function used by `display-buffer' for creating a new frame.
6084 : This function is called with no arguments and should return a new
6085 : frame. The default value calls `make-frame' with the argument
6086 : `pop-up-frame-alist'."
6087 : :type 'function
6088 : :group 'frames)
6089 :
6090 : (defcustom special-display-buffer-names nil
6091 : "List of names of buffers that should be displayed specially.
6092 : Displaying a buffer with `display-buffer' or `pop-to-buffer', if
6093 : its name is in this list, displays the buffer in a way specified
6094 : by `special-display-function'. `special-display-popup-frame'
6095 : \(the default for `special-display-function') usually displays
6096 : the buffer in a separate frame made with the parameters specified
6097 : by `special-display-frame-alist'. If `special-display-function'
6098 : has been set to some other function, that function is called with
6099 : the buffer as first, and nil as second argument.
6100 :
6101 : Alternatively, an element of this list can be specified as
6102 : \(BUFFER-NAME FRAME-PARAMETERS), where BUFFER-NAME is a buffer
6103 : name and FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
6104 : `special-display-popup-frame' will interpret such pairs as frame
6105 : parameters when it creates a special frame, overriding the
6106 : corresponding values from `special-display-frame-alist'.
6107 :
6108 : As a special case, if FRAME-PARAMETERS contains (same-window . t)
6109 : `special-display-popup-frame' displays that buffer in the
6110 : selected window. If FRAME-PARAMETERS contains (same-frame . t),
6111 : it displays that buffer in a window on the selected frame.
6112 :
6113 : If `special-display-function' specifies some other function than
6114 : `special-display-popup-frame', that function is called with the
6115 : buffer named BUFFER-NAME as first, and FRAME-PARAMETERS as second
6116 : argument.
6117 :
6118 : Finally, an element of this list can be also specified as
6119 : \(BUFFER-NAME FUNCTION OTHER-ARGS). In that case,
6120 : `special-display-popup-frame' will call FUNCTION with the buffer
6121 : named BUFFER-NAME as first argument, and OTHER-ARGS as the
6122 : second.
6123 :
6124 : Any alternative function specified here is responsible for
6125 : setting up the quit-restore parameter of the window used.
6126 :
6127 : If this variable appears \"not to work\", because you added a
6128 : name to it but the corresponding buffer is displayed in the
6129 : selected window, look at the values of `same-window-buffer-names'
6130 : and `same-window-regexps'. Those variables take precedence over
6131 : this one.
6132 :
6133 : See also `special-display-regexps'."
6134 : :type '(repeat
6135 : (choice :tag "Buffer"
6136 : :value ""
6137 : (string :format "%v")
6138 : (cons :tag "With parameters"
6139 : :format "%v"
6140 : :value ("" . nil)
6141 : (string :format "%v")
6142 : (repeat :tag "Parameters"
6143 : (cons :format "%v"
6144 : (symbol :tag "Parameter")
6145 : (sexp :tag "Value"))))
6146 : (list :tag "With function"
6147 : :format "%v"
6148 : :value ("" . nil)
6149 : (string :format "%v")
6150 : (function :tag "Function")
6151 : (repeat :tag "Arguments" (sexp)))))
6152 : :group 'windows
6153 : :group 'frames)
6154 : (make-obsolete-variable 'special-display-buffer-names 'display-buffer-alist "24.3")
6155 : (put 'special-display-buffer-names 'risky-local-variable t)
6156 :
6157 : (defcustom special-display-regexps nil
6158 : "List of regexps saying which buffers should be displayed specially.
6159 : Displaying a buffer with `display-buffer' or `pop-to-buffer', if
6160 : any regexp in this list matches its name, displays it specially
6161 : using `special-display-function'. `special-display-popup-frame'
6162 : \(the default for `special-display-function') usually displays
6163 : the buffer in a separate frame made with the parameters specified
6164 : by `special-display-frame-alist'. If `special-display-function'
6165 : has been set to some other function, that function is called with
6166 : the buffer as first, and nil as second argument.
6167 :
6168 : Alternatively, an element of this list can be specified as
6169 : \(REGEXP FRAME-PARAMETERS), where REGEXP is a regexp as above and
6170 : FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
6171 : `special-display-popup-frame' will then interpret these pairs as
6172 : frame parameters when creating a special frame for a buffer whose
6173 : name matches REGEXP, overriding the corresponding values from
6174 : `special-display-frame-alist'.
6175 :
6176 : As a special case, if FRAME-PARAMETERS contains (same-window . t)
6177 : `special-display-popup-frame' displays buffers matching REGEXP in
6178 : the selected window. (same-frame . t) in FRAME-PARAMETERS means
6179 : to display such buffers in a window on the selected frame.
6180 :
6181 : If `special-display-function' specifies some other function than
6182 : `special-display-popup-frame', that function is called with the
6183 : buffer whose name matched REGEXP as first, and FRAME-PARAMETERS
6184 : as second argument.
6185 :
6186 : Finally, an element of this list can be also specified as
6187 : \(REGEXP FUNCTION OTHER-ARGS). `special-display-popup-frame'
6188 : will then call FUNCTION with the buffer whose name matched
6189 : REGEXP as first, and OTHER-ARGS as second argument.
6190 :
6191 : Any alternative function specified here is responsible for
6192 : setting up the quit-restore parameter of the window used.
6193 :
6194 : If this variable appears \"not to work\", because you added a
6195 : name to it but the corresponding buffer is displayed in the
6196 : selected window, look at the values of `same-window-buffer-names'
6197 : and `same-window-regexps'. Those variables take precedence over
6198 : this one.
6199 :
6200 : See also `special-display-buffer-names'."
6201 : :type '(repeat
6202 : (choice :tag "Buffer"
6203 : :value ""
6204 : (regexp :format "%v")
6205 : (cons :tag "With parameters"
6206 : :format "%v"
6207 : :value ("" . nil)
6208 : (regexp :format "%v")
6209 : (repeat :tag "Parameters"
6210 : (cons :format "%v"
6211 : (symbol :tag "Parameter")
6212 : (sexp :tag "Value"))))
6213 : (list :tag "With function"
6214 : :format "%v"
6215 : :value ("" . nil)
6216 : (regexp :format "%v")
6217 : (function :tag "Function")
6218 : (repeat :tag "Arguments" (sexp)))))
6219 : :group 'windows
6220 : :group 'frames)
6221 : (make-obsolete-variable 'special-display-regexps 'display-buffer-alist "24.3")
6222 : (put 'special-display-regexps 'risky-local-variable t)
6223 :
6224 : (defun special-display-p (buffer-name)
6225 : "Return non-nil if a buffer named BUFFER-NAME gets a special frame.
6226 : More precisely, return t if `special-display-buffer-names' or
6227 : `special-display-regexps' contain a string entry equaling or
6228 : matching BUFFER-NAME. If `special-display-buffer-names' or
6229 : `special-display-regexps' contain a list entry whose car equals
6230 : or matches BUFFER-NAME, the return value is the cdr of that
6231 : entry."
6232 160 : (let (tmp)
6233 160 : (cond
6234 160 : ((member buffer-name special-display-buffer-names)
6235 : t)
6236 160 : ((setq tmp (assoc buffer-name special-display-buffer-names))
6237 0 : (cdr tmp))
6238 160 : ((catch 'found
6239 160 : (dolist (regexp special-display-regexps)
6240 0 : (cond
6241 0 : ((stringp regexp)
6242 0 : (when (string-match-p regexp buffer-name)
6243 0 : (throw 'found t)))
6244 0 : ((and (consp regexp) (stringp (car regexp))
6245 0 : (string-match-p (car regexp) buffer-name))
6246 160 : (throw 'found (cdr regexp))))))))))
6247 :
6248 : (defcustom special-display-frame-alist
6249 : '((height . 14) (width . 80) (unsplittable . t))
6250 : "Alist of parameters for special frames.
6251 : Special frames are used for buffers whose names are listed in
6252 : `special-display-buffer-names' and for buffers whose names match
6253 : one of the regular expressions in `special-display-regexps'.
6254 :
6255 : This variable can be set in your init file, like this:
6256 :
6257 : (setq special-display-frame-alist \\='((width . 80) (height . 20)))
6258 :
6259 : These supersede the values given in `default-frame-alist'."
6260 : :type '(repeat (cons :format "%v"
6261 : (symbol :tag "Parameter")
6262 : (sexp :tag "Value")))
6263 : :group 'frames)
6264 : (make-obsolete-variable 'special-display-frame-alist 'display-buffer-alist "24.3")
6265 :
6266 : (defun special-display-popup-frame (buffer &optional args)
6267 : "Pop up a frame displaying BUFFER and return its window.
6268 : If BUFFER is already displayed in a visible or iconified frame,
6269 : raise that frame. Otherwise, display BUFFER in a new frame.
6270 :
6271 : Optional argument ARGS is a list specifying additional
6272 : information.
6273 :
6274 : If ARGS is an alist, use it as a list of frame parameters. If
6275 : these parameters contain (same-window . t), display BUFFER in
6276 : the selected window. If they contain (same-frame . t), display
6277 : BUFFER in a window of the selected frame.
6278 :
6279 : If ARGS is a list whose car is a symbol, use (car ARGS) as a
6280 : function to do the work. Pass it BUFFER as first argument, and
6281 : pass the elements of (cdr ARGS) as the remaining arguments."
6282 0 : (if (and args (symbolp (car args)))
6283 0 : (apply (car args) buffer (cdr args))
6284 0 : (let ((window (get-buffer-window buffer 0)))
6285 0 : (or
6286 : ;; If we have a window already, make it visible.
6287 0 : (when window
6288 0 : (let ((frame (window-frame window)))
6289 0 : (make-frame-visible frame)
6290 0 : (raise-frame frame)
6291 0 : (display-buffer-record-window 'reuse window buffer)
6292 0 : window))
6293 : ;; Reuse the current window if the user requested it.
6294 0 : (when (cdr (assq 'same-window args))
6295 0 : (condition-case nil
6296 0 : (progn (switch-to-buffer buffer nil t) (selected-window))
6297 0 : (error nil)))
6298 : ;; Stay on the same frame if requested.
6299 0 : (when (or (cdr (assq 'same-frame args)) (cdr (assq 'same-window args)))
6300 0 : (let* ((pop-up-windows t)
6301 : pop-up-frames
6302 : special-display-buffer-names special-display-regexps)
6303 0 : (display-buffer buffer)))
6304 : ;; If no window yet, make one in a new frame.
6305 0 : (let* ((frame
6306 0 : (with-current-buffer buffer
6307 0 : (make-frame (append args special-display-frame-alist))))
6308 0 : (window (frame-selected-window frame)))
6309 0 : (display-buffer-record-window 'frame window buffer)
6310 0 : (unless (eq buffer (window-buffer window))
6311 0 : (set-window-buffer window buffer)
6312 0 : (set-window-prev-buffers window nil))
6313 0 : (set-window-dedicated-p window t)
6314 0 : window)))))
6315 :
6316 : (defcustom special-display-function 'special-display-popup-frame
6317 : "Function to call for displaying special buffers.
6318 : This function is called with two arguments - the buffer and,
6319 : optionally, a list - and should return a window displaying that
6320 : buffer. The default value usually makes a separate frame for the
6321 : buffer using `special-display-frame-alist' to specify the frame
6322 : parameters. See the definition of `special-display-popup-frame'
6323 : for how to specify such a function.
6324 :
6325 : A buffer is special when its name is either listed in
6326 : `special-display-buffer-names' or matches a regexp in
6327 : `special-display-regexps'.
6328 :
6329 : The specified function should call `display-buffer-record-window'
6330 : with corresponding arguments to set up the quit-restore parameter
6331 : of the window used."
6332 : :type 'function
6333 : :group 'frames)
6334 : (make-obsolete-variable 'special-display-function 'display-buffer-alist "24.3")
6335 :
6336 : (defcustom same-window-buffer-names nil
6337 : "List of names of buffers that should appear in the \"same\" window.
6338 : `display-buffer' and `pop-to-buffer' show a buffer whose name is
6339 : on this list in the selected rather than some other window.
6340 :
6341 : An element of this list can be a cons cell instead of just a
6342 : string. In that case, the cell's car must be a string specifying
6343 : the buffer name. This is for compatibility with
6344 : `special-display-buffer-names'; the cdr of the cons cell is
6345 : ignored.
6346 :
6347 : See also `same-window-regexps'."
6348 : :type '(repeat (string :format "%v"))
6349 : :group 'windows)
6350 :
6351 : (defcustom same-window-regexps nil
6352 : "List of regexps saying which buffers should appear in the \"same\" window.
6353 : `display-buffer' and `pop-to-buffer' show a buffer whose name
6354 : matches a regexp on this list in the selected rather than some
6355 : other window.
6356 :
6357 : An element of this list can be a cons cell instead of just a
6358 : string. In that case, the cell's car must be a regexp matching
6359 : the buffer name. This is for compatibility with
6360 : `special-display-regexps'; the cdr of the cons cell is ignored.
6361 :
6362 : See also `same-window-buffer-names'."
6363 : :type '(repeat (regexp :format "%v"))
6364 : :group 'windows)
6365 :
6366 : (defun same-window-p (buffer-name)
6367 : "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
6368 : This function returns non-nil if `display-buffer' or
6369 : `pop-to-buffer' would show a buffer named BUFFER-NAME in the
6370 : selected rather than (as usual) some other window. See
6371 : `same-window-buffer-names' and `same-window-regexps'."
6372 11 : (cond
6373 11 : ((not (stringp buffer-name)))
6374 : ;; The elements of `same-window-buffer-names' can be buffer
6375 : ;; names or cons cells whose cars are buffer names.
6376 11 : ((member buffer-name same-window-buffer-names))
6377 11 : ((assoc buffer-name same-window-buffer-names))
6378 11 : ((catch 'found
6379 11 : (dolist (regexp same-window-regexps)
6380 : ;; The elements of `same-window-regexps' can be regexps
6381 : ;; or cons cells whose cars are regexps.
6382 0 : (when (or (and (stringp regexp)
6383 0 : (string-match-p regexp buffer-name))
6384 0 : (and (consp regexp) (stringp (car regexp))
6385 0 : (string-match-p (car regexp) buffer-name)))
6386 11 : (throw 'found t)))))))
6387 :
6388 : (defcustom pop-up-frames nil
6389 : "Whether `display-buffer' should make a separate frame.
6390 : If nil, never make a separate frame.
6391 : If the value is `graphic-only', make a separate frame
6392 : on graphic displays only.
6393 : Any other non-nil value means always make a separate frame."
6394 : :type '(choice
6395 : (const :tag "Never" nil)
6396 : (const :tag "On graphic displays only" graphic-only)
6397 : (const :tag "Always" t))
6398 : :group 'windows)
6399 :
6400 : (defcustom display-buffer-reuse-frames nil
6401 : "Non-nil means `display-buffer' should reuse frames.
6402 : If the buffer in question is already displayed in a frame, raise
6403 : that frame."
6404 : :type 'boolean
6405 : :version "21.1"
6406 : :group 'windows)
6407 :
6408 : (make-obsolete-variable
6409 : 'display-buffer-reuse-frames
6410 : "use a `reusable-frames' alist entry in `display-buffer-alist'."
6411 : "24.3")
6412 :
6413 : (defcustom pop-up-windows t
6414 : "Non-nil means `display-buffer' should make a new window."
6415 : :type 'boolean
6416 : :group 'windows)
6417 :
6418 : (defcustom split-window-preferred-function 'split-window-sensibly
6419 : "Function called by `display-buffer' routines to split a window.
6420 : This function is called with a window as single argument and is
6421 : supposed to split that window and return the new window. If the
6422 : window can (or shall) not be split, it is supposed to return nil.
6423 : The default is to call the function `split-window-sensibly' which
6424 : tries to split the window in a way which seems most suitable.
6425 : You can customize the options `split-height-threshold' and/or
6426 : `split-width-threshold' in order to have `split-window-sensibly'
6427 : prefer either vertical or horizontal splitting.
6428 :
6429 : If you set this to any other function, bear in mind that the
6430 : `display-buffer' routines may call this function two times. The
6431 : argument of the first call is the largest window on its frame.
6432 : If that call fails to return a live window, the function is
6433 : called again with the least recently used window as argument. If
6434 : that call fails too, `display-buffer' will use an existing window
6435 : to display its buffer.
6436 :
6437 : The window selected at the time `display-buffer' was invoked is
6438 : still selected when this function is called. Hence you can
6439 : compare the window argument with the value of `selected-window'
6440 : if you intend to split the selected window instead or if you do
6441 : not want to split the selected window."
6442 : :type 'function
6443 : :version "23.1"
6444 : :group 'windows)
6445 :
6446 : (defcustom split-height-threshold 80
6447 : "Minimum height for splitting windows sensibly.
6448 : If this is an integer, `split-window-sensibly' may split a window
6449 : vertically only if it has at least this many lines. If this is
6450 : nil, `split-window-sensibly' is not allowed to split a window
6451 : vertically. If, however, a window is the only window on its
6452 : frame, `split-window-sensibly' may split it vertically
6453 : disregarding the value of this variable."
6454 : :type '(choice (const nil) (integer :tag "lines"))
6455 : :version "23.1"
6456 : :group 'windows)
6457 :
6458 : (defcustom split-width-threshold 160
6459 : "Minimum width for splitting windows sensibly.
6460 : If this is an integer, `split-window-sensibly' may split a window
6461 : horizontally only if it has at least this many columns. If this
6462 : is nil, `split-window-sensibly' is not allowed to split a window
6463 : horizontally."
6464 : :type '(choice (const nil) (integer :tag "columns"))
6465 : :version "23.1"
6466 : :group 'windows)
6467 :
6468 : (defun window-splittable-p (window &optional horizontal)
6469 : "Return non-nil if `split-window-sensibly' may split WINDOW.
6470 : Optional argument HORIZONTAL nil or omitted means check whether
6471 : `split-window-sensibly' may split WINDOW vertically. HORIZONTAL
6472 : non-nil means check whether WINDOW may be split horizontally.
6473 :
6474 : WINDOW may be split vertically when the following conditions
6475 : hold:
6476 : - `window-size-fixed' is either nil or equals `width' for the
6477 : buffer of WINDOW.
6478 : - `split-height-threshold' is an integer and WINDOW is at least as
6479 : high as `split-height-threshold'.
6480 : - When WINDOW is split evenly, the emanating windows are at least
6481 : `window-min-height' lines tall and can accommodate at least one
6482 : line plus - if WINDOW has one - a mode line.
6483 :
6484 : WINDOW may be split horizontally when the following conditions
6485 : hold:
6486 : - `window-size-fixed' is either nil or equals `height' for the
6487 : buffer of WINDOW.
6488 : - `split-width-threshold' is an integer and WINDOW is at least as
6489 : wide as `split-width-threshold'.
6490 : - When WINDOW is split evenly, the emanating windows are at least
6491 : `window-min-width' or two (whichever is larger) columns wide."
6492 41 : (when (and (window-live-p window)
6493 41 : (not (window-parameter window 'window-side)))
6494 41 : (with-current-buffer (window-buffer window)
6495 41 : (if horizontal
6496 : ;; A window can be split horizontally when its width is not
6497 : ;; fixed, it is at least `split-width-threshold' columns wide
6498 : ;; and at least twice as wide as `window-min-width' and 2 (the
6499 : ;; latter value is hardcoded).
6500 19 : (and (memq window-size-fixed '(nil height))
6501 : ;; Testing `window-full-width-p' here hardly makes any
6502 : ;; sense nowadays. This can be done more intuitively by
6503 : ;; setting up `split-width-threshold' appropriately.
6504 19 : (numberp split-width-threshold)
6505 19 : (>= (window-width window)
6506 19 : (max split-width-threshold
6507 19 : (* 2 (max window-min-width 2)))))
6508 : ;; A window can be split vertically when its height is not
6509 : ;; fixed, it is at least `split-height-threshold' lines high,
6510 : ;; and it is at least twice as high as `window-min-height' and 2
6511 : ;; if it has a mode line or 1.
6512 22 : (and (memq window-size-fixed '(nil width))
6513 22 : (numberp split-height-threshold)
6514 22 : (>= (window-height window)
6515 22 : (max split-height-threshold
6516 22 : (* 2 (max window-min-height
6517 41 : (if mode-line-format 2 1))))))))))
6518 :
6519 : (defun split-window-sensibly (&optional window)
6520 : "Split WINDOW in a way suitable for `display-buffer'.
6521 : WINDOW defaults to the currently selected window.
6522 : If `split-height-threshold' specifies an integer, WINDOW is at
6523 : least `split-height-threshold' lines tall and can be split
6524 : vertically, split WINDOW into two windows one above the other and
6525 : return the lower window. Otherwise, if `split-width-threshold'
6526 : specifies an integer, WINDOW is at least `split-width-threshold'
6527 : columns wide and can be split horizontally, split WINDOW into two
6528 : windows side by side and return the window on the right. If this
6529 : can't be done either and WINDOW is the only window on its frame,
6530 : try to split WINDOW vertically disregarding any value specified
6531 : by `split-height-threshold'. If that succeeds, return the lower
6532 : window. Return nil otherwise.
6533 :
6534 : By default `display-buffer' routines call this function to split
6535 : the largest or least recently used window. To change the default
6536 : customize the option `split-window-preferred-function'.
6537 :
6538 : You can enforce this function to not split WINDOW horizontally,
6539 : by setting (or binding) the variable `split-width-threshold' to
6540 : nil. If, in addition, you set `split-height-threshold' to zero,
6541 : chances increase that this function does split WINDOW vertically.
6542 :
6543 : In order to not split WINDOW vertically, set (or bind) the
6544 : variable `split-height-threshold' to nil. Additionally, you can
6545 : set `split-width-threshold' to zero to make a horizontal split
6546 : more likely to occur.
6547 :
6548 : Have a look at the function `window-splittable-p' if you want to
6549 : know how `split-window-sensibly' determines whether WINDOW can be
6550 : split."
6551 19 : (let ((window (or window (selected-window))))
6552 19 : (or (and (window-splittable-p window)
6553 : ;; Split window vertically.
6554 0 : (with-selected-window window
6555 19 : (split-window-below)))
6556 19 : (and (window-splittable-p window t)
6557 : ;; Split window horizontally.
6558 0 : (with-selected-window window
6559 19 : (split-window-right)))
6560 19 : (and (eq window (frame-root-window (window-frame window)))
6561 3 : (not (window-minibuffer-p window))
6562 : ;; If WINDOW is the only window on its frame and is not the
6563 : ;; minibuffer window, try to split it vertically disregarding
6564 : ;; the value of `split-height-threshold'.
6565 3 : (let ((split-height-threshold 0))
6566 3 : (when (window-splittable-p window)
6567 3 : (with-selected-window window
6568 19 : (split-window-below))))))))
6569 :
6570 : (defun window--try-to-split-window (window &optional alist)
6571 : "Try to split WINDOW.
6572 : Return value returned by `split-window-preferred-function' if it
6573 : represents a live window, nil otherwise."
6574 19 : (and (window-live-p window)
6575 19 : (not (frame-parameter (window-frame window) 'unsplittable))
6576 19 : (let* ((window-combination-limit
6577 : ;; When `window-combination-limit' equals
6578 : ;; `display-buffer' or equals `resize-window' and a
6579 : ;; `window-height' or `window-width' alist entry are
6580 : ;; present, bind it to t so resizing steals space
6581 : ;; preferably from the window that was split.
6582 19 : (if (or (eq window-combination-limit 'display-buffer)
6583 19 : (and (eq window-combination-limit 'window-size)
6584 19 : (or (cdr (assq 'window-height alist))
6585 19 : (cdr (assq 'window-width alist)))))
6586 : t
6587 19 : window-combination-limit))
6588 : (new-window
6589 : ;; Since `split-window-preferred-function' might
6590 : ;; throw an error use `condition-case'.
6591 19 : (condition-case nil
6592 19 : (funcall split-window-preferred-function window)
6593 19 : (error nil))))
6594 19 : (and (window-live-p new-window) new-window))))
6595 :
6596 : (defun window--frame-usable-p (frame)
6597 : "Return FRAME if it can be used to display a buffer."
6598 19 : (when (frame-live-p frame)
6599 19 : (let ((window (frame-root-window frame)))
6600 : ;; `frame-root-window' may be an internal window which is considered
6601 : ;; "dead" by `window-live-p'. Hence if `window' is not live we
6602 : ;; implicitly know that `frame' has a visible window we can use.
6603 19 : (unless (and (window-live-p window)
6604 3 : (or (window-minibuffer-p window)
6605 : ;; If the window is soft-dedicated, the frame is usable.
6606 : ;; Actually, even if the window is really dedicated,
6607 : ;; the frame is still usable by splitting it.
6608 : ;; At least Emacs-22 allowed it, and it is desirable
6609 : ;; when displaying same-frame windows.
6610 : nil ; (eq t (window-dedicated-p window))
6611 19 : ))
6612 19 : frame))))
6613 :
6614 : (defcustom even-window-sizes t
6615 : "If non-nil `display-buffer' will try to even window sizes.
6616 : Otherwise `display-buffer' will leave the window configuration
6617 : alone. Special values are `height-only' to even heights only and
6618 : `width-only' to even widths only. Any other value means to even
6619 : any of them."
6620 : :type '(choice
6621 : (const :tag "Never" nil)
6622 : (const :tag "Side-by-side windows only" width-only)
6623 : (const :tag "Windows above or below only" height-only)
6624 : (const :tag "Always" t))
6625 : :version "25.1"
6626 : :group 'windows)
6627 : (defvaralias 'even-window-heights 'even-window-sizes)
6628 :
6629 : (defun window--even-window-sizes (window)
6630 : "Even sizes of WINDOW and selected window.
6631 : Even only if these windows are the only children of their parent,
6632 : `even-window-sizes' has the appropriate value and the selected
6633 : window is larger than WINDOW."
6634 8 : (when (and (= (window-child-count (window-parent window)) 2)
6635 8 : (eq (window-parent) (window-parent window)))
6636 8 : (cond
6637 8 : ((and (not (memq even-window-sizes '(nil height-only)))
6638 8 : (window-combined-p window t)
6639 8 : (> (window-total-width) (window-total-width window)))
6640 0 : (condition-case nil
6641 0 : (enlarge-window
6642 0 : (/ (- (window-total-width window) (window-total-width)) 2) t)
6643 0 : (error nil)))
6644 8 : ((and (not (memq even-window-sizes '(nil width-only)))
6645 8 : (window-combined-p window)
6646 8 : (> (window-total-height) (window-total-height window)))
6647 0 : (condition-case nil
6648 0 : (enlarge-window
6649 0 : (/ (- (window-total-height window) (window-total-height)) 2))
6650 8 : (error nil))))))
6651 :
6652 : (defun window--display-buffer (buffer window type &optional alist dedicated)
6653 : "Display BUFFER in WINDOW.
6654 : TYPE must be one of the symbols `reuse', `window' or `frame' and
6655 : is passed unaltered to `display-buffer-record-window'. ALIST is
6656 : the alist argument of `display-buffer'. Set `window-dedicated-p'
6657 : to DEDICATED if non-nil. Return WINDOW if BUFFER and WINDOW are
6658 : live."
6659 160 : (when (and (buffer-live-p buffer) (window-live-p window))
6660 160 : (display-buffer-record-window type window buffer)
6661 160 : (unless (eq buffer (window-buffer window))
6662 160 : (set-window-dedicated-p window nil)
6663 160 : (set-window-buffer window buffer))
6664 160 : (when dedicated
6665 160 : (set-window-dedicated-p window dedicated))
6666 160 : (when (memq type '(window frame))
6667 160 : (set-window-prev-buffers window nil))
6668 160 : (let ((quit-restore (window-parameter window 'quit-restore))
6669 160 : (height (cdr (assq 'window-height alist)))
6670 160 : (width (cdr (assq 'window-width alist)))
6671 160 : (size (cdr (assq 'window-size alist)))
6672 160 : (preserve-size (cdr (assq 'preserve-size alist))))
6673 160 : (cond
6674 160 : ((or (eq type 'frame)
6675 160 : (and (eq (car quit-restore) 'same)
6676 160 : (eq (nth 1 quit-restore) 'frame)))
6677 : ;; Adjust size of frame if asked for.
6678 0 : (cond
6679 0 : ((not size))
6680 0 : ((consp size)
6681 0 : (let ((width (car size))
6682 0 : (height (cdr size))
6683 0 : (frame (window-frame window)))
6684 0 : (when (and (numberp width) (numberp height))
6685 0 : (set-frame-height
6686 0 : frame (+ (frame-height frame)
6687 0 : (- height (window-total-height window))))
6688 0 : (set-frame-width
6689 0 : frame (+ (frame-width frame)
6690 0 : (- width (window-total-width window)))))))
6691 0 : ((functionp size)
6692 0 : (ignore-errors (funcall size window)))))
6693 160 : ((or (eq type 'window)
6694 157 : (and (eq (car quit-restore) 'same)
6695 160 : (eq (nth 1 quit-restore) 'window)))
6696 : ;; Adjust height of window if asked for.
6697 3 : (cond
6698 3 : ((not height))
6699 0 : ((numberp height)
6700 0 : (let* ((new-height
6701 0 : (if (integerp height)
6702 0 : height
6703 0 : (round
6704 0 : (* (window-total-height (frame-root-window window))
6705 0 : height))))
6706 0 : (delta (- new-height (window-total-height window))))
6707 0 : (when (and (window--resizable-p window delta nil 'safe)
6708 0 : (window-combined-p window))
6709 0 : (window-resize window delta nil 'safe))))
6710 0 : ((functionp height)
6711 3 : (ignore-errors (funcall height window))))
6712 : ;; Adjust width of window if asked for.
6713 3 : (cond
6714 3 : ((not width))
6715 0 : ((numberp width)
6716 0 : (let* ((new-width
6717 0 : (if (integerp width)
6718 0 : width
6719 0 : (round
6720 0 : (* (window-total-width (frame-root-window window))
6721 0 : width))))
6722 0 : (delta (- new-width (window-total-width window))))
6723 0 : (when (and (window--resizable-p window delta t 'safe)
6724 0 : (window-combined-p window t))
6725 0 : (window-resize window delta t 'safe))))
6726 0 : ((functionp width)
6727 3 : (ignore-errors (funcall width window))))
6728 : ;; Preserve window size if asked for.
6729 3 : (when (consp preserve-size)
6730 0 : (window-preserve-size window t (car preserve-size))
6731 160 : (window-preserve-size window nil (cdr preserve-size)))))
6732 : ;; Assign any window parameters specified.
6733 160 : (let ((parameters (cdr (assq 'window-parameters alist))))
6734 160 : (dolist (parameter parameters)
6735 0 : (set-window-parameter
6736 160 : window (car parameter) (cdr parameter)))))
6737 160 : window))
6738 :
6739 : (defun window--maybe-raise-frame (frame)
6740 11 : (make-frame-visible frame)
6741 11 : (unless (or (frame-parameter frame 'no-focus-on-map)
6742 : ;; Don't raise frames that should not get focus.
6743 11 : (frame-parameter frame 'no-accept-focus)
6744 : ;; Assume the selected frame is already visible enough.
6745 11 : (eq frame (selected-frame))
6746 : ;; Assume the frame from which we invoked the
6747 : ;; minibuffer is visible.
6748 0 : (and (minibuffer-window-active-p (selected-window))
6749 11 : (eq frame (window-frame (minibuffer-selected-window)))))
6750 11 : (raise-frame frame)))
6751 :
6752 : ;; FIXME: Not implemented.
6753 : ;; FIXME: By the way, there could be more levels of dedication:
6754 : ;; - `barely' dedicated doesn't prevent reuse of the window, only records that
6755 : ;; the window hasn't been used for something else yet.
6756 : ;; - `soft' (`softly') dedicated only allows reuse when asked explicitly.
6757 : ;; - `strongly' never allows reuse.
6758 : (defvar display-buffer-mark-dedicated nil
6759 : "If non-nil, `display-buffer' marks the windows it creates as dedicated.
6760 : The actual non-nil value of this variable will be copied to the
6761 : `window-dedicated-p' flag.")
6762 :
6763 : (defconst display-buffer--action-function-custom-type
6764 : '(choice :tag "Function"
6765 : (const :tag "--" ignore) ; default for insertion
6766 : (const display-buffer-reuse-window)
6767 : (const display-buffer-pop-up-window)
6768 : (const display-buffer-same-window)
6769 : (const display-buffer-pop-up-frame)
6770 : (const display-buffer-in-child-frame)
6771 : (const display-buffer-below-selected)
6772 : (const display-buffer-at-bottom)
6773 : (const display-buffer-in-previous-window)
6774 : (const display-buffer-use-some-window)
6775 : (const display-buffer-use-some-frame)
6776 : (function :tag "Other function"))
6777 : "Custom type for `display-buffer' action functions.")
6778 :
6779 : (defconst display-buffer--action-custom-type
6780 : `(cons :tag "Action"
6781 : (choice :tag "Action functions"
6782 : ,display-buffer--action-function-custom-type
6783 : (repeat
6784 : :tag "List of functions"
6785 : ,display-buffer--action-function-custom-type))
6786 : (alist :tag "Action arguments"
6787 : :key-type symbol
6788 : :value-type (sexp :tag "Value")))
6789 : "Custom type for `display-buffer' actions.")
6790 :
6791 : (defvar display-buffer-overriding-action '(nil . nil)
6792 : "Overriding action to perform to display a buffer.
6793 : It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a
6794 : function or a list of functions. Each function should accept two
6795 : arguments: a buffer to display and an alist similar to ALIST.
6796 : See `display-buffer' for details.")
6797 : (put 'display-buffer-overriding-action 'risky-local-variable t)
6798 :
6799 : (defcustom display-buffer-alist nil
6800 : "Alist of conditional actions for `display-buffer'.
6801 : This is a list of elements (CONDITION . ACTION), where:
6802 :
6803 : CONDITION is either a regexp matching buffer names, or a
6804 : function that takes two arguments - a buffer name and the
6805 : ACTION argument of `display-buffer' - and returns a boolean.
6806 :
6807 : ACTION is a cons cell (FUNCTION . ALIST), where FUNCTION is a
6808 : function or a list of functions. Each such function should
6809 : accept two arguments: a buffer to display and an alist of the
6810 : same form as ALIST. See `display-buffer' for details.
6811 :
6812 : `display-buffer' scans this alist until it either finds a
6813 : matching regular expression or the function specified by a
6814 : condition returns non-nil. In any of these cases, it adds the
6815 : associated action to the list of actions it will try."
6816 : :type `(alist :key-type
6817 : (choice :tag "Condition"
6818 : regexp
6819 : (function :tag "Matcher function"))
6820 : :value-type ,display-buffer--action-custom-type)
6821 : :risky t
6822 : :version "24.1"
6823 : :group 'windows)
6824 :
6825 : (defcustom display-buffer-base-action '(nil . nil)
6826 : "User-specified default action for `display-buffer'.
6827 : It should be a cons cell (FUNCTION . ALIST), where FUNCTION is a
6828 : function or a list of functions. Each function should accept two
6829 : arguments: a buffer to display and an alist similar to ALIST.
6830 : See `display-buffer' for details."
6831 : :type display-buffer--action-custom-type
6832 : :risky t
6833 : :version "24.1"
6834 : :group 'windows)
6835 :
6836 : (defconst display-buffer-fallback-action
6837 : '((display-buffer--maybe-same-window ;FIXME: why isn't this redundant?
6838 : display-buffer-reuse-window
6839 : display-buffer--maybe-pop-up-frame-or-window
6840 : display-buffer-in-previous-window
6841 : display-buffer-use-some-window
6842 : ;; If all else fails, pop up a new frame.
6843 : display-buffer-pop-up-frame))
6844 : "Default fallback action for `display-buffer'.
6845 : This is the action used by `display-buffer' if no other actions
6846 : specified, e.g. by the user options `display-buffer-alist' or
6847 : `display-buffer-base-action'. See `display-buffer'.")
6848 : (put 'display-buffer-fallback-action 'risky-local-variable t)
6849 :
6850 : (defun display-buffer-assq-regexp (buffer-name alist action)
6851 : "Retrieve ALIST entry corresponding to BUFFER-NAME.
6852 : ACTION is the action argument passed to `display-buffer'."
6853 160 : (catch 'match
6854 160 : (dolist (entry alist)
6855 0 : (let ((key (car entry)))
6856 0 : (when (or (and (stringp key)
6857 0 : (string-match-p key buffer-name))
6858 0 : (and (functionp key)
6859 0 : (funcall key buffer-name action)))
6860 160 : (throw 'match (cdr entry)))))))
6861 :
6862 : (defvar display-buffer--same-window-action
6863 : '(display-buffer-same-window
6864 : (inhibit-same-window . nil))
6865 : "A `display-buffer' action for displaying in the same window.")
6866 : (put 'display-buffer--same-window-action 'risky-local-variable t)
6867 :
6868 : (defvar display-buffer--other-frame-action
6869 : '((display-buffer-reuse-window
6870 : display-buffer-pop-up-frame)
6871 : (reusable-frames . 0)
6872 : (inhibit-same-window . t))
6873 : "A `display-buffer' action for displaying in another frame.")
6874 : (put 'display-buffer--other-frame-action 'risky-local-variable t)
6875 :
6876 : (defun display-buffer (buffer-or-name &optional action frame)
6877 : "Display BUFFER-OR-NAME in some window, without selecting it.
6878 : BUFFER-OR-NAME must be a buffer or the name of an existing
6879 : buffer. Return the window chosen for displaying BUFFER-OR-NAME,
6880 : or nil if no such window is found.
6881 :
6882 : Optional argument ACTION, if non-nil, should specify a display
6883 : action. Its form is described below.
6884 :
6885 : Optional argument FRAME, if non-nil, acts like an additional
6886 : ALIST entry (reusable-frames . FRAME) to the action list of ACTION,
6887 : specifying the frame(s) to search for a window that is already
6888 : displaying the buffer. See `display-buffer-reuse-window'.
6889 :
6890 : If ACTION is non-nil, it should have the form (FUNCTION . ALIST),
6891 : where FUNCTION is either a function or a list of functions, and
6892 : ALIST is an arbitrary association list (alist).
6893 :
6894 : Each such FUNCTION should accept two arguments: the buffer to
6895 : display and an alist. Based on those arguments, it should
6896 : display the buffer and return the window. If the caller is
6897 : prepared to handle the case of not displaying the buffer
6898 : and returning nil from `display-buffer' it should pass
6899 : \(allow-no-window . t) as an element of the ALIST.
6900 :
6901 : The `display-buffer' function builds a function list and an alist
6902 : by combining the functions and alists specified in
6903 : `display-buffer-overriding-action', `display-buffer-alist', the
6904 : ACTION argument, `display-buffer-base-action', and
6905 : `display-buffer-fallback-action' (in order). Then it calls each
6906 : function in the combined function list in turn, passing the
6907 : buffer as the first argument and the combined alist as the second
6908 : argument, until one of the functions returns non-nil.
6909 :
6910 : If ACTION is nil, the function list and the alist are built using
6911 : only the other variables mentioned above.
6912 :
6913 : Available action functions include:
6914 : `display-buffer-same-window'
6915 : `display-buffer-reuse-window'
6916 : `display-buffer-pop-up-frame'
6917 : `display-buffer-in-child-frame'
6918 : `display-buffer-pop-up-window'
6919 : `display-buffer-in-previous-window'
6920 : `display-buffer-use-some-window'
6921 : `display-buffer-use-some-frame'
6922 :
6923 : Recognized alist entries include:
6924 :
6925 : `inhibit-same-window' -- A non-nil value prevents the same
6926 : window from being used for display.
6927 :
6928 : `inhibit-switch-frame' -- A non-nil value prevents any other
6929 : frame from being raised or selected,
6930 : even if the window is displayed there.
6931 :
6932 : `reusable-frames' -- Value specifies frame(s) to search for a
6933 : window that already displays the buffer.
6934 : See `display-buffer-reuse-window'.
6935 :
6936 : `pop-up-frame-parameters' -- Value specifies an alist of frame
6937 : parameters to give a new frame, if
6938 : one is created.
6939 :
6940 : `window-height' -- Value specifies either an integer (the number
6941 : of lines of a new window), a floating point number (the
6942 : fraction of a new window with respect to the height of the
6943 : frame's root window) or a function to be called with one
6944 : argument - a new window. The function is supposed to adjust
6945 : the height of the window; its return value is ignored.
6946 : Suitable functions are `shrink-window-if-larger-than-buffer'
6947 : and `fit-window-to-buffer'.
6948 :
6949 : `window-width' -- Value specifies either an integer (the number
6950 : of columns of a new window), a floating point number (the
6951 : fraction of a new window with respect to the width of the
6952 : frame's root window) or a function to be called with one
6953 : argument - a new window. The function is supposed to adjust
6954 : the width of the window; its return value is ignored.
6955 :
6956 : `allow-no-window' -- A non-nil value indicates readiness for the case
6957 : of not displaying the buffer and FUNCTION can safely return
6958 : a non-window value to suppress displaying.
6959 :
6960 : `preserve-size' -- Value should be either (t . nil) to
6961 : preserve the width of the window, (nil . t) to preserve its
6962 : height or (t . t) to preserve both.
6963 :
6964 : `window-parameters' -- Value specifies an alist of window
6965 : parameters to give the chosen window.
6966 :
6967 : The ACTION argument to `display-buffer' can also have a non-nil
6968 : and non-list value. This means to display the buffer in a window
6969 : other than the selected one, even if it is already displayed in
6970 : the selected window. If called interactively with a prefix
6971 : argument, ACTION is t."
6972 0 : (interactive (list (read-buffer "Display buffer: " (other-buffer))
6973 0 : (if current-prefix-arg t)))
6974 160 : (let ((buffer (if (bufferp buffer-or-name)
6975 160 : buffer-or-name
6976 160 : (get-buffer buffer-or-name)))
6977 : ;; Make sure that when we split windows the old window keeps
6978 : ;; point, bug#14829.
6979 : (split-window-keep-point t)
6980 : ;; Handle the old form of the first argument.
6981 160 : (inhibit-same-window (and action (not (listp action)))))
6982 160 : (unless (listp action) (setq action nil))
6983 160 : (if display-buffer-function
6984 : ;; If `display-buffer-function' is defined, let it do the job.
6985 0 : (funcall display-buffer-function buffer inhibit-same-window)
6986 : ;; Otherwise, use the defined actions.
6987 160 : (let* ((user-action
6988 160 : (display-buffer-assq-regexp
6989 160 : (buffer-name buffer) display-buffer-alist action))
6990 160 : (special-action (display-buffer--special-action buffer))
6991 : ;; Extra actions from the arguments to this function:
6992 : (extra-action
6993 160 : (cons nil (append (if inhibit-same-window
6994 160 : '((inhibit-same-window . t)))
6995 160 : (if frame
6996 160 : `((reusable-frames . ,frame))))))
6997 : ;; Construct action function list and action alist.
6998 160 : (actions (list display-buffer-overriding-action
6999 160 : user-action special-action action extra-action
7000 160 : display-buffer-base-action
7001 160 : display-buffer-fallback-action))
7002 160 : (functions (apply 'append
7003 160 : (mapcar (lambda (x)
7004 1120 : (setq x (car x))
7005 1120 : (if (functionp x) (list x) x))
7006 160 : actions)))
7007 160 : (alist (apply 'append (mapcar 'cdr actions)))
7008 : window)
7009 160 : (unless (buffer-live-p buffer)
7010 160 : (error "Invalid buffer"))
7011 358 : (while (and functions (not window))
7012 198 : (setq window (funcall (car functions) buffer alist)
7013 198 : functions (cdr functions)))
7014 160 : (and (windowp window) window)))))
7015 :
7016 : (defun display-buffer-other-frame (buffer)
7017 : "Display buffer BUFFER preferably in another frame.
7018 : This uses the function `display-buffer' as a subroutine; see
7019 : its documentation for additional customization information."
7020 : (interactive "BDisplay buffer in other frame: ")
7021 0 : (display-buffer buffer display-buffer--other-frame-action t))
7022 :
7023 : ;;; `display-buffer' action functions:
7024 :
7025 : (defun display-buffer-use-some-frame (buffer alist)
7026 : "Display BUFFER in an existing frame that meets a predicate
7027 : \(by default any frame other than the current frame). If
7028 : successful, return the window used; otherwise return nil.
7029 :
7030 : If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
7031 : raising the frame.
7032 :
7033 : If ALIST has a non-nil `frame-predicate' entry, its value is a
7034 : function taking one argument (a frame), returning non-nil if the
7035 : frame is a candidate; this function replaces the default
7036 : predicate.
7037 :
7038 : If ALIST has a non-nil `inhibit-same-window' entry, avoid using
7039 : the currently selected window (only useful with a frame-predicate
7040 : that allows the selected frame)."
7041 0 : (let* ((predicate (or (cdr (assq 'frame-predicate alist))
7042 : (lambda (frame)
7043 0 : (and
7044 0 : (not (eq frame (selected-frame)))
7045 0 : (not (window-dedicated-p
7046 0 : (or
7047 0 : (get-lru-window frame)
7048 0 : (frame-first-window frame)))))
7049 0 : )))
7050 0 : (frame (car (filtered-frame-list predicate)))
7051 0 : (window (and frame (get-lru-window frame nil (cdr (assq 'inhibit-same-window alist))))))
7052 0 : (when window
7053 0 : (prog1
7054 0 : (window--display-buffer
7055 0 : buffer window 'frame alist display-buffer-mark-dedicated)
7056 0 : (unless (cdr (assq 'inhibit-switch-frame alist))
7057 0 : (window--maybe-raise-frame frame))))))
7058 :
7059 : (defun display-buffer-same-window (buffer alist)
7060 : "Display BUFFER in the selected window.
7061 : This fails if ALIST has a non-nil `inhibit-same-window' entry, or
7062 : if the selected window is a minibuffer window or is dedicated to
7063 : another buffer; in that case, return nil. Otherwise, return the
7064 : selected window."
7065 149 : (unless (or (cdr (assq 'inhibit-same-window alist))
7066 149 : (window-minibuffer-p)
7067 149 : (window-dedicated-p))
7068 149 : (window--display-buffer buffer (selected-window) 'reuse alist)))
7069 :
7070 : (defun display-buffer--maybe-same-window (buffer alist)
7071 : "Conditionally display BUFFER in the selected window.
7072 : If `same-window-p' returns non-nil for BUFFER's name, call
7073 : `display-buffer-same-window' and return its value. Otherwise,
7074 : return nil."
7075 11 : (and (same-window-p (buffer-name buffer))
7076 11 : (display-buffer-same-window buffer alist)))
7077 :
7078 : (defun display-buffer-reuse-window (buffer alist)
7079 : "Return a window that is already displaying BUFFER.
7080 : Return nil if no usable window is found.
7081 :
7082 : If ALIST has a non-nil `inhibit-same-window' entry, the selected
7083 : window is not eligible for reuse.
7084 :
7085 : If ALIST contains a `reusable-frames' entry, its value determines
7086 : which frames to search for a reusable window:
7087 : nil -- the selected frame (actually the last non-minibuffer frame)
7088 : A frame -- just that frame
7089 : `visible' -- all visible frames
7090 : 0 -- all frames on the current terminal
7091 : t -- all frames.
7092 :
7093 : If ALIST contains no `reusable-frames' entry, search just the
7094 : selected frame if `display-buffer-reuse-frames' and
7095 : `pop-up-frames' are both nil; search all frames on the current
7096 : terminal if either of those variables is non-nil.
7097 :
7098 : If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
7099 : event that a window on another frame is chosen, avoid raising
7100 : that frame."
7101 11 : (let* ((alist-entry (assq 'reusable-frames alist))
7102 11 : (frames (cond (alist-entry (cdr alist-entry))
7103 11 : ((if (eq pop-up-frames 'graphic-only)
7104 0 : (display-graphic-p)
7105 11 : pop-up-frames)
7106 : 0)
7107 11 : (display-buffer-reuse-frames 0)
7108 11 : (t (last-nonminibuffer-frame))))
7109 11 : (window (if (and (eq buffer (window-buffer))
7110 11 : (not (cdr (assq 'inhibit-same-window alist))))
7111 0 : (selected-window)
7112 11 : (car (delq (selected-window)
7113 11 : (get-buffer-window-list buffer 'nomini
7114 11 : frames))))))
7115 11 : (when (window-live-p window)
7116 0 : (prog1 (window--display-buffer buffer window 'reuse alist)
7117 0 : (unless (cdr (assq 'inhibit-switch-frame alist))
7118 11 : (window--maybe-raise-frame (window-frame window)))))))
7119 :
7120 : (defun display-buffer-reuse-mode-window (buffer alist)
7121 : "Return a window based on the mode of the buffer it displays.
7122 : Display BUFFER in the returned window. Return nil if no usable
7123 : window is found.
7124 :
7125 : If ALIST contains a `mode' entry, its value is a major mode (a
7126 : symbol) or a list of modes. A window is a candidate if it
7127 : displays a buffer that derives from one of the given modes. When
7128 : ALIST contains no `mode' entry, the current major mode of BUFFER
7129 : is used.
7130 :
7131 : The behavior is also controlled by entries for
7132 : `inhibit-same-window', `reusable-frames' and
7133 : `inhibit-switch-frame' as is done in the function
7134 : `display-buffer-reuse-window'."
7135 0 : (let* ((alist-entry (assq 'reusable-frames alist))
7136 0 : (alist-mode-entry (assq 'mode alist))
7137 0 : (frames (cond (alist-entry (cdr alist-entry))
7138 0 : ((if (eq pop-up-frames 'graphic-only)
7139 0 : (display-graphic-p)
7140 0 : pop-up-frames)
7141 : 0)
7142 0 : (display-buffer-reuse-frames 0)
7143 0 : (t (last-nonminibuffer-frame))))
7144 0 : (inhibit-same-window-p (cdr (assq 'inhibit-same-window alist)))
7145 0 : (windows (window-list-1 nil 'nomini frames))
7146 0 : (buffer-mode (with-current-buffer buffer major-mode))
7147 0 : (allowed-modes (if alist-mode-entry
7148 0 : (cdr alist-mode-entry)
7149 0 : buffer-mode))
7150 0 : (curwin (selected-window))
7151 0 : (curframe (selected-frame)))
7152 0 : (unless (listp allowed-modes)
7153 0 : (setq allowed-modes (list allowed-modes)))
7154 0 : (let (same-mode-same-frame
7155 : same-mode-other-frame
7156 : derived-mode-same-frame
7157 : derived-mode-other-frame)
7158 0 : (dolist (window windows)
7159 0 : (let ((mode?
7160 0 : (with-current-buffer (window-buffer window)
7161 0 : (cond ((memq major-mode allowed-modes)
7162 : 'same)
7163 0 : ((derived-mode-p allowed-modes)
7164 0 : 'derived)))))
7165 0 : (when (and mode?
7166 0 : (not (and inhibit-same-window-p
7167 0 : (eq window curwin))))
7168 0 : (push window (if (eq curframe (window-frame window))
7169 0 : (if (eq mode? 'same)
7170 0 : same-mode-same-frame
7171 0 : derived-mode-same-frame)
7172 0 : (if (eq mode? 'same)
7173 0 : same-mode-other-frame
7174 0 : derived-mode-other-frame))))))
7175 0 : (let ((window (car (nconc same-mode-same-frame
7176 0 : same-mode-other-frame
7177 0 : derived-mode-same-frame
7178 0 : derived-mode-other-frame))))
7179 0 : (when (window-live-p window)
7180 0 : (prog1 (window--display-buffer buffer window 'reuse alist)
7181 0 : (unless (cdr (assq 'inhibit-switch-frame alist))
7182 0 : (window--maybe-raise-frame (window-frame window)))))))))
7183 :
7184 : (defun display-buffer--special-action (buffer)
7185 : "Return special display action for BUFFER, if any.
7186 : If `special-display-p' returns non-nil for BUFFER, return an
7187 : appropriate display action involving `special-display-function'.
7188 : See `display-buffer' for the format of display actions."
7189 160 : (and special-display-function
7190 : ;; `special-display-p' returns either t or a list of frame
7191 : ;; parameters to pass to `special-display-function'.
7192 160 : (let ((pars (special-display-p (buffer-name buffer))))
7193 160 : (when pars
7194 0 : (list (list #'display-buffer-reuse-window
7195 : (lambda (buffer _alist)
7196 0 : (funcall special-display-function
7197 160 : buffer (if (listp pars) pars)))))))))
7198 :
7199 : (defun display-buffer-pop-up-frame (buffer alist)
7200 : "Display BUFFER in a new frame.
7201 : This works by calling `pop-up-frame-function'. If successful,
7202 : return the window used; otherwise return nil.
7203 :
7204 : If ALIST has a non-nil `inhibit-switch-frame' entry, avoid
7205 : raising the new frame.
7206 :
7207 : If ALIST has a non-nil `pop-up-frame-parameters' entry, the
7208 : corresponding value is an alist of frame parameters to give the
7209 : new frame."
7210 0 : (let* ((params (cdr (assq 'pop-up-frame-parameters alist)))
7211 0 : (pop-up-frame-alist (append params pop-up-frame-alist))
7212 0 : (fun pop-up-frame-function)
7213 : frame window)
7214 0 : (when (and fun
7215 : ;; Make BUFFER current so `make-frame' will use it as the
7216 : ;; new frame's buffer (Bug#15133).
7217 0 : (with-current-buffer buffer
7218 0 : (setq frame (funcall fun)))
7219 0 : (setq window (frame-selected-window frame)))
7220 0 : (prog1 (window--display-buffer
7221 0 : buffer window 'frame alist display-buffer-mark-dedicated)
7222 0 : (unless (cdr (assq 'inhibit-switch-frame alist))
7223 0 : (window--maybe-raise-frame frame))))))
7224 :
7225 : (defun display-buffer-pop-up-window (buffer alist)
7226 : "Display BUFFER by popping up a new window.
7227 : The new window is created on the selected frame, or in
7228 : `last-nonminibuffer-frame' if no windows can be created there.
7229 : If successful, return the new window; otherwise return nil.
7230 :
7231 : If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
7232 : event that the new window is created on another frame, avoid
7233 : raising the frame."
7234 11 : (let ((frame (or (window--frame-usable-p (selected-frame))
7235 11 : (window--frame-usable-p (last-nonminibuffer-frame))))
7236 : window)
7237 11 : (when (and (or (not (frame-parameter frame 'unsplittable))
7238 : ;; If the selected frame cannot be split, look at
7239 : ;; `last-nonminibuffer-frame'.
7240 0 : (and (eq frame (selected-frame))
7241 0 : (setq frame (last-nonminibuffer-frame))
7242 0 : (window--frame-usable-p frame)
7243 11 : (not (frame-parameter frame 'unsplittable))))
7244 : ;; Attempt to split largest or least recently used window.
7245 11 : (setq window (or (window--try-to-split-window
7246 11 : (get-largest-window frame t) alist)
7247 8 : (window--try-to-split-window
7248 11 : (get-lru-window frame t) alist))))
7249 :
7250 3 : (prog1 (window--display-buffer
7251 3 : buffer window 'window alist display-buffer-mark-dedicated)
7252 3 : (unless (cdr (assq 'inhibit-switch-frame alist))
7253 11 : (window--maybe-raise-frame (window-frame window)))))))
7254 :
7255 : (defun display-buffer--maybe-pop-up-frame-or-window (buffer alist)
7256 : "Try displaying BUFFER based on `pop-up-frames' or `pop-up-windows'.
7257 : If `pop-up-frames' is non-nil (and not `graphic-only' on a
7258 : text-only terminal), try with `display-buffer-pop-up-frame'.
7259 :
7260 : If that cannot be done, and `pop-up-windows' is non-nil, try
7261 : again with `display-buffer-pop-up-window'."
7262 11 : (or (and (if (eq pop-up-frames 'graphic-only)
7263 0 : (display-graphic-p)
7264 11 : pop-up-frames)
7265 11 : (display-buffer-pop-up-frame buffer alist))
7266 11 : (and pop-up-windows
7267 11 : (display-buffer-pop-up-window buffer alist))))
7268 :
7269 : (defun display-buffer-in-child-frame (buffer alist)
7270 : "Display BUFFER in a child frame.
7271 : By default, this either reuses a child frame of the selected
7272 : frame or makes a new child frame of the selected frame. If
7273 : successful, return the window used; otherwise return nil.
7274 :
7275 : If ALIST has a non-nil 'child-frame-parameters' entry, the
7276 : corresponding value is an alist of frame parameters to give the
7277 : new frame. A 'parent-frame' parameter specifying the selected
7278 : frame is provided by default. If the child frame should be or
7279 : become the child of any other frame, a corresponding entry must
7280 : be added to ALIST."
7281 0 : (let* ((parameters
7282 0 : (append
7283 0 : (cdr (assq 'child-frame-parameters alist))
7284 0 : `((parent-frame . ,(selected-frame)))))
7285 0 : (parent (or (assq 'parent-frame parameters)
7286 0 : (selected-frame)))
7287 0 : (share (assq 'share-child-frame parameters))
7288 : share1 frame window)
7289 0 : (with-current-buffer buffer
7290 0 : (when (frame-live-p parent)
7291 0 : (catch 'frame
7292 0 : (dolist (frame1 (frame-list))
7293 0 : (when (eq (frame-parent frame1) parent)
7294 0 : (setq share1 (assq 'share-child-frame
7295 0 : (frame-parameters frame1)))
7296 0 : (when (eq share share1)
7297 0 : (setq frame frame1)
7298 0 : (throw 'frame t))))))
7299 :
7300 0 : (if frame
7301 0 : (setq window (frame-selected-window frame))
7302 0 : (setq frame (make-frame parameters))
7303 0 : (setq window (frame-selected-window frame))))
7304 :
7305 0 : (prog1 (window--display-buffer
7306 0 : buffer window 'frame alist display-buffer-mark-dedicated)
7307 0 : (unless (cdr (assq 'inhibit-switch-frame alist))
7308 0 : (window--maybe-raise-frame frame)))))
7309 :
7310 : (defun display-buffer-below-selected (buffer alist)
7311 : "Try displaying BUFFER in a window below the selected window.
7312 : If there is a window below the selected one and that window
7313 : already displays BUFFER, use that window. Otherwise, try to
7314 : create a new window below the selected one and show BUFFER there.
7315 : If that attempt fails as well and there is a non-dedicated window
7316 : below the selected one, use that window."
7317 0 : (let (window)
7318 0 : (or (and (setq window (window-in-direction 'below))
7319 0 : (eq buffer (window-buffer window))
7320 0 : (window--display-buffer buffer window 'reuse alist))
7321 0 : (and (not (frame-parameter nil 'unsplittable))
7322 0 : (let ((split-height-threshold 0)
7323 : split-width-threshold)
7324 0 : (setq window (window--try-to-split-window
7325 0 : (selected-window) alist)))
7326 0 : (window--display-buffer
7327 0 : buffer window 'window alist display-buffer-mark-dedicated))
7328 0 : (and (setq window (window-in-direction 'below))
7329 0 : (not (window-dedicated-p window))
7330 0 : (window--display-buffer
7331 0 : buffer window 'reuse alist display-buffer-mark-dedicated)))))
7332 :
7333 : (defun display-buffer-at-bottom (buffer alist)
7334 : "Try displaying BUFFER in a window at the bottom of the selected frame.
7335 : This either reuses such a window provided it shows BUFFER
7336 : already, splits a window at the bottom of the frame or the
7337 : frame's root window, or reuses some window at the bottom of the
7338 : selected frame."
7339 0 : (let (bottom-window bottom-window-shows-buffer window)
7340 0 : (walk-window-tree
7341 : (lambda (window)
7342 0 : (cond
7343 0 : ((window-in-direction 'below window))
7344 0 : ((and (not bottom-window-shows-buffer)
7345 0 : (eq buffer (window-buffer window)))
7346 0 : (setq bottom-window-shows-buffer t)
7347 0 : (setq bottom-window window))
7348 0 : ((not bottom-window)
7349 0 : (setq bottom-window window)))
7350 0 : nil nil 'nomini))
7351 0 : (or (and bottom-window-shows-buffer
7352 0 : (window--display-buffer
7353 0 : buffer bottom-window 'reuse alist display-buffer-mark-dedicated))
7354 0 : (and (not (frame-parameter nil 'unsplittable))
7355 0 : (let (split-width-threshold)
7356 0 : (setq window (window--try-to-split-window bottom-window alist)))
7357 0 : (window--display-buffer
7358 0 : buffer window 'window alist display-buffer-mark-dedicated))
7359 0 : (and (not (frame-parameter nil 'unsplittable))
7360 0 : (setq window (split-window-no-error (window-main-window)))
7361 0 : (window--display-buffer
7362 0 : buffer window 'window alist display-buffer-mark-dedicated))
7363 0 : (and (setq window bottom-window)
7364 0 : (not (window-dedicated-p window))
7365 0 : (window--display-buffer
7366 0 : buffer window 'reuse alist display-buffer-mark-dedicated)))))
7367 :
7368 : (defun display-buffer-in-previous-window (buffer alist)
7369 : "Display BUFFER in a window previously showing it.
7370 : If ALIST has a non-nil `inhibit-same-window' entry, the selected
7371 : window is not eligible for reuse.
7372 :
7373 : If ALIST contains a `reusable-frames' entry, its value determines
7374 : which frames to search for a reusable window:
7375 : nil -- the selected frame (actually the last non-minibuffer frame)
7376 : A frame -- just that frame
7377 : `visible' -- all visible frames
7378 : 0 -- all frames on the current terminal
7379 : t -- all frames.
7380 :
7381 : If ALIST contains no `reusable-frames' entry, search just the
7382 : selected frame if `display-buffer-reuse-frames' and
7383 : `pop-up-frames' are both nil; search all frames on the current
7384 : terminal if either of those variables is non-nil.
7385 :
7386 : If ALIST has a `previous-window' entry, the window specified by
7387 : that entry will override any other window found by the methods
7388 : above, even if that window never showed BUFFER before."
7389 8 : (let* ((alist-entry (assq 'reusable-frames alist))
7390 : (inhibit-same-window
7391 8 : (cdr (assq 'inhibit-same-window alist)))
7392 8 : (frames (cond
7393 8 : (alist-entry (cdr alist-entry))
7394 8 : ((if (eq pop-up-frames 'graphic-only)
7395 0 : (display-graphic-p)
7396 8 : pop-up-frames)
7397 : 0)
7398 8 : (display-buffer-reuse-frames 0)
7399 8 : (t (last-nonminibuffer-frame))))
7400 : best-window second-best-window window)
7401 : ;; Scan windows whether they have shown the buffer recently.
7402 8 : (catch 'best
7403 8 : (dolist (window (window-list-1 (frame-first-window) 'nomini frames))
7404 16 : (when (and (assq buffer (window-prev-buffers window))
7405 16 : (not (window-dedicated-p window)))
7406 0 : (if (eq window (selected-window))
7407 0 : (unless inhibit-same-window
7408 0 : (setq second-best-window window))
7409 0 : (setq best-window window)
7410 16 : (throw 'best t)))))
7411 : ;; When ALIST has a `previous-window' entry, that entry may override
7412 : ;; anything we found so far.
7413 8 : (when (and (setq window (cdr (assq 'previous-window alist)))
7414 0 : (window-live-p window)
7415 8 : (not (window-dedicated-p window)))
7416 0 : (if (eq window (selected-window))
7417 0 : (unless inhibit-same-window
7418 0 : (setq second-best-window window))
7419 8 : (setq best-window window)))
7420 : ;; Return best or second best window found.
7421 8 : (when (setq window (or best-window second-best-window))
7422 8 : (window--display-buffer buffer window 'reuse alist))))
7423 :
7424 : (defun display-buffer-use-some-window (buffer alist)
7425 : "Display BUFFER in an existing window.
7426 : Search for a usable window, set that window to the buffer, and
7427 : return the window. If no suitable window is found, return nil.
7428 :
7429 : If ALIST has a non-nil `inhibit-switch-frame' entry, then in the
7430 : event that a window in another frame is chosen, avoid raising
7431 : that frame."
7432 8 : (let* ((not-this-window (cdr (assq 'inhibit-same-window alist)))
7433 8 : (frame (or (window--frame-usable-p (selected-frame))
7434 8 : (window--frame-usable-p (last-nonminibuffer-frame))))
7435 : (window
7436 : ;; Reuse an existing window.
7437 8 : (or (get-lru-window frame nil not-this-window)
7438 0 : (let ((window (get-buffer-window buffer 'visible)))
7439 0 : (unless (and not-this-window
7440 0 : (eq window (selected-window)))
7441 0 : window))
7442 0 : (get-largest-window 'visible nil not-this-window)
7443 0 : (let ((window (get-buffer-window buffer 0)))
7444 0 : (unless (and not-this-window
7445 0 : (eq window (selected-window)))
7446 0 : window))
7447 8 : (get-largest-window 0 nil not-this-window)))
7448 8 : (quit-restore (and (window-live-p window)
7449 8 : (window-parameter window 'quit-restore)))
7450 8 : (quad (nth 1 quit-restore)))
7451 8 : (when (window-live-p window)
7452 : ;; If the window was used by `display-buffer' before, try to
7453 : ;; resize it to its old height but don't signal an error.
7454 8 : (when (and (listp quad)
7455 6 : (integerp (nth 3 quad))
7456 8 : (> (nth 3 quad) (window-total-height window)))
7457 0 : (condition-case nil
7458 0 : (window-resize window (- (nth 3 quad) (window-total-height window)))
7459 8 : (error nil)))
7460 :
7461 8 : (prog1
7462 8 : (window--display-buffer buffer window 'reuse alist)
7463 8 : (window--even-window-sizes window)
7464 8 : (unless (cdr (assq 'inhibit-switch-frame alist))
7465 8 : (window--maybe-raise-frame (window-frame window)))))))
7466 :
7467 : (defun display-buffer-no-window (_buffer alist)
7468 : "Display BUFFER in no window.
7469 : If ALIST has a non-nil `allow-no-window' entry, then don't display
7470 : a window at all. This makes possible to override the default action
7471 : and avoid displaying the buffer. It is assumed that when the caller
7472 : specifies a non-nil `allow-no-window' then it can handle a nil value
7473 : returned from `display-buffer' in this case."
7474 0 : (when (cdr (assq 'allow-no-window alist))
7475 0 : 'fail))
7476 :
7477 : ;;; Display + selection commands:
7478 : (defun pop-to-buffer (buffer-or-name &optional action norecord)
7479 : "Display buffer specified by BUFFER-OR-NAME and select its window.
7480 : BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
7481 : If it is a string not naming an existent buffer, create a buffer
7482 : with that name. If BUFFER-OR-NAME is nil, choose some other
7483 : buffer. In either case, make that buffer current and return it.
7484 :
7485 : This uses `display-buffer' as a subroutine. The optional ACTION
7486 : argument is passed to `display-buffer' as its ACTION argument.
7487 : See `display-buffer' for more information. ACTION is t if called
7488 : interactively with a prefix argument, which means to pop to a
7489 : window other than the selected one even if the buffer is already
7490 : displayed in the selected window.
7491 :
7492 : If a suitable window is found, select that window. If it is not
7493 : on the selected frame, raise that window's frame and give it
7494 : input focus.
7495 :
7496 : Optional third arg NORECORD non-nil means do not put this buffer
7497 : at the front of the list of recently selected ones."
7498 0 : (interactive (list (read-buffer "Pop to buffer: " (other-buffer))
7499 0 : (if current-prefix-arg t)))
7500 150 : (let* ((buffer (window-normalize-buffer-to-switch-to buffer-or-name))
7501 150 : (old-frame (selected-frame))
7502 150 : (window (display-buffer buffer action)))
7503 : ;; Don't assume that `display-buffer' has supplied us with a window
7504 : ;; (Bug#24332).
7505 150 : (if window
7506 150 : (let ((frame (window-frame window)))
7507 : ;; If we chose another frame, make sure it gets input focus.
7508 150 : (unless (eq frame old-frame)
7509 150 : (select-frame-set-input-focus frame norecord))
7510 : ;; Make sure the window is selected (Bug#8615), (Bug#6954)
7511 150 : (select-window window norecord))
7512 : ;; If `display-buffer' failed to supply a window, just make the
7513 : ;; buffer current.
7514 150 : (set-buffer buffer))
7515 : ;; Return BUFFER even when we got no window.
7516 150 : buffer))
7517 :
7518 : (defun pop-to-buffer-same-window (buffer &optional norecord)
7519 : "Select buffer BUFFER in some window, preferably the same one.
7520 : BUFFER may be a buffer, a string (a buffer name), or nil. If it
7521 : is a string not naming an existent buffer, create a buffer with
7522 : that name. If BUFFER is nil, choose some other buffer. Return
7523 : the buffer.
7524 :
7525 : Optional argument NORECORD, if non-nil means do not put this
7526 : buffer at the front of the list of recently selected ones.
7527 :
7528 : Unlike `pop-to-buffer', this function prefers using the selected
7529 : window over popping up a new window or frame."
7530 149 : (pop-to-buffer buffer display-buffer--same-window-action norecord))
7531 :
7532 : (defun read-buffer-to-switch (prompt)
7533 : "Read the name of a buffer to switch to, prompting with PROMPT.
7534 : Return the name of the buffer as a string.
7535 :
7536 : This function is intended for the `switch-to-buffer' family of
7537 : commands since these need to omit the name of the current buffer
7538 : from the list of completions and default values."
7539 0 : (let ((rbts-completion-table (internal-complete-buffer-except)))
7540 0 : (minibuffer-with-setup-hook
7541 : (lambda ()
7542 0 : (setq minibuffer-completion-table rbts-completion-table)
7543 : ;; Since rbts-completion-table is built dynamically, we
7544 : ;; can't just add it to the default value of
7545 : ;; icomplete-with-completion-tables, so we add it
7546 : ;; here manually.
7547 0 : (if (and (boundp 'icomplete-with-completion-tables)
7548 0 : (listp icomplete-with-completion-tables))
7549 0 : (set (make-local-variable 'icomplete-with-completion-tables)
7550 0 : (cons rbts-completion-table
7551 0 : icomplete-with-completion-tables))))
7552 0 : (read-buffer prompt (other-buffer (current-buffer))
7553 0 : (confirm-nonexistent-file-or-buffer)))))
7554 :
7555 : (defun window-normalize-buffer-to-switch-to (buffer-or-name)
7556 : "Normalize BUFFER-OR-NAME argument of buffer switching functions.
7557 : If BUFFER-OR-NAME is nil, return the buffer returned by
7558 : `other-buffer'. Else, if a buffer specified by BUFFER-OR-NAME
7559 : exists, return that buffer. If no such buffer exists, create a
7560 : buffer with the name BUFFER-OR-NAME and return that buffer."
7561 150 : (if buffer-or-name
7562 150 : (or (get-buffer buffer-or-name)
7563 0 : (let ((buffer (get-buffer-create buffer-or-name)))
7564 0 : (set-buffer-major-mode buffer)
7565 150 : buffer))
7566 150 : (other-buffer)))
7567 :
7568 : (defcustom switch-to-buffer-preserve-window-point t
7569 : "If non-nil, `switch-to-buffer' tries to preserve `window-point'.
7570 : If this is nil, `switch-to-buffer' displays the buffer at that
7571 : buffer's `point'. If this is `already-displayed', it tries to
7572 : display the buffer at its previous position in the selected
7573 : window, provided the buffer is currently displayed in some other
7574 : window on any visible or iconified frame. If this is t, it
7575 : unconditionally tries to display the buffer at its previous
7576 : position in the selected window.
7577 :
7578 : This variable is ignored if the buffer is already displayed in
7579 : the selected window or never appeared in it before, or if
7580 : `switch-to-buffer' calls `pop-to-buffer' to display the buffer."
7581 : :type '(choice
7582 : (const :tag "Never" nil)
7583 : (const :tag "If already displayed elsewhere" already-displayed)
7584 : (const :tag "Always" t))
7585 : :group 'windows
7586 : :version "26.1")
7587 :
7588 : (defcustom switch-to-buffer-in-dedicated-window nil
7589 : "Allow switching to buffer in strongly dedicated windows.
7590 : If non-nil, allow `switch-to-buffer' to proceed when called
7591 : interactively and the selected window is strongly dedicated to
7592 : its buffer.
7593 :
7594 : The following values are recognized:
7595 :
7596 : nil - disallow switching; signal an error
7597 :
7598 : prompt - prompt user whether to allow switching
7599 :
7600 : pop - perform `pop-to-buffer' instead
7601 :
7602 : t - undedicate selected window and switch
7603 :
7604 : When called non-interactively, `switch-to-buffer' always signals
7605 : an error when the selected window is dedicated to its buffer and
7606 : FORCE-SAME-WINDOW is non-nil."
7607 : :type '(choice
7608 : (const :tag "Disallow" nil)
7609 : (const :tag "Prompt" prompt)
7610 : (const :tag "Pop" pop)
7611 : (const :tag "Allow" t))
7612 : :group 'windows
7613 : :version "25.1")
7614 :
7615 : (defun switch-to-buffer (buffer-or-name &optional norecord force-same-window)
7616 : "Display buffer BUFFER-OR-NAME in the selected window.
7617 :
7618 : WARNING: This is NOT the way to work on another buffer temporarily
7619 : within a Lisp program! Use `set-buffer' instead. That avoids
7620 : messing with the window-buffer correspondences.
7621 :
7622 : If the selected window cannot display the specified buffer
7623 : because it is a minibuffer window or strongly dedicated to
7624 : another buffer, call `pop-to-buffer' to select the buffer in
7625 : another window. In interactive use, if the selected window is
7626 : strongly dedicated to its buffer, the value of the option
7627 : `switch-to-buffer-in-dedicated-window' specifies how to proceed.
7628 :
7629 : If called interactively, read the buffer name using the
7630 : minibuffer. The variable `confirm-nonexistent-file-or-buffer'
7631 : determines whether to request confirmation before creating a new
7632 : buffer.
7633 :
7634 : BUFFER-OR-NAME may be a buffer, a string (a buffer name), or nil.
7635 : If BUFFER-OR-NAME is a string that does not identify an existing
7636 : buffer, create a buffer with that name. If BUFFER-OR-NAME is
7637 : nil, switch to the buffer returned by `other-buffer'.
7638 :
7639 : If optional argument NORECORD is non-nil, do not put the buffer
7640 : at the front of the buffer list, and do not make the window
7641 : displaying it the most recently selected one.
7642 :
7643 : If optional argument FORCE-SAME-WINDOW is non-nil, the buffer
7644 : must be displayed in the selected window when called
7645 : non-interactively; if that is impossible, signal an error rather
7646 : than calling `pop-to-buffer'.
7647 :
7648 : The option `switch-to-buffer-preserve-window-point' can be used
7649 : to make the buffer appear at its last position in the selected
7650 : window.
7651 :
7652 : Return the buffer switched to."
7653 : (interactive
7654 0 : (let ((force-same-window
7655 0 : (cond
7656 0 : ((window-minibuffer-p) nil)
7657 0 : ((not (eq (window-dedicated-p) t)) 'force-same-window)
7658 0 : ((pcase switch-to-buffer-in-dedicated-window
7659 0 : (`nil (user-error
7660 0 : "Cannot switch buffers in a dedicated window"))
7661 : (`prompt
7662 0 : (if (y-or-n-p
7663 0 : (format "Window is dedicated to %s; undedicate it"
7664 0 : (window-buffer)))
7665 0 : (progn
7666 0 : (set-window-dedicated-p nil nil)
7667 0 : 'force-same-window)
7668 0 : (user-error
7669 0 : "Cannot switch buffers in a dedicated window")))
7670 : (`pop nil)
7671 0 : (_ (set-window-dedicated-p nil nil) 'force-same-window))))))
7672 0 : (list (read-buffer-to-switch "Switch to buffer: ") nil force-same-window)))
7673 0 : (let ((buffer (window-normalize-buffer-to-switch-to buffer-or-name)))
7674 0 : (cond
7675 : ;; Don't call set-window-buffer if it's not needed since it
7676 : ;; might signal an error (e.g. if the window is dedicated).
7677 0 : ((eq buffer (window-buffer)))
7678 0 : ((window-minibuffer-p)
7679 0 : (if force-same-window
7680 0 : (user-error "Cannot switch buffers in minibuffer window")
7681 0 : (pop-to-buffer buffer norecord)))
7682 0 : ((eq (window-dedicated-p) t)
7683 0 : (if force-same-window
7684 0 : (user-error "Cannot switch buffers in a dedicated window")
7685 0 : (pop-to-buffer buffer norecord)))
7686 : (t
7687 0 : (let* ((entry (assq buffer (window-prev-buffers)))
7688 0 : (displayed (and (eq switch-to-buffer-preserve-window-point
7689 0 : 'already-displayed)
7690 0 : (get-buffer-window buffer 0))))
7691 0 : (set-window-buffer nil buffer)
7692 0 : (when (and entry
7693 0 : (or (eq switch-to-buffer-preserve-window-point t)
7694 0 : displayed))
7695 : ;; Try to restore start and point of buffer in the selected
7696 : ;; window (Bug#4041).
7697 0 : (set-window-start (selected-window) (nth 1 entry) t)
7698 0 : (set-window-point nil (nth 2 entry))))))
7699 :
7700 0 : (unless norecord
7701 0 : (select-window (selected-window)))
7702 0 : (set-buffer buffer)))
7703 :
7704 : (defun switch-to-buffer-other-window (buffer-or-name &optional norecord)
7705 : "Select the buffer specified by BUFFER-OR-NAME in another window.
7706 : BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
7707 : nil. Return the buffer switched to.
7708 :
7709 : If called interactively, prompt for the buffer name using the
7710 : minibuffer. The variable `confirm-nonexistent-file-or-buffer'
7711 : determines whether to request confirmation before creating a new
7712 : buffer.
7713 :
7714 : If BUFFER-OR-NAME is a string and does not identify an existing
7715 : buffer, create a new buffer with that name. If BUFFER-OR-NAME is
7716 : nil, switch to the buffer returned by `other-buffer'.
7717 :
7718 : Optional second argument NORECORD non-nil means do not put this
7719 : buffer at the front of the list of recently selected ones.
7720 :
7721 : This uses the function `display-buffer' as a subroutine; see its
7722 : documentation for additional customization information."
7723 : (interactive
7724 0 : (list (read-buffer-to-switch "Switch to buffer in other window: ")))
7725 0 : (let ((pop-up-windows t))
7726 0 : (pop-to-buffer buffer-or-name t norecord)))
7727 :
7728 : (defun switch-to-buffer-other-frame (buffer-or-name &optional norecord)
7729 : "Switch to buffer BUFFER-OR-NAME in another frame.
7730 : BUFFER-OR-NAME may be a buffer, a string (a buffer name), or
7731 : nil. Return the buffer switched to.
7732 :
7733 : If called interactively, prompt for the buffer name using the
7734 : minibuffer. The variable `confirm-nonexistent-file-or-buffer'
7735 : determines whether to request confirmation before creating a new
7736 : buffer.
7737 :
7738 : If BUFFER-OR-NAME is a string and does not identify an existing
7739 : buffer, create a new buffer with that name. If BUFFER-OR-NAME is
7740 : nil, switch to the buffer returned by `other-buffer'.
7741 :
7742 : Optional second arg NORECORD non-nil means do not put this
7743 : buffer at the front of the list of recently selected ones.
7744 :
7745 : This uses the function `display-buffer' as a subroutine; see its
7746 : documentation for additional customization information."
7747 : (interactive
7748 0 : (list (read-buffer-to-switch "Switch to buffer in other frame: ")))
7749 0 : (pop-to-buffer buffer-or-name display-buffer--other-frame-action norecord))
7750 :
7751 : (defun set-window-text-height (window height)
7752 : "Set the height in lines of the text display area of WINDOW to HEIGHT.
7753 : WINDOW must be a live window and defaults to the selected one.
7754 : HEIGHT doesn't include the mode line or header line, if any, or
7755 : any partial-height lines in the text display area.
7756 :
7757 : Note that the current implementation of this function cannot
7758 : always set the height exactly, but attempts to be conservative,
7759 : by allocating more lines than are actually needed in the case
7760 : where some error may be present."
7761 0 : (setq window (window-normalize-window window t))
7762 0 : (let ((delta (- height (window-text-height window))))
7763 0 : (unless (zerop delta)
7764 : ;; Setting window-min-height to a value like 1 can lead to very
7765 : ;; bizarre displays because it also allows Emacs to make *other*
7766 : ;; windows one line tall, which means that there's no more space
7767 : ;; for the mode line.
7768 0 : (let ((window-min-height (min 2 height)))
7769 0 : (window-resize window delta)))))
7770 :
7771 : (defun enlarge-window-horizontally (delta)
7772 : "Make selected window DELTA columns wider.
7773 : Interactively, if no argument is given, make selected window one
7774 : column wider."
7775 : (interactive "p")
7776 0 : (enlarge-window delta t))
7777 :
7778 : (defun shrink-window-horizontally (delta)
7779 : "Make selected window DELTA columns narrower.
7780 : Interactively, if no argument is given, make selected window one
7781 : column narrower."
7782 : (interactive "p")
7783 0 : (shrink-window delta t))
7784 :
7785 : (defun count-screen-lines (&optional beg end count-final-newline window)
7786 : "Return the number of screen lines in the region.
7787 : The number of screen lines may be different from the number of actual lines,
7788 : due to line breaking, display table, etc.
7789 :
7790 : Optional arguments BEG and END default to `point-min' and `point-max'
7791 : respectively.
7792 :
7793 : If region ends with a newline, ignore it unless optional third argument
7794 : COUNT-FINAL-NEWLINE is non-nil.
7795 :
7796 : The optional fourth argument WINDOW specifies the window used for obtaining
7797 : parameters such as width, horizontal scrolling, and so on. The default is
7798 : to use the selected window's parameters.
7799 :
7800 : Like `vertical-motion', `count-screen-lines' always uses the current buffer,
7801 : regardless of which buffer is displayed in WINDOW. This makes possible to use
7802 : `count-screen-lines' in any buffer, whether or not it is currently displayed
7803 : in some window."
7804 2 : (unless beg
7805 2 : (setq beg (point-min)))
7806 2 : (unless end
7807 2 : (setq end (point-max)))
7808 2 : (if (= beg end)
7809 : 0
7810 2 : (save-excursion
7811 2 : (save-restriction
7812 2 : (widen)
7813 2 : (narrow-to-region (min beg end)
7814 2 : (if (and (not count-final-newline)
7815 2 : (= ?\n (char-before (max beg end))))
7816 2 : (1- (max beg end))
7817 2 : (max beg end)))
7818 2 : (goto-char (point-min))
7819 2 : (1+ (vertical-motion (buffer-size) window))))))
7820 :
7821 : (defun window-buffer-height (window)
7822 : "Return the height (in screen lines) of the buffer that WINDOW is displaying.
7823 : WINDOW must be a live window and defaults to the selected one."
7824 0 : (setq window (window-normalize-window window t))
7825 0 : (with-current-buffer (window-buffer window)
7826 0 : (max 1
7827 0 : (count-screen-lines (point-min) (point-max)
7828 : ;; If buffer ends with a newline, ignore it when
7829 : ;; counting height unless point is after it.
7830 0 : (eobp)
7831 0 : window))))
7832 :
7833 : ;;; Resizing windows and frames to fit their contents exactly.
7834 : (defcustom fit-window-to-buffer-horizontally nil
7835 : "Non-nil means `fit-window-to-buffer' can resize windows horizontally.
7836 : If this is nil, `fit-window-to-buffer' never resizes windows
7837 : horizontally. If this is `only', it can resize windows
7838 : horizontally only. Any other value means `fit-window-to-buffer'
7839 : can resize windows in both dimensions."
7840 : :type 'boolean
7841 : :version "24.4"
7842 : :group 'help)
7843 :
7844 : ;; `fit-frame-to-buffer' eventually wants to know the real frame sizes
7845 : ;; counting title bar and outer borders.
7846 : (defcustom fit-frame-to-buffer nil
7847 : "Non-nil means `fit-window-to-buffer' can fit a frame to its buffer.
7848 : A frame is fit if and only if its root window is a live window
7849 : and this option is non-nil. If this is `horizontally', frames
7850 : are resized horizontally only. If this is `vertically', frames
7851 : are resized vertically only. Any other non-nil value means
7852 : frames can be resized in both dimensions."
7853 : :type 'boolean
7854 : :version "24.4"
7855 : :group 'help)
7856 :
7857 : (defcustom fit-frame-to-buffer-margins '(nil nil nil nil)
7858 : "Margins around frame for `fit-frame-to-buffer'.
7859 : This specifies the numbers of pixels to be left free on the left,
7860 : above, on the right, and below a frame fitted to its buffer. Set
7861 : this to avoid obscuring other desktop objects like the taskbar.
7862 : The default is nil for each side, which means to not add margins.
7863 :
7864 : The value specified here can be overridden for a specific frame
7865 : by that frame's `fit-frame-to-buffer-margins' parameter, if
7866 : present. See also `fit-frame-to-buffer-sizes'."
7867 : :version "24.4"
7868 : :type '(list
7869 : (choice
7870 : :tag "Left"
7871 : :value nil
7872 : :format "%[LeftMargin%] %v "
7873 : (const :tag "None" :format "%t" nil)
7874 : (integer :tag "Pixels" :size 5))
7875 : (choice
7876 : :tag "Top"
7877 : :value nil
7878 : :format "%[TopMargin%] %v "
7879 : (const :tag "None" :format "%t" nil)
7880 : (integer :tag "Pixels" :size 5))
7881 : (choice
7882 : :tag "Right"
7883 : :value nil
7884 : :format "%[RightMargin%] %v "
7885 : (const :tag "None" :format "%t" nil)
7886 : (integer :tag "Pixels" :size 5))
7887 : (choice
7888 : :tag "Bottom"
7889 : :value nil
7890 : :format "%[BottomMargin%] %v "
7891 : (const :tag "None" :format "%t" nil)
7892 : (integer :tag "Pixels" :size 5)))
7893 : :group 'help)
7894 :
7895 : (defcustom fit-frame-to-buffer-sizes '(nil nil nil nil)
7896 : "Size boundaries of frame for `fit-frame-to-buffer'.
7897 : This list specifies the total maximum and minimum lines and
7898 : maximum and minimum columns of the root window of any frame that
7899 : shall be fit to its buffer. If any of these values is non-nil,
7900 : it overrides the corresponding argument of `fit-frame-to-buffer'.
7901 :
7902 : On window systems where the menubar can wrap, fitting a frame to
7903 : its buffer may swallow the last line(s). Specifying an
7904 : appropriate minimum width value here can avoid such wrapping.
7905 :
7906 : See also `fit-frame-to-buffer-margins'."
7907 : :version "24.4"
7908 : :type '(list
7909 : (choice
7910 : :tag "Maximum Height"
7911 : :value nil
7912 : :format "%[MaxHeight%] %v "
7913 : (const :tag "None" :format "%t" nil)
7914 : (integer :tag "Lines" :size 5))
7915 : (choice
7916 : :tag "Minimum Height"
7917 : :value nil
7918 : :format "%[MinHeight%] %v "
7919 : (const :tag "None" :format "%t" nil)
7920 : (integer :tag "Lines" :size 5))
7921 : (choice
7922 : :tag "Maximum Width"
7923 : :value nil
7924 : :format "%[MaxWidth%] %v "
7925 : (const :tag "None" :format "%t" nil)
7926 : (integer :tag "Columns" :size 5))
7927 : (choice
7928 : :tag "Minimum Width"
7929 : :value nil
7930 : :format "%[MinWidth%] %v\n"
7931 : (const :tag "None" :format "%t" nil)
7932 : (integer :tag "Columns" :size 5)))
7933 : :group 'help)
7934 :
7935 : (declare-function x-display-pixel-height "xfns.c" (&optional terminal))
7936 :
7937 : (defun window--sanitize-margin (margin left right)
7938 : "Return MARGIN if it's a number between LEFT and RIGHT.
7939 : Return 0 otherwise."
7940 0 : (if (and (numberp margin)
7941 0 : (<= left (- right margin)) (<= margin right))
7942 0 : margin
7943 0 : 0))
7944 :
7945 : (declare-function tool-bar-height "xdisp.c" (&optional frame pixelwise))
7946 :
7947 : (defun fit-frame-to-buffer (&optional frame max-height min-height max-width min-width only)
7948 : "Adjust size of FRAME to display the contents of its buffer exactly.
7949 : FRAME can be any live frame and defaults to the selected one.
7950 : Fit only if FRAME's root window is live. MAX-HEIGHT, MIN-HEIGHT,
7951 : MAX-WIDTH and MIN-WIDTH specify bounds on the new total size of
7952 : FRAME's root window. MIN-HEIGHT and MIN-WIDTH default to the values of
7953 : `window-min-height' and `window-min-width' respectively.
7954 :
7955 : If the optional argument ONLY is `vertically', resize the frame
7956 : vertically only. If ONLY is `horizontally', resize the frame
7957 : horizontally only.
7958 :
7959 : The new position and size of FRAME can be additionally determined
7960 : by customizing the options `fit-frame-to-buffer-sizes' and
7961 : `fit-frame-to-buffer-margins' or setting the corresponding
7962 : parameters of FRAME."
7963 : (interactive)
7964 0 : (unless (fboundp 'display-monitor-attributes-list)
7965 0 : (user-error "Cannot resize frame in non-graphic Emacs"))
7966 0 : (setq frame (window-normalize-frame frame))
7967 0 : (when (window-live-p (frame-root-window frame))
7968 0 : (let* ((char-width (frame-char-width frame))
7969 0 : (char-height (frame-char-height frame))
7970 : ;; WINDOW is FRAME's root window.
7971 0 : (window (frame-root-window frame))
7972 0 : (parent (frame-parent frame))
7973 : (monitor-attributes
7974 0 : (unless parent
7975 0 : (car (display-monitor-attributes-list
7976 0 : (frame-parameter frame 'display)))))
7977 : ;; FRAME'S parent or display sizes. Used in connection
7978 : ;; with margins.
7979 : (geometry
7980 0 : (unless parent
7981 0 : (cdr (assq 'geometry monitor-attributes))))
7982 : (parent-or-display-width
7983 0 : (if parent
7984 0 : (frame-native-width parent)
7985 0 : (- (nth 2 geometry) (nth 0 geometry))))
7986 : (parent-or-display-height
7987 0 : (if parent
7988 0 : (frame-native-height parent)
7989 0 : (- (nth 3 geometry) (nth 1 geometry))))
7990 : ;; FRAME'S parent or workarea sizes. Used when no margins
7991 : ;; are specified.
7992 : (parent-or-workarea
7993 0 : (if parent
7994 0 : `(0 0 ,parent-or-display-width ,parent-or-display-height)
7995 0 : (cdr (assq 'workarea monitor-attributes))))
7996 : ;; The outer size of FRAME. Needed to calculate the
7997 : ;; margins around the root window's body that have to
7998 : ;; remain untouched by fitting.
7999 0 : (outer-edges (frame-edges frame 'outer-edges))
8000 0 : (outer-width (if outer-edges
8001 0 : (- (nth 2 outer-edges) (nth 0 outer-edges))
8002 : ;; A poor guess.
8003 0 : (frame-pixel-width frame)))
8004 0 : (outer-height (if outer-edges
8005 0 : (- (nth 3 outer-edges) (nth 1 outer-edges))
8006 : ;; Another poor guess.
8007 0 : (frame-pixel-height frame)))
8008 : ;; The text size of of FRAME. Needed to specify FRAME's
8009 : ;; text size after the root window's body's new sizes have
8010 : ;; been calculated.
8011 0 : (text-width (frame-text-width frame))
8012 0 : (text-height (frame-text-height frame))
8013 : ;; WINDOW's body size.
8014 0 : (body-width (window-body-width window t))
8015 0 : (body-height (window-body-height window t))
8016 : ;; The difference between FRAME's outer size and WINDOW's
8017 : ;; body size.
8018 0 : (outer-minus-body-width (- outer-width body-width))
8019 0 : (outer-minus-body-height (- outer-height body-height))
8020 : ;; The difference between FRAME's text size and WINDOW's
8021 : ;; body size (these values "should" be positive).
8022 0 : (text-minus-body-width (- text-width body-width))
8023 0 : (text-minus-body-height (- text-height body-height))
8024 : ;; The current position of FRAME.
8025 0 : (position (frame-position frame))
8026 0 : (left (car position))
8027 0 : (top (cdr position))
8028 : ;; The margins specified for FRAME. These represent pixel
8029 : ;; offsets from the left, top, right and bottom edge of the
8030 : ;; display or FRAME's parent's native rectangle and have to
8031 : ;; take care of the display's taskbar and other obstacles.
8032 : ;; If they are unspecified, constrain the resulting frame
8033 : ;; to its workarea or the parent frame's native rectangle.
8034 0 : (margins (or (frame-parameter frame 'fit-frame-to-buffer-margins)
8035 0 : fit-frame-to-buffer-margins))
8036 : ;; Convert margins into pixel offsets from the left-top
8037 : ;; corner of FRAME's display or parent.
8038 0 : (left-margin (if (nth 0 margins)
8039 0 : (window--sanitize-margin
8040 0 : (nth 0 margins) 0 parent-or-display-width)
8041 0 : (nth 0 parent-or-workarea)))
8042 0 : (top-margin (if (nth 1 margins)
8043 0 : (window--sanitize-margin
8044 0 : (nth 1 margins) 0 parent-or-display-height)
8045 0 : (nth 1 parent-or-workarea)))
8046 0 : (right-margin (if (nth 2 margins)
8047 0 : (- parent-or-display-width
8048 0 : (window--sanitize-margin
8049 0 : (nth 2 margins) left-margin
8050 0 : parent-or-display-width))
8051 0 : (nth 2 parent-or-workarea)))
8052 0 : (bottom-margin (if (nth 3 margins)
8053 0 : (- parent-or-display-height
8054 0 : (window--sanitize-margin
8055 0 : (nth 3 margins) top-margin
8056 0 : parent-or-display-height))
8057 0 : (nth 3 parent-or-workarea)))
8058 : ;; Minimum and maximum sizes specified for FRAME.
8059 0 : (sizes (or (frame-parameter frame 'fit-frame-to-buffer-sizes)
8060 0 : fit-frame-to-buffer-sizes))
8061 : ;; Calculate the minimum and maximum pixel sizes of FRAME
8062 : ;; from the values provided by the MAX-HEIGHT, MIN-HEIGHT,
8063 : ;; MAX-WIDTH and MIN-WIDTH arguments or, if these are nil,
8064 : ;; from those provided by `fit-frame-to-buffer-sizes'.
8065 : (max-height
8066 0 : (min
8067 0 : (cond
8068 0 : ((numberp max-height) (* max-height char-height))
8069 0 : ((numberp (nth 0 sizes)) (* (nth 0 sizes) char-height))
8070 0 : (t parent-or-display-height))
8071 : ;; The following is the maximum height that fits into the
8072 : ;; top and bottom margins.
8073 0 : (max (- bottom-margin top-margin outer-minus-body-height))))
8074 : (min-height
8075 0 : (cond
8076 0 : ((numberp min-height) (* min-height char-height))
8077 0 : ((numberp (nth 1 sizes)) (* (nth 1 sizes) char-height))
8078 0 : (t (window-min-size window nil nil t))))
8079 : (max-width
8080 0 : (min
8081 0 : (cond
8082 0 : ((numberp max-width) (* max-width char-width))
8083 0 : ((numberp (nth 2 sizes)) (* (nth 2 sizes) char-width))
8084 0 : (t parent-or-display-width))
8085 : ;; The following is the maximum width that fits into the
8086 : ;; left and right margins.
8087 0 : (max (- right-margin left-margin outer-minus-body-width))))
8088 : (min-width
8089 0 : (cond
8090 0 : ((numberp min-width) (* min-width char-width))
8091 0 : ((numberp (nth 3 sizes)) (nth 3 sizes))
8092 0 : (t (window-min-size window t nil t))))
8093 : ;; Note: Currently, for a new frame the sizes of the header
8094 : ;; and mode line may be estimated incorrectly
8095 : (size
8096 0 : (window-text-pixel-size window t t max-width max-height))
8097 0 : (width (max (car size) min-width))
8098 0 : (height (max (cdr size) min-height)))
8099 : ;; Don't change height or width when the window's size is fixed
8100 : ;; in either direction or ONLY forbids it.
8101 0 : (cond
8102 0 : ((or (eq window-size-fixed 'width) (eq only 'vertically))
8103 0 : (setq width nil))
8104 0 : ((or (eq window-size-fixed 'height) (eq only 'horizontally))
8105 0 : (setq height nil)))
8106 : ;; Fit width to constraints.
8107 0 : (when width
8108 0 : (unless frame-resize-pixelwise
8109 : ;; Round to character sizes.
8110 0 : (setq width (* (/ (+ width char-width -1) char-width)
8111 0 : char-width)))
8112 : ;; The new outer width (in pixels).
8113 0 : (setq outer-width (+ width outer-minus-body-width))
8114 : ;; Maybe move FRAME to preserve margins.
8115 0 : (let ((right (+ left outer-width)))
8116 0 : (cond
8117 0 : ((> right right-margin)
8118 : ;; Move frame to left.
8119 0 : (setq left (max left-margin (- left (- right right-margin)))))
8120 0 : ((< left left-margin)
8121 : ;; Move frame to right.
8122 0 : (setq left left-margin)))))
8123 : ;; Fit height to constraints.
8124 0 : (when height
8125 0 : (unless frame-resize-pixelwise
8126 0 : (setq height (* (/ (+ height char-height -1) char-height)
8127 0 : char-height)))
8128 : ;; The new outer height.
8129 0 : (setq outer-height (+ height outer-minus-body-height))
8130 : ;; Preserve margins.
8131 0 : (let ((bottom (+ top outer-height)))
8132 0 : (cond
8133 0 : ((> bottom bottom-margin)
8134 : ;; Move frame up.
8135 0 : (setq top (max top-margin (- top (- bottom bottom-margin)))))
8136 0 : ((< top top-margin)
8137 : ;; Move frame down.
8138 0 : (setq top top-margin)))))
8139 : ;; Apply our changes.
8140 0 : (setq text-width
8141 0 : (if width
8142 0 : (+ width text-minus-body-width)
8143 0 : (frame-text-width frame)))
8144 0 : (setq text-height
8145 0 : (if height
8146 0 : (+ height text-minus-body-height)
8147 0 : (frame-text-height frame)))
8148 0 : (modify-frame-parameters
8149 0 : frame `((left . ,left) (top . ,top)
8150 0 : (width . (text-pixels . ,text-width))
8151 0 : (height . (text-pixels . ,text-height)))))))
8152 :
8153 : (defun fit-window-to-buffer (&optional window max-height min-height max-width min-width preserve-size)
8154 : "Adjust size of WINDOW to display its buffer's contents exactly.
8155 : WINDOW must be a live window and defaults to the selected one.
8156 :
8157 : If WINDOW is part of a vertical combination, adjust WINDOW's
8158 : height. The new height is calculated from the actual height of
8159 : the accessible portion of its buffer. The optional argument
8160 : MAX-HEIGHT specifies a maximum height and defaults to the height
8161 : of WINDOW's frame. The optional argument MIN-HEIGHT specifies a
8162 : minimum height and defaults to `window-min-height'. Both
8163 : MAX-HEIGHT and MIN-HEIGHT are specified in lines and include mode
8164 : and header line and a bottom divider, if any.
8165 :
8166 : If WINDOW is part of a horizontal combination and the value of
8167 : the option `fit-window-to-buffer-horizontally' is non-nil, adjust
8168 : WINDOW's width. The new width of WINDOW is calculated from the
8169 : maximum length of its buffer's lines that follow the current
8170 : start position of WINDOW. The optional argument MAX-WIDTH
8171 : specifies a maximum width and defaults to the width of WINDOW's
8172 : frame. The optional argument MIN-WIDTH specifies a minimum width
8173 : and defaults to `window-min-width'. Both MAX-WIDTH and MIN-WIDTH
8174 : are specified in columns and include fringes, margins, a
8175 : scrollbar and a vertical divider, if any.
8176 :
8177 : If the optional argument `preserve-size' is non-nil, preserve the
8178 : size of WINDOW (see `window-preserve-size').
8179 :
8180 : Fit pixelwise if the option `window-resize-pixelwise' is non-nil.
8181 : If WINDOW is its frame's root window and the option
8182 : `fit-frame-to-buffer' is non-nil, call `fit-frame-to-buffer' to
8183 : adjust the frame's size.
8184 :
8185 : Note that even if this function makes WINDOW large enough to show
8186 : _all_ parts of its buffer you might not see the first part when
8187 : WINDOW was scrolled. If WINDOW is resized horizontally, you will
8188 : not see the top of its buffer unless WINDOW starts at its minimum
8189 : accessible position."
8190 : (interactive)
8191 0 : (setq window (window-normalize-window window t))
8192 0 : (if (eq window (frame-root-window window))
8193 0 : (when fit-frame-to-buffer
8194 : ;; Fit WINDOW's frame to buffer.
8195 0 : (fit-frame-to-buffer
8196 0 : (window-frame window)
8197 0 : max-height min-height max-width min-width
8198 0 : (and (memq fit-frame-to-buffer '(vertically horizontally))
8199 0 : fit-frame-to-buffer)))
8200 0 : (with-selected-window window
8201 0 : (let* ((pixelwise window-resize-pixelwise)
8202 0 : (char-height (frame-char-height))
8203 0 : (char-width (frame-char-width))
8204 0 : (total-height (window-size window nil pixelwise))
8205 0 : (body-height (window-body-height window pixelwise))
8206 0 : (body-width (window-body-width window pixelwise))
8207 : (min-height
8208 : ;; Sanitize MIN-HEIGHT.
8209 0 : (if (numberp min-height)
8210 : ;; Can't get smaller than `window-safe-min-height'.
8211 0 : (max (if pixelwise
8212 0 : (* char-height min-height)
8213 0 : min-height)
8214 0 : (if pixelwise
8215 0 : (window-safe-min-pixel-height window)
8216 0 : window-safe-min-height))
8217 : ;; Preserve header and mode line if present.
8218 0 : (max (if pixelwise
8219 0 : (* char-height window-min-height)
8220 0 : window-min-height)
8221 0 : (window-min-size window nil window pixelwise))))
8222 : (max-height
8223 : ;; Sanitize MAX-HEIGHT.
8224 0 : (if (numberp max-height)
8225 0 : (min
8226 0 : (+ total-height
8227 0 : (window-max-delta
8228 0 : window nil window nil t nil pixelwise))
8229 0 : (if pixelwise
8230 0 : (* char-height max-height)
8231 0 : max-height))
8232 0 : (+ total-height (window-max-delta
8233 0 : window nil window nil t nil pixelwise))))
8234 : height)
8235 0 : (cond
8236 : ;; If WINDOW is vertically combined, try to resize it
8237 : ;; vertically.
8238 0 : ((and (not (eq fit-window-to-buffer-horizontally 'only))
8239 0 : (not (window-size-fixed-p window 'preserved))
8240 0 : (window-combined-p))
8241 : ;; Vertically we always want to fit the entire buffer.
8242 : ;; WINDOW'S height can't get larger than its frame's pixel
8243 : ;; height. Its width remains fixed.
8244 0 : (setq height (+ (cdr (window-text-pixel-size
8245 0 : nil nil t nil (frame-pixel-height) t))
8246 0 : (window-scroll-bar-height window)
8247 0 : (window-bottom-divider-width)))
8248 : ;; Round height.
8249 0 : (unless pixelwise
8250 0 : (setq height (/ (+ height char-height -1) char-height)))
8251 0 : (unless (= height total-height)
8252 0 : (window-preserve-size window)
8253 0 : (window-resize-no-error
8254 0 : window
8255 0 : (- (max min-height (min max-height height)) total-height)
8256 0 : nil window pixelwise)
8257 0 : (when preserve-size
8258 0 : (window-preserve-size window nil t))))
8259 : ;; If WINDOW is horizontally combined, try to resize it
8260 : ;; horizontally.
8261 0 : ((and fit-window-to-buffer-horizontally
8262 0 : (not (window-size-fixed-p window t 'preserved))
8263 0 : (window-combined-p nil t))
8264 0 : (let* ((total-width (window-size window t pixelwise))
8265 : (min-width
8266 : ;; Sanitize MIN-WIDTH.
8267 0 : (if (numberp min-width)
8268 : ;; Can't get smaller than `window-safe-min-width'.
8269 0 : (max (if pixelwise
8270 0 : (* char-width min-width)
8271 0 : min-width)
8272 0 : (if pixelwise
8273 0 : (window-safe-min-pixel-width)
8274 0 : window-safe-min-width))
8275 : ;; Preserve fringes, margins, scrollbars if present.
8276 0 : (max (if pixelwise
8277 0 : (* char-width window-min-width)
8278 0 : window-min-width)
8279 0 : (window-min-size nil nil window pixelwise))))
8280 : (max-width
8281 : ;; Sanitize MAX-WIDTH.
8282 0 : (if (numberp max-width)
8283 0 : (min (+ total-width
8284 0 : (window-max-delta
8285 0 : window t window nil t nil pixelwise))
8286 0 : (if pixelwise
8287 0 : (* char-width max-width)
8288 0 : max-width))
8289 0 : (+ total-width (window-max-delta
8290 0 : window t window nil t nil pixelwise))))
8291 : ;; When fitting horizontally, assume that WINDOW's
8292 : ;; start position remains unaltered. WINDOW can't get
8293 : ;; wider than its frame's pixel width, its height
8294 : ;; remains unaltered.
8295 0 : (width (+ (car (window-text-pixel-size
8296 0 : nil (window-start) (point-max)
8297 0 : (frame-pixel-width)
8298 : ;; Add one char-height to assure that
8299 : ;; we're on the safe side. This
8300 : ;; overshoots when the first line below
8301 : ;; the bottom is wider than the window.
8302 0 : (* body-height
8303 0 : (if pixelwise 1 char-height))))
8304 0 : (window-right-divider-width))))
8305 0 : (unless pixelwise
8306 0 : (setq width (/ (+ width char-width -1) char-width)))
8307 0 : (unless (= width body-width)
8308 0 : (window-preserve-size window t)
8309 0 : (window-resize-no-error
8310 0 : window
8311 0 : (- (max min-width
8312 0 : (min max-width
8313 0 : (+ total-width (- width body-width))))
8314 0 : total-width)
8315 0 : t window pixelwise)
8316 0 : (when preserve-size
8317 0 : (window-preserve-size window t t))))))))))
8318 :
8319 : (defun window-safely-shrinkable-p (&optional window)
8320 : "Return t if WINDOW can be shrunk without shrinking other windows.
8321 : WINDOW defaults to the selected window."
8322 0 : (with-selected-window (or window (selected-window))
8323 0 : (let ((edges (window-edges)))
8324 0 : (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
8325 0 : (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
8326 :
8327 : (defun shrink-window-if-larger-than-buffer (&optional window)
8328 : "Shrink height of WINDOW if its buffer doesn't need so many lines.
8329 : More precisely, shrink WINDOW vertically to be as small as
8330 : possible, while still showing the full contents of its buffer.
8331 : WINDOW must be a live window and defaults to the selected one.
8332 :
8333 : Do not shrink WINDOW to less than `window-min-height' lines. Do
8334 : nothing if the buffer contains more lines than the present window
8335 : height, or if some of the window's contents are scrolled out of
8336 : view, or if shrinking this window would also shrink another
8337 : window, or if the window is the only window of its frame.
8338 :
8339 : Return non-nil if the window was shrunk, nil otherwise."
8340 : (interactive)
8341 0 : (setq window (window-normalize-window window t))
8342 : ;; Make sure that WINDOW is vertically combined and `point-min' is
8343 : ;; visible (for whatever reason that's needed). The remaining issues
8344 : ;; should be taken care of by `fit-window-to-buffer'.
8345 0 : (when (and (window-combined-p window)
8346 0 : (pos-visible-in-window-p (point-min) window))
8347 0 : (fit-window-to-buffer window (window-total-height window))))
8348 :
8349 : (defun window-largest-empty-rectangle--maximums-1 (quad maximums)
8350 : "Support function for `window-largest-empty-rectangle'."
8351 0 : (cond
8352 0 : ((null maximums)
8353 0 : (list quad))
8354 0 : ((> (car quad) (caar maximums))
8355 0 : (cons quad maximums))
8356 : (t
8357 0 : (cons (car maximums)
8358 0 : (window-largest-empty-rectangle--maximums-1 quad (cdr maximums))))))
8359 :
8360 : (defun window-largest-empty-rectangle--maximums (quad maximums count)
8361 : "Support function for `window-largest-empty-rectangle'."
8362 0 : (setq maximums (window-largest-empty-rectangle--maximums-1 quad maximums))
8363 0 : (if (> (length maximums) count)
8364 0 : (nbutlast maximums)
8365 0 : maximums))
8366 :
8367 : (defun window-largest-empty-rectangle--disjoint-maximums (maximums count)
8368 : "Support function for `window-largest-empty-rectangle'."
8369 0 : (setq maximums (sort maximums (lambda (x y) (> (car x) (car y)))))
8370 0 : (let ((new-length 0)
8371 : new-maximums)
8372 0 : (while (and maximums (< new-length count))
8373 0 : (let* ((maximum (car maximums))
8374 0 : (at (nth 2 maximum))
8375 0 : (to (nth 3 maximum)))
8376 0 : (catch 'drop
8377 0 : (dolist (new-maximum new-maximums)
8378 0 : (let ((new-at (nth 2 new-maximum))
8379 0 : (new-to (nth 3 new-maximum)))
8380 0 : (when (if (< at new-at) (> to new-at) (< at new-to))
8381 : ;; Intersection -> drop.
8382 0 : (throw 'drop nil))))
8383 0 : (setq new-maximums (cons maximum new-maximums))
8384 0 : (setq new-length (1+ new-length)))
8385 0 : (setq maximums (cdr maximums))))
8386 :
8387 0 : (nreverse new-maximums)))
8388 :
8389 : (defun window-largest-empty-rectangle (&optional window count min-width min-height positions left)
8390 : "Return dimensions of largest empty rectangle in WINDOW.
8391 : WINDOW must be a live window and defaults to the selected one.
8392 :
8393 : The return value is a triple of the width and the start and end
8394 : Y-coordinates of the largest rectangle that can be inscribed into
8395 : the empty space (the space not displaying any text) of WINDOW's
8396 : text area. The return value is nil if the current glyph matrix
8397 : of WINDOW is not up-to-date.
8398 :
8399 : Optional argument COUNT, if non-nil, specifies the maximum number
8400 : of rectangles to return. This means that the return value is a
8401 : list of triples specifying rectangles with the largest rectangle
8402 : first. COUNT can be also a cons cell whose car specifies the
8403 : number of rectangles to return and whose cdr, if non-nil, states
8404 : that all rectangles returned must be disjoint.
8405 :
8406 : Note that the right edge of any rectangle returned by this
8407 : function is the right edge of WINDOW (the left edge if its buffer
8408 : displays RTL text).
8409 :
8410 : Optional arguments MIN-WIDTH and MIN-HEIGHT, if non-nil, specify
8411 : the minimum width and height of any rectangle returned.
8412 :
8413 : Optional argument POSITIONS, if non-nil, is a cons cell whose car
8414 : specifies the uppermost and whose cdr specifies the lowermost
8415 : pixel position that must be covered by any rectangle returned.
8416 : Note that positions are counted from the start of the text area
8417 : of WINDOW.
8418 :
8419 : Optional argument LEFT, if non-nil, means to return values suitable for
8420 : buffers displaying right to left text."
8421 : ;; Process lines as returned by ‘window-lines-pixel-dimensions’.
8422 : ;; STACK is a stack that contains rows that have to be processed yet.
8423 0 : (let* ((window (window-normalize-window window t))
8424 0 : (disjoint (and (consp count) (cdr count)))
8425 0 : (count (or (and (numberp count) count)
8426 0 : (and (consp count) (numberp (car count)) (car count))))
8427 0 : (rows (window-lines-pixel-dimensions window nil nil t t left))
8428 : (rows-at 0)
8429 : (max-size 0)
8430 : row stack stack-at stack-to
8431 : top top-width top-at top-to top-size
8432 : max-width max-at max-to maximums)
8433 : ;; ROWS-AT is the position where the first element of ROWS starts.
8434 : ;; STACK-AT is the position where the first element of STACK starts.
8435 0 : (while rows
8436 0 : (setq row (car rows))
8437 0 : (if (or (not stack) (>= (car row) (caar stack)))
8438 0 : (progn
8439 0 : (unless stack
8440 0 : (setq stack-at rows-at))
8441 0 : (setq stack (cons row stack))
8442 : ;; Set ROWS-AT to where the first element of ROWS ends
8443 : ;; which, after popping ROW, makes it the start position of
8444 : ;; the next ROW.
8445 0 : (setq rows-at (cdr row))
8446 0 : (setq rows (cdr rows)))
8447 0 : (setq top (car stack))
8448 0 : (setq stack (cdr stack))
8449 0 : (setq top-width (car top))
8450 0 : (setq top-at (if stack (cdar stack) stack-at))
8451 0 : (setq top-to (cdr top))
8452 0 : (setq top-size (* top-width (- top-to top-at)))
8453 0 : (unless (or (and min-width (< top-width min-width))
8454 0 : (and min-height (< (- top-to top-at) min-height))
8455 0 : (and positions
8456 0 : (or (> top-at (car positions))
8457 0 : (< top-to (cdr positions)))))
8458 0 : (if count
8459 0 : (if disjoint
8460 0 : (setq maximums (cons (list top-size top-width top-at top-to)
8461 0 : maximums))
8462 0 : (setq maximums (window-largest-empty-rectangle--maximums
8463 0 : (list top-size top-width top-at top-to)
8464 0 : maximums count)))
8465 0 : (when (> top-size max-size)
8466 0 : (setq max-size top-size)
8467 0 : (setq max-width top-width)
8468 0 : (setq max-at top-at)
8469 0 : (setq max-to top-to))))
8470 0 : (if (and stack (> (caar stack) (car row)))
8471 : ;; Have new top element of stack include old top.
8472 0 : (setq stack (cons (cons (caar stack) (cdr top)) (cdr stack)))
8473 : ;; Move rows-at backwards to top-at.
8474 0 : (setq rows-at top-at))))
8475 :
8476 0 : (when stack
8477 : ;; STACK-TO is the position where the stack ends.
8478 0 : (setq stack-to (cdar stack))
8479 0 : (while stack
8480 0 : (setq top (car stack))
8481 0 : (setq stack (cdr stack))
8482 0 : (setq top-width (car top))
8483 0 : (setq top-at (if stack (cdar stack) stack-at))
8484 0 : (setq top-size (* top-width (- stack-to top-at)))
8485 0 : (unless (or (and min-width (< top-width min-width))
8486 0 : (and min-height (< (- stack-to top-at) min-height))
8487 0 : (and positions
8488 0 : (or (> top-at (car positions))
8489 0 : (< stack-to (cdr positions)))))
8490 0 : (if count
8491 0 : (if disjoint
8492 0 : (setq maximums (cons (list top-size top-width top-at stack-to)
8493 0 : maximums))
8494 0 : (setq maximums (window-largest-empty-rectangle--maximums
8495 0 : (list top-size top-width top-at stack-to)
8496 0 : maximums count)))
8497 0 : (when (> top-size max-size)
8498 0 : (setq max-size top-size)
8499 0 : (setq max-width top-width)
8500 0 : (setq max-at top-at)
8501 0 : (setq max-to stack-to))))))
8502 :
8503 0 : (cond
8504 0 : (maximums
8505 0 : (if disjoint
8506 0 : (window-largest-empty-rectangle--disjoint-maximums maximums count)
8507 0 : maximums))
8508 0 : ((> max-size 0)
8509 0 : (list max-width max-at max-to)))))
8510 :
8511 : (defun kill-buffer-and-window ()
8512 : "Kill the current buffer and delete the selected window."
8513 : (interactive)
8514 0 : (let ((window-to-delete (selected-window))
8515 0 : (buffer-to-kill (current-buffer))
8516 0 : (delete-window-hook (lambda () (ignore-errors (delete-window)))))
8517 0 : (unwind-protect
8518 0 : (progn
8519 0 : (add-hook 'kill-buffer-hook delete-window-hook t t)
8520 0 : (if (kill-buffer (current-buffer))
8521 : ;; If `delete-window' failed before, we rerun it to regenerate
8522 : ;; the error so it can be seen in the echo area.
8523 0 : (when (eq (selected-window) window-to-delete)
8524 0 : (delete-window))))
8525 : ;; If the buffer is not dead for some reason (probably because
8526 : ;; of a `quit' signal), remove the hook again.
8527 0 : (ignore-errors
8528 0 : (with-current-buffer buffer-to-kill
8529 0 : (remove-hook 'kill-buffer-hook delete-window-hook t))))))
8530 :
8531 :
8532 : ;;;
8533 : ;; Groups of windows (Follow Mode).
8534 : ;;
8535 : ;; This section of functions extends the functionality of some window
8536 : ;; manipulating commands to groups of windows cooperatively
8537 : ;; displaying a buffer, typically with Follow Mode.
8538 : ;;
8539 : ;; The xxx-function variables are permanent locals so that their local
8540 : ;; status is undone only when explicitly programmed, not when a buffer
8541 : ;; is reverted or a mode function is called.
8542 :
8543 : (defvar window-group-start-function nil)
8544 : (make-variable-buffer-local 'window-group-start-function)
8545 : (put 'window-group-start-function 'permanent-local t)
8546 : (defun window-group-start (&optional window)
8547 : "Return position at which display currently starts in the group of
8548 : windows containing WINDOW. When a grouping mode (such as Follow Mode)
8549 : is not active, this function is identical to `window-start'.
8550 :
8551 : WINDOW must be a live window and defaults to the selected one.
8552 : This is updated by redisplay or by calling `set-window*-start'."
8553 0 : (if (functionp window-group-start-function)
8554 0 : (funcall window-group-start-function window)
8555 0 : (window-start window)))
8556 :
8557 : (defvar window-group-end-function nil)
8558 : (make-variable-buffer-local 'window-group-end-function)
8559 : (put 'window-group-end-function 'permanent-local t)
8560 : (defun window-group-end (&optional window update)
8561 : "Return position at which display currently ends in the group of
8562 : windows containing WINDOW. When a grouping mode (such as Follow Mode)
8563 : is not active, this function is identical to `window-end'.
8564 :
8565 : WINDOW must be a live window and defaults to the selected one.
8566 : This is updated by redisplay, when it runs to completion.
8567 : Simply changing the buffer text or setting `window-group-start'
8568 : does not update this value.
8569 : Return nil if there is no recorded value. (This can happen if the
8570 : last redisplay of WINDOW was preempted, and did not finish.)
8571 : If UPDATE is non-nil, compute the up-to-date position
8572 : if it isn't already recorded."
8573 0 : (if (functionp window-group-end-function)
8574 0 : (funcall window-group-end-function window update)
8575 0 : (window-end window update)))
8576 :
8577 : (defvar set-window-group-start-function nil)
8578 : (make-variable-buffer-local 'set-window-group-start-function)
8579 : (put 'set-window-group-start-function 'permanent-local t)
8580 : (defun set-window-group-start (window pos &optional noforce)
8581 : "Make display in the group of windows containing WINDOW start at
8582 : position POS in WINDOW's buffer. When a grouping mode (such as Follow
8583 : Mode) is not active, this function is identical to `set-window-start'.
8584 :
8585 : WINDOW must be a live window and defaults to the selected one. Return
8586 : POS. Optional third arg NOFORCE non-nil inhibits next redisplay from
8587 : overriding motion of point in order to display at this exact start."
8588 0 : (if (functionp set-window-group-start-function)
8589 0 : (funcall set-window-group-start-function window pos noforce)
8590 0 : (set-window-start window pos noforce)))
8591 :
8592 : (defvar recenter-window-group-function nil)
8593 : (make-variable-buffer-local 'recenter-window-group-function)
8594 : (put 'recenter-window-group-function 'permanent-local t)
8595 : (defun recenter-window-group (&optional arg)
8596 : "Center point in the group of windows containing the selected window
8597 : and maybe redisplay frame. When a grouping mode (such as Follow Mode)
8598 : is not active, this function is identical to `recenter'.
8599 :
8600 : With a numeric prefix argument ARG, recenter putting point on screen line ARG
8601 : relative to the first window in the selected window group. If ARG is
8602 : negative, it counts up from the bottom of the last window in the
8603 : group. (ARG should be less than the total height of the window group.)
8604 :
8605 : If ARG is omitted or nil, then recenter with point on the middle line of
8606 : the selected window group; if the variable `recenter-redisplay' is
8607 : non-nil, also erase the entire frame and redraw it (when
8608 : `auto-resize-tool-bars' is set to `grow-only', this resets the
8609 : tool-bar's height to the minimum height needed); if
8610 : `recenter-redisplay' has the special value `tty', then only tty frames
8611 : are redrawn.
8612 :
8613 : Just C-u as prefix means put point in the center of the window
8614 : and redisplay normally--don't erase and redraw the frame."
8615 0 : (if (functionp recenter-window-group-function)
8616 0 : (funcall recenter-window-group-function arg)
8617 0 : (recenter arg)))
8618 :
8619 : (defvar pos-visible-in-window-group-p-function nil)
8620 : (make-variable-buffer-local 'pos-visible-in-window-group-p-function)
8621 : (put 'pos-visible-in-window-group-p-function 'permanent-local t)
8622 : (defun pos-visible-in-window-group-p (&optional pos window partially)
8623 : "Return non-nil if position POS is currently on the frame in the
8624 : window group containing WINDOW. When a grouping mode (such as Follow
8625 : Mode) is not active, this function is identical to
8626 : `pos-visible-in-window-p'.
8627 :
8628 : WINDOW must be a live window and defaults to the selected one.
8629 :
8630 : Return nil if that position is scrolled vertically out of view. If a
8631 : character is only partially visible, nil is returned, unless the
8632 : optional argument PARTIALLY is non-nil. If POS is only out of view
8633 : because of horizontal scrolling, return non-nil. If POS is t, it
8634 : specifies the position of the last visible glyph in the window group.
8635 : POS defaults to point in WINDOW; WINDOW defaults to the selected
8636 : window.
8637 :
8638 : If POS is visible, return t if PARTIALLY is nil; if PARTIALLY is non-nil,
8639 : the return value is a list of 2 or 6 elements (X Y [RTOP RBOT ROWH VPOS]),
8640 : where X and Y are the pixel coordinates relative to the top left corner
8641 : of the window. The remaining elements are omitted if the character after
8642 : POS is fully visible; otherwise, RTOP and RBOT are the number of pixels
8643 : off-window at the top and bottom of the screen line (\"row\") containing
8644 : POS, ROWH is the visible height of that row, and VPOS is the row number
8645 : \(zero-based)."
8646 0 : (if (functionp pos-visible-in-window-group-p-function)
8647 0 : (funcall pos-visible-in-window-group-p-function pos window partially)
8648 0 : (pos-visible-in-window-p pos window partially)))
8649 :
8650 : (defvar selected-window-group-function nil)
8651 : (make-variable-buffer-local 'selected-window-group-function)
8652 : (put 'selected-window-group-function 'permanent-local t)
8653 : (defun selected-window-group ()
8654 : "Return the list of windows in the group containing the selected window.
8655 : When a grouping mode (such as Follow Mode) is not active, the
8656 : result is a list containing only the selected window."
8657 0 : (if (functionp selected-window-group-function)
8658 0 : (funcall selected-window-group-function)
8659 0 : (list (selected-window))))
8660 :
8661 : (defvar move-to-window-group-line-function nil)
8662 : (make-variable-buffer-local 'move-to-window-group-line-function)
8663 : (put 'move-to-window-group-line-function 'permanent-local t)
8664 : (defun move-to-window-group-line (arg)
8665 : "Position point relative to the the current group of windows.
8666 : When a grouping mode (such as Follow Mode) is not active, this
8667 : function is identical to `move-to-window-line'.
8668 :
8669 : ARG nil means position point at center of the window group.
8670 : Else, ARG specifies the vertical position within the window
8671 : group; zero means top of first window in the group, negative
8672 : means relative to the bottom of the last window in the group."
8673 0 : (if (functionp move-to-window-group-line-function)
8674 0 : (funcall move-to-window-group-line-function arg)
8675 0 : (move-to-window-line arg)))
8676 :
8677 :
8678 : (defvar recenter-last-op nil
8679 : "Indicates the last recenter operation performed.
8680 : Possible values: `top', `middle', `bottom', integer or float numbers.
8681 : It can also be nil, which means the first value in `recenter-positions'.")
8682 :
8683 : (defcustom recenter-positions '(middle top bottom)
8684 : "Cycling order for `recenter-top-bottom'.
8685 : A list of elements with possible values `top', `middle', `bottom',
8686 : integer or float numbers that define the cycling order for
8687 : the command `recenter-top-bottom'.
8688 :
8689 : Top and bottom destinations are `scroll-margin' lines from the true
8690 : window top and bottom. Middle redraws the frame and centers point
8691 : vertically within the window. Integer number moves current line to
8692 : the specified absolute window-line. Float number between 0.0 and 1.0
8693 : means the percentage of the screen space from the top. The default
8694 : cycling order is middle -> top -> bottom."
8695 : :type '(repeat (choice
8696 : (const :tag "Top" top)
8697 : (const :tag "Middle" middle)
8698 : (const :tag "Bottom" bottom)
8699 : (integer :tag "Line number")
8700 : (float :tag "Percentage")))
8701 : :version "23.2"
8702 : :group 'windows)
8703 :
8704 : (defun recenter-top-bottom (&optional arg)
8705 : "Move current buffer line to the specified window line.
8706 : With no prefix argument, successive calls place point according
8707 : to the cycling order defined by `recenter-positions'.
8708 :
8709 : A prefix argument is handled like `recenter':
8710 : With numeric prefix ARG, move current line to window-line ARG.
8711 : With plain `C-u', move current line to window center."
8712 : (interactive "P")
8713 0 : (cond
8714 0 : (arg (recenter arg)) ; Always respect ARG.
8715 : (t
8716 0 : (setq recenter-last-op
8717 0 : (if (eq this-command last-command)
8718 0 : (car (or (cdr (member recenter-last-op recenter-positions))
8719 0 : recenter-positions))
8720 0 : (car recenter-positions)))
8721 0 : (let ((this-scroll-margin
8722 0 : (min (max 0 scroll-margin)
8723 0 : (truncate (/ (window-body-height) 4.0)))))
8724 0 : (cond ((eq recenter-last-op 'middle)
8725 0 : (recenter))
8726 0 : ((eq recenter-last-op 'top)
8727 0 : (recenter this-scroll-margin))
8728 0 : ((eq recenter-last-op 'bottom)
8729 0 : (recenter (- -1 this-scroll-margin)))
8730 0 : ((integerp recenter-last-op)
8731 0 : (recenter recenter-last-op))
8732 0 : ((floatp recenter-last-op)
8733 0 : (recenter (round (* recenter-last-op (window-height))))))))))
8734 :
8735 : (define-key global-map [?\C-l] 'recenter-top-bottom)
8736 :
8737 : (defun move-to-window-line-top-bottom (&optional arg)
8738 : "Position point relative to window.
8739 :
8740 : With a prefix argument ARG, acts like `move-to-window-line'.
8741 :
8742 : With no argument, positions point at center of window.
8743 : Successive calls position point at positions defined
8744 : by `recenter-positions'."
8745 : (interactive "P")
8746 0 : (cond
8747 0 : (arg (move-to-window-line arg)) ; Always respect ARG.
8748 : (t
8749 0 : (setq recenter-last-op
8750 0 : (if (eq this-command last-command)
8751 0 : (car (or (cdr (member recenter-last-op recenter-positions))
8752 0 : recenter-positions))
8753 0 : (car recenter-positions)))
8754 0 : (let ((this-scroll-margin
8755 0 : (min (max 0 scroll-margin)
8756 0 : (truncate (/ (window-body-height) 4.0)))))
8757 0 : (cond ((eq recenter-last-op 'middle)
8758 0 : (call-interactively 'move-to-window-line))
8759 0 : ((eq recenter-last-op 'top)
8760 0 : (move-to-window-line this-scroll-margin))
8761 0 : ((eq recenter-last-op 'bottom)
8762 0 : (move-to-window-line (- -1 this-scroll-margin)))
8763 0 : ((integerp recenter-last-op)
8764 0 : (move-to-window-line recenter-last-op))
8765 0 : ((floatp recenter-last-op)
8766 0 : (move-to-window-line (round (* recenter-last-op (window-height))))))))))
8767 :
8768 : (define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
8769 :
8770 : ;;; Scrolling commands.
8771 :
8772 : ;;; Scrolling commands which do not signal errors at top/bottom
8773 : ;;; of buffer at first key-press (instead move to top/bottom
8774 : ;;; of buffer).
8775 :
8776 : (defcustom scroll-error-top-bottom nil
8777 : "Move point to top/bottom of buffer before signaling a scrolling error.
8778 : A value of nil means just signal an error if no more scrolling possible.
8779 : A value of t means point moves to the beginning or the end of the buffer
8780 : \(depending on scrolling direction) when no more scrolling possible.
8781 : When point is already on that position, then signal an error."
8782 : :type 'boolean
8783 : :group 'windows
8784 : :version "24.1")
8785 :
8786 : (defun scroll-up-command (&optional arg)
8787 : "Scroll text of selected window upward ARG lines; or near full screen if no ARG.
8788 : If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
8789 : scroll window further, move cursor to the bottom line.
8790 : When point is already on that position, then signal an error.
8791 : A near full screen is `next-screen-context-lines' less than a full screen.
8792 : Negative ARG means scroll downward.
8793 : If ARG is the atom `-', scroll downward by nearly full screen."
8794 : (interactive "^P")
8795 0 : (cond
8796 0 : ((null scroll-error-top-bottom)
8797 0 : (scroll-up arg))
8798 0 : ((eq arg '-)
8799 0 : (scroll-down-command nil))
8800 0 : ((< (prefix-numeric-value arg) 0)
8801 0 : (scroll-down-command (- (prefix-numeric-value arg))))
8802 0 : ((eobp)
8803 0 : (scroll-up arg)) ; signal error
8804 : (t
8805 0 : (condition-case nil
8806 0 : (scroll-up arg)
8807 : (end-of-buffer
8808 0 : (if arg
8809 : ;; When scrolling by ARG lines can't be done,
8810 : ;; move by ARG lines instead.
8811 0 : (forward-line arg)
8812 : ;; When ARG is nil for full-screen scrolling,
8813 : ;; move to the bottom of the buffer.
8814 0 : (goto-char (point-max))))))))
8815 :
8816 : (put 'scroll-up-command 'scroll-command t)
8817 :
8818 : (defun scroll-down-command (&optional arg)
8819 : "Scroll text of selected window down ARG lines; or near full screen if no ARG.
8820 : If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
8821 : scroll window further, move cursor to the top line.
8822 : When point is already on that position, then signal an error.
8823 : A near full screen is `next-screen-context-lines' less than a full screen.
8824 : Negative ARG means scroll upward.
8825 : If ARG is the atom `-', scroll upward by nearly full screen."
8826 : (interactive "^P")
8827 0 : (cond
8828 0 : ((null scroll-error-top-bottom)
8829 0 : (scroll-down arg))
8830 0 : ((eq arg '-)
8831 0 : (scroll-up-command nil))
8832 0 : ((< (prefix-numeric-value arg) 0)
8833 0 : (scroll-up-command (- (prefix-numeric-value arg))))
8834 0 : ((bobp)
8835 0 : (scroll-down arg)) ; signal error
8836 : (t
8837 0 : (condition-case nil
8838 0 : (scroll-down arg)
8839 : (beginning-of-buffer
8840 0 : (if arg
8841 : ;; When scrolling by ARG lines can't be done,
8842 : ;; move by ARG lines instead.
8843 0 : (forward-line (- arg))
8844 : ;; When ARG is nil for full-screen scrolling,
8845 : ;; move to the top of the buffer.
8846 0 : (goto-char (point-min))))))))
8847 :
8848 : (put 'scroll-down-command 'scroll-command t)
8849 :
8850 : ;;; Scrolling commands which scroll a line instead of full screen.
8851 :
8852 : (defun scroll-up-line (&optional arg)
8853 : "Scroll text of selected window upward ARG lines; or one line if no ARG.
8854 : If ARG is omitted or nil, scroll upward by one line.
8855 : This is different from `scroll-up-command' that scrolls a full screen."
8856 : (interactive "p")
8857 0 : (scroll-up (or arg 1)))
8858 :
8859 : (put 'scroll-up-line 'scroll-command t)
8860 :
8861 : (defun scroll-down-line (&optional arg)
8862 : "Scroll text of selected window down ARG lines; or one line if no ARG.
8863 : If ARG is omitted or nil, scroll down by one line.
8864 : This is different from `scroll-down-command' that scrolls a full screen."
8865 : (interactive "p")
8866 0 : (scroll-down (or arg 1)))
8867 :
8868 : (put 'scroll-down-line 'scroll-command t)
8869 :
8870 :
8871 : (defun scroll-other-window-down (&optional lines)
8872 : "Scroll the \"other window\" down.
8873 : For more details, see the documentation for `scroll-other-window'."
8874 : (interactive "P")
8875 0 : (scroll-other-window
8876 : ;; Just invert the argument's meaning.
8877 : ;; We can do that without knowing which window it will be.
8878 0 : (if (eq lines '-) nil
8879 0 : (if (null lines) '-
8880 0 : (- (prefix-numeric-value lines))))))
8881 :
8882 : (defun beginning-of-buffer-other-window (arg)
8883 : "Move point to the beginning of the buffer in the other window.
8884 : Leave mark at previous position.
8885 : With arg N, put point N/10 of the way from the true beginning."
8886 : (interactive "P")
8887 0 : (let ((orig-window (selected-window))
8888 0 : (window (other-window-for-scrolling)))
8889 : ;; We use unwind-protect rather than save-window-excursion
8890 : ;; because the latter would preserve the things we want to change.
8891 0 : (unwind-protect
8892 0 : (progn
8893 0 : (select-window window)
8894 : ;; Set point and mark in that window's buffer.
8895 0 : (with-no-warnings
8896 0 : (beginning-of-buffer arg))
8897 : ;; Set point accordingly.
8898 0 : (recenter '(t)))
8899 0 : (select-window orig-window))))
8900 :
8901 : (defun end-of-buffer-other-window (arg)
8902 : "Move point to the end of the buffer in the other window.
8903 : Leave mark at previous position.
8904 : With arg N, put point N/10 of the way from the true end."
8905 : (interactive "P")
8906 : ;; See beginning-of-buffer-other-window for comments.
8907 0 : (let ((orig-window (selected-window))
8908 0 : (window (other-window-for-scrolling)))
8909 0 : (unwind-protect
8910 0 : (progn
8911 0 : (select-window window)
8912 0 : (with-no-warnings
8913 0 : (end-of-buffer arg))
8914 0 : (recenter '(t)))
8915 0 : (select-window orig-window))))
8916 :
8917 : (defvar mouse-autoselect-window-timer nil
8918 : "Timer used by delayed window autoselection.")
8919 :
8920 : (defvar mouse-autoselect-window-position-1 nil
8921 : "First mouse position recorded by delayed window autoselection.")
8922 :
8923 : (defvar mouse-autoselect-window-position nil
8924 : "Last mouse position recorded by delayed window autoselection.")
8925 :
8926 : (defvar mouse-autoselect-window-window nil
8927 : "Last window recorded by delayed window autoselection.")
8928 :
8929 : (defvar mouse-autoselect-window-state nil
8930 : "When non-nil, special state of delayed window autoselection.
8931 : Possible values are `suspend' (suspend autoselection after a menu or
8932 : scrollbar interaction) and `select' (the next invocation of
8933 : `handle-select-window' shall select the window immediately).")
8934 :
8935 : (defun mouse-autoselect-window-cancel (&optional force)
8936 : "Cancel delayed window autoselection.
8937 : Optional argument FORCE means cancel unconditionally."
8938 0 : (unless (and (not force)
8939 : ;; Don't cancel for select-window or select-frame events
8940 : ;; or when the user drags a scroll bar.
8941 0 : (or (memq this-command
8942 0 : '(handle-select-window handle-switch-frame))
8943 0 : (and (eq this-command 'scroll-bar-toolkit-scroll)
8944 0 : (memq (nth 4 (event-end last-input-event))
8945 0 : '(handle end-scroll)))))
8946 0 : (setq mouse-autoselect-window-state nil)
8947 0 : (setq mouse-autoselect-window-position-1 nil)
8948 0 : (when (timerp mouse-autoselect-window-timer)
8949 0 : (cancel-timer mouse-autoselect-window-timer))
8950 0 : (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
8951 :
8952 : (defun mouse-autoselect-window-start (mouse-position &optional window suspend)
8953 : "Start delayed window autoselection.
8954 : MOUSE-POSITION is the last position where the mouse was seen as returned
8955 : by `mouse-position'. Optional argument WINDOW non-nil denotes the
8956 : window where the mouse was seen. Optional argument SUSPEND non-nil
8957 : means suspend autoselection."
8958 : ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
8959 0 : (setq mouse-autoselect-window-position mouse-position)
8960 0 : (when window (setq mouse-autoselect-window-window window))
8961 0 : (setq mouse-autoselect-window-state (when suspend 'suspend))
8962 : ;; Install timer which runs `mouse-autoselect-window-select' after
8963 : ;; `mouse-autoselect-window' seconds.
8964 0 : (setq mouse-autoselect-window-timer
8965 0 : (run-at-time
8966 0 : (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
8967 :
8968 : (defun mouse-autoselect-window-select ()
8969 : "Select window with delayed window autoselection.
8970 : If the mouse position has stabilized in a non-selected window, select
8971 : that window. The minibuffer window is selected only if the minibuffer
8972 : is active. This function is run by `mouse-autoselect-window-timer'."
8973 0 : (let* ((mouse-position (mouse-position))
8974 0 : (mouse-x (and (numberp (cadr mouse-position))
8975 0 : (cadr mouse-position)))
8976 0 : (mouse-y (and (numberp (cddr mouse-position))
8977 0 : (cddr mouse-position)))
8978 0 : (frame (and mouse-x mouse-y (car mouse-position)))
8979 0 : (window (and frame (window-at mouse-x mouse-y frame))))
8980 0 : (cond
8981 0 : ((or (and (fboundp 'menu-or-popup-active-p) (menu-or-popup-active-p))
8982 0 : (and window
8983 0 : (let ((coords (coordinates-in-window-p
8984 0 : (cdr mouse-position) window)))
8985 0 : (and (not (consp coords))
8986 0 : (not (memq coords '(left-margin right-margin)))))))
8987 : ;; A menu / popup dialog is active or the mouse is not on the
8988 : ;; text region of WINDOW: Suspend autoselection temporarily.
8989 0 : (mouse-autoselect-window-start mouse-position nil t))
8990 0 : ((or (eq mouse-autoselect-window-state 'suspend)
8991 : ;; When the mouse is at its first recorded position, restart
8992 : ;; delayed autoselection. This works around a scenario with
8993 : ;; two two-window frames with identical dimensions: select the
8994 : ;; first window of the first frame, switch to the second
8995 : ;; frame, move the mouse to its second window, minimize the
8996 : ;; second frame. Now the second window of the first frame
8997 : ;; gets selected although the mouse never really "moved" into
8998 : ;; that window.
8999 0 : (and (numberp mouse-autoselect-window)
9000 0 : (equal (mouse-position) mouse-autoselect-window-position-1)))
9001 : ;; Delayed autoselection was temporarily suspended, reenable it.
9002 0 : (mouse-autoselect-window-start mouse-position))
9003 0 : ((and window
9004 0 : (or (not (numberp mouse-autoselect-window))
9005 0 : (and (>= mouse-autoselect-window 0)
9006 : ;; If `mouse-autoselect-window' is non-negative,
9007 : ;; select window if it's the same as before.
9008 0 : (eq window mouse-autoselect-window-window))
9009 : ;; Otherwise select window iff the mouse is at the same
9010 : ;; position as before. Observe that the first test
9011 : ;; after starting autoselection usually fails since the
9012 : ;; value of `mouse-autoselect-window-position' recorded
9013 : ;; there is the position where the mouse has entered the
9014 : ;; new window and not necessarily where the mouse has
9015 : ;; stopped moving.
9016 0 : (equal mouse-position mouse-autoselect-window-position))
9017 : ;; The minibuffer is a candidate window if it's active.
9018 0 : (or (not (window-minibuffer-p window))
9019 0 : (eq window (active-minibuffer-window))))
9020 : ;; Mouse position has stabilized in non-selected window: Cancel
9021 : ;; delayed autoselection and try to select that window.
9022 0 : (mouse-autoselect-window-cancel t)
9023 : ;; Use `unread-command-events' in order to execute pre- and
9024 : ;; post-command hooks and trigger idle timers. To avoid delaying
9025 : ;; autoselection again, set `mouse-autoselect-window-state'."
9026 0 : (setq mouse-autoselect-window-state 'select)
9027 0 : (setq unread-command-events
9028 0 : (cons (list 'select-window (list window))
9029 0 : unread-command-events)))
9030 0 : ((or (not (numberp mouse-autoselect-window))
9031 0 : (equal mouse-position mouse-autoselect-window-position))
9032 : ;; Mouse position has stabilized at
9033 : ;; `mouse-autoselect-window-position': Cancel delayed
9034 : ;; autoselection.
9035 0 : (mouse-autoselect-window-cancel t))
9036 0 : (window
9037 : ;; Mouse position has not stabilized yet, resume delayed
9038 : ;; autoselection.
9039 0 : (mouse-autoselect-window-start mouse-position window)))))
9040 :
9041 : (defun handle-select-window (event)
9042 : "Handle select-window events."
9043 : (interactive "^e")
9044 0 : (let* ((window (posn-window (event-start event)))
9045 0 : (frame (and (window-live-p window) (window-frame window)))
9046 0 : (old-frame (selected-frame)))
9047 0 : (unless (or (not (window-live-p window))
9048 : ;; Don't switch when autoselection shall be delayed.
9049 0 : (and (numberp mouse-autoselect-window)
9050 0 : (not (eq mouse-autoselect-window-state 'select))
9051 0 : (let ((position (mouse-position)))
9052 : ;; Cancel any delayed autoselection.
9053 0 : (mouse-autoselect-window-cancel t)
9054 : ;; Start delayed autoselection from current mouse
9055 : ;; position and window.
9056 0 : (setq mouse-autoselect-window-position-1 position)
9057 0 : (mouse-autoselect-window-start position window)
9058 : ;; Executing a command cancels delayed autoselection.
9059 0 : (add-hook
9060 0 : 'pre-command-hook 'mouse-autoselect-window-cancel)))
9061 : ;; Don't switch to a `no-accept-focus' frame unless it's
9062 : ;; already selected.
9063 0 : (and (not (eq frame (selected-frame)))
9064 0 : (frame-parameter frame 'no-accept-focus))
9065 : ;; Don't switch to minibuffer window unless it's active.
9066 0 : (and (window-minibuffer-p window)
9067 0 : (not (minibuffer-window-active-p window))))
9068 : ;; Reset state of delayed autoselection.
9069 0 : (setq mouse-autoselect-window-state nil)
9070 : ;; Run `mouse-leave-buffer-hook' when autoselecting window.
9071 0 : (run-hooks 'mouse-leave-buffer-hook)
9072 : ;; Clear echo area.
9073 0 : (message nil)
9074 : ;; Select the window before giving the frame focus since otherwise
9075 : ;; we might get two windows with an active cursor.
9076 0 : (select-window window)
9077 0 : (cond
9078 0 : ((or (not (memq (window-system frame) '(x w32 ns)))
9079 0 : (not focus-follows-mouse)
9080 : ;; Focus FRAME if it's either a child frame or an ancestor
9081 : ;; of the frame switched from.
9082 0 : (and (not (frame-parameter frame 'parent-frame))
9083 0 : (not (frame-ancestor-p frame old-frame)))))
9084 0 : ((eq focus-follows-mouse 'auto-raise)
9085 : ;; Focus and auto-raise frame.
9086 0 : (x-focus-frame frame)
9087 : ;; This doesn't seem to work when we move from a normal frame
9088 : ;; right into the child frame of another frame - we should raise
9089 : ;; that child frame's ancestor frame first ...
9090 0 : (raise-frame frame))
9091 : (t
9092 : ;; Just focus frame.
9093 0 : (x-focus-frame frame t))))))
9094 :
9095 : (defun truncated-partial-width-window-p (&optional window)
9096 : "Return non-nil if lines in WINDOW are specifically truncated due to its width.
9097 : WINDOW must be a live window and defaults to the selected one.
9098 : Return nil if WINDOW is not a partial-width window
9099 : (regardless of the value of `truncate-lines').
9100 : Otherwise, consult the value of `truncate-partial-width-windows'
9101 : for the buffer shown in WINDOW."
9102 0 : (setq window (window-normalize-window window t))
9103 0 : (unless (window-full-width-p window)
9104 0 : (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
9105 0 : (window-buffer window))))
9106 0 : (if (integerp t-p-w-w)
9107 0 : (< (window-width window) t-p-w-w)
9108 0 : t-p-w-w))))
9109 :
9110 :
9111 : ;; Automatically inform subprocesses of changes to window size.
9112 :
9113 : (defcustom window-adjust-process-window-size-function
9114 : 'window-adjust-process-window-size-smallest
9115 : "Control how Emacs chooses inferior process window sizes.
9116 : Emacs uses this function to tell processes the space they have
9117 : available for displaying their output. After each window
9118 : configuration change, Emacs calls the value of
9119 : `window-adjust-process-window-size-function' for each process
9120 : with a buffer being displayed in at least one window.
9121 : This function is responsible for combining the sizes of the
9122 : displayed windows and returning a cons (WIDTH . HEIGHT)
9123 : describing the width and height with which Emacs will call
9124 : `set-process-window-size' for that process. If the function
9125 : returns nil, Emacs does not call `set-process-window-size'.
9126 :
9127 : This function is called with the process buffer as the current
9128 : buffer and with two arguments: the process and a list of windows
9129 : displaying process. Modes can make this variable buffer-local;
9130 : additionally, the `adjust-window-size-function' process property
9131 : overrides the global or buffer-local value of
9132 : `window-adjust-process-window-size-function'."
9133 : :type '(choice
9134 : (const :tag "Minimum area of any window"
9135 : window-adjust-process-window-size-smallest)
9136 : (const :tag "Maximum area of any window"
9137 : window-adjust-process-window-size-largest)
9138 : (const :tag "Do not adjust process window sizes" ignore)
9139 : function)
9140 : :group 'windows
9141 : :version "25.1")
9142 :
9143 : (defun window-adjust-process-window-size (reducer windows)
9144 : "Adjust the window sizes of a process.
9145 : WINDOWS is a list of windows associated with that process. REDUCER is
9146 : a two-argument function used to combine the widths and heights of
9147 : the given windows."
9148 0 : (when windows
9149 0 : (let ((width (window-max-chars-per-line (car windows)))
9150 0 : (height (window-body-height (car windows))))
9151 0 : (dolist (window (cdr windows))
9152 0 : (setf width (funcall reducer width (window-max-chars-per-line window)))
9153 0 : (setf height (funcall reducer height (window-body-height window))))
9154 0 : (cons width height))))
9155 :
9156 : (defun window-adjust-process-window-size-smallest (_process windows)
9157 : "Adjust the process window size of PROCESS.
9158 : WINDOWS is a list of windows associated with PROCESS. Choose the
9159 : smallest area available for displaying PROCESS's output."
9160 0 : (window-adjust-process-window-size #'min windows))
9161 :
9162 : (defun window-adjust-process-window-size-largest (_process windows)
9163 : "Adjust the process window size of PROCESS.
9164 : WINDOWS is a list of windows associated with PROCESS. Choose the
9165 : largest area available for displaying PROCESS's output."
9166 0 : (window-adjust-process-window-size #'max windows))
9167 :
9168 : (defun window--process-window-list ()
9169 : "Return an alist mapping processes to associated windows.
9170 : A window is associated with a process if that window is
9171 : displaying that processes's buffer."
9172 179 : (let ((processes (process-list))
9173 : (process-windows nil))
9174 179 : (if processes
9175 33 : (walk-windows
9176 : (lambda (window)
9177 55 : (let ((buffer (window-buffer window))
9178 55 : (iter processes))
9179 71 : (while (let ((process (car iter)))
9180 71 : (if (and (process-live-p process)
9181 71 : (eq buffer (process-buffer process)))
9182 10 : (let ((procwin (assq process process-windows)))
9183 : ;; Add this window to the list of windows
9184 : ;; displaying process.
9185 10 : (if procwin
9186 0 : (push window (cdr procwin))
9187 20 : (push (list process window) process-windows))
9188 : ;; We found our process for this window, so
9189 : ;; stop iterating over the process list.
9190 10 : nil)
9191 71 : (setf iter (cdr iter)))))))
9192 179 : 1 t))
9193 179 : process-windows))
9194 :
9195 : (defun window--adjust-process-windows ()
9196 : "Update process window sizes to match the current window configuration."
9197 179 : (when (fboundp 'process-list)
9198 179 : (dolist (procwin (window--process-window-list))
9199 10 : (let ((process (car procwin)))
9200 10 : (with-demoted-errors "Error adjusting window size: %S"
9201 10 : (with-current-buffer (process-buffer process)
9202 10 : (let ((size (funcall
9203 10 : (or (process-get process 'adjust-window-size-function)
9204 10 : window-adjust-process-window-size-function)
9205 10 : process (cdr procwin))))
9206 10 : (when size
9207 179 : (set-process-window-size process (cdr size) (car size))))))))))
9208 :
9209 : (add-hook 'window-configuration-change-hook 'window--adjust-process-windows)
9210 :
9211 :
9212 : ;; Some of these are in tutorial--default-keys, so update that if you
9213 : ;; change these.
9214 : (define-key ctl-x-map "0" 'delete-window)
9215 : (define-key ctl-x-map "1" 'delete-other-windows)
9216 : (define-key ctl-x-map "2" 'split-window-below)
9217 : (define-key ctl-x-map "3" 'split-window-right)
9218 : (define-key ctl-x-map "o" 'other-window)
9219 : (define-key ctl-x-map "^" 'enlarge-window)
9220 : (define-key ctl-x-map "}" 'enlarge-window-horizontally)
9221 : (define-key ctl-x-map "{" 'shrink-window-horizontally)
9222 : (define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
9223 : (define-key ctl-x-map "+" 'balance-windows)
9224 : (define-key ctl-x-4-map "0" 'kill-buffer-and-window)
9225 :
9226 : ;;; window.el ends here
|