Some changes and re-organization for animated gif support.
[bpt/emacs.git] / lisp / window.el
CommitLineData
3c448ab6
MR
1;;; window.el --- GNU Emacs window commands aside from those written in C
2
73b0cd50 3;; Copyright (C) 1985, 1989, 1992-1994, 2000-2011
3689984f 4;; Free Software Foundation, Inc.
3c448ab6
MR
5
6;; Maintainer: FSF
7;; Keywords: internal
bd78fa1d 8;; Package: emacs
3c448ab6
MR
9
10;; This file is part of GNU Emacs.
11
12;; GNU Emacs is free software: you can redistribute it and/or modify
13;; it under the terms of the GNU General Public License as published by
14;; the Free Software Foundation, either version 3 of the License, or
15;; (at your option) any later version.
16
17;; GNU Emacs is distributed in the hope that it will be useful,
18;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20;; GNU General Public License for more details.
21
22;; You should have received a copy of the GNU General Public License
23;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25;;; Commentary:
26
27;; Window tree functions.
28
29;;; Code:
30
31(eval-when-compile (require 'cl))
32
3c448ab6
MR
33(defmacro save-selected-window (&rest body)
34 "Execute BODY, then select the previously selected window.
35The value returned is the value of the last form in BODY.
36
37This macro saves and restores the selected window, as well as the
38selected window in each frame. If the previously selected window
39is no longer live, then whatever window is selected at the end of
40BODY remains selected. If the previously selected window of some
41frame is no longer live at the end of BODY, that frame's selected
42window is left alone.
43
44This macro saves and restores the current buffer, since otherwise
45its normal operation could make a different buffer current. The
46order of recently selected windows and the buffer list ordering
47are not altered by this macro (unless they are altered in BODY)."
f291fe60 48 (declare (indent 0) (debug t))
3c448ab6
MR
49 `(let ((save-selected-window-window (selected-window))
50 ;; It is necessary to save all of these, because calling
51 ;; select-window changes frame-selected-window for whatever
52 ;; frame that window is in.
53 (save-selected-window-alist
54 (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
55 (frame-list))))
56 (save-current-buffer
57 (unwind-protect
58 (progn ,@body)
59 (dolist (elt save-selected-window-alist)
60 (and (frame-live-p (car elt))
61 (window-live-p (cdr elt))
62 (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
63 (when (window-live-p save-selected-window-window)
64 (select-window save-selected-window-window 'norecord))))))
65
85cc1f11
MR
66;; The following two functions are like `window-next' and `window-prev'
67;; but the WINDOW argument is _not_ optional (so they don't substitute
68;; the selected window for nil), and they return nil when WINDOW doesn't
69;; have a parent (like a frame's root window or a minibuffer window).
70(defsubst window-right (window)
71 "Return WINDOW's right sibling.
72Return nil if WINDOW is the root window of its frame. WINDOW can
73be any window."
74 (and window (window-parent window) (window-next window)))
75
76(defsubst window-left (window)
77 "Return WINDOW's left sibling.
78Return nil if WINDOW is the root window of its frame. WINDOW can
79be any window."
80 (and window (window-parent window) (window-prev window)))
81
82(defsubst window-child (window)
83 "Return WINDOW's first child window."
84 (or (window-vchild window) (window-hchild window)))
85
86(defun window-child-count (window)
87 "Return number of WINDOW's child windows."
88 (let ((count 0))
89 (when (and (windowp window) (setq window (window-child window)))
90 (while window
91 (setq count (1+ count))
92 (setq window (window-next window))))
93 count))
94
95(defun window-last-child (window)
96 "Return last child window of WINDOW."
97 (when (and (windowp window) (setq window (window-child window)))
98 (while (window-next window)
99 (setq window (window-next window))))
100 window)
101
102(defsubst window-any-p (object)
103 "Return t if OBJECT denotes a live or internal window."
104 (and (windowp object)
105 (or (window-buffer object) (window-child object))
106 t))
107
108;; The following four functions should probably go to subr.el.
109(defsubst normalize-live-buffer (buffer-or-name)
110 "Return buffer specified by BUFFER-OR-NAME.
111BUFFER-OR-NAME must be either a buffer or a string naming a live
112buffer and defaults to the current buffer."
113 (cond
114 ((not buffer-or-name)
115 (current-buffer))
116 ((bufferp buffer-or-name)
117 (if (buffer-live-p buffer-or-name)
118 buffer-or-name
119 (error "Buffer %s is not a live buffer" buffer-or-name)))
120 ((get-buffer buffer-or-name))
121 (t
122 (error "No such buffer %s" buffer-or-name))))
123
124(defsubst normalize-live-frame (frame)
125 "Return frame specified by FRAME.
126FRAME must be a live frame and defaults to the selected frame."
127 (if frame
128 (if (frame-live-p frame)
129 frame
130 (error "%s is not a live frame" frame))
131 (selected-frame)))
132
133(defsubst normalize-any-window (window)
134 "Return window specified by WINDOW.
135WINDOW must be a window that has not been deleted and defaults to
136the selected window."
137 (if window
138 (if (window-any-p window)
139 window
140 (error "%s is not a window" window))
141 (selected-window)))
142
143(defsubst normalize-live-window (window)
144 "Return live window specified by WINDOW.
145WINDOW must be a live window and defaults to the selected one."
146 (if window
147 (if (and (windowp window) (window-buffer window))
148 window
149 (error "%s is not a live window" window))
150 (selected-window)))
151
152(defvar ignore-window-parameters nil
153 "If non-nil, standard functions ignore window parameters.
154The functions currently affected by this are `split-window',
155`delete-window', `delete-other-windows' and `other-window'.
156
157An application may bind this to a non-nil value around calls to
158these functions to inhibit processing of window parameters.")
159
a1511caf
MR
160(defconst window-safe-min-height 1
161 "The absolut minimum number of lines of a window.
162Anything less might crash Emacs.")
163
164(defconst window-safe-min-width 2
165 "The absolut minimum number of columns of a window.
166Anything less might crash Emacs.")
167
85cc1f11
MR
168(defun window-iso-combination-p (&optional window horizontal)
169 "If WINDOW is a vertical combination return WINDOW's first child.
170WINDOW can be any window and defaults to the selected one.
171Optional argument HORIZONTAL non-nil means return WINDOW's first
172child if WINDOW is a horizontal combination."
173 (setq window (normalize-any-window window))
174 (if horizontal
175 (window-hchild window)
176 (window-vchild window)))
177
178(defsubst window-iso-combined-p (&optional window horizontal)
179 "Return non-nil if and only if WINDOW is vertically combined.
180WINDOW can be any window and defaults to the selected one.
181Optional argument HORIZONTAL non-nil means return non-nil if and
182only if WINDOW is horizontally combined."
183 (setq window (normalize-any-window window))
184 (let ((parent (window-parent window)))
185 (and parent (window-iso-combination-p parent horizontal))))
186
187(defun window-iso-combinations (&optional window horizontal)
188 "Return largest number of vertically arranged subwindows of WINDOW.
189WINDOW can be any window and defaults to the selected one.
190Optional argument HORIZONTAL non-nil means to return the largest
191number of horizontally arranged subwindows of WINDOW."
192 (setq window (normalize-any-window window))
193 (cond
194 ((window-live-p window)
195 ;; If WINDOW is live, return 1.
196 1)
197 ((window-iso-combination-p window horizontal)
198 ;; If WINDOW is iso-combined, return the sum of the values for all
199 ;; subwindows of WINDOW.
200 (let ((child (window-child window))
201 (count 0))
202 (while child
203 (setq count
204 (+ (window-iso-combinations child horizontal)
205 count))
206 (setq child (window-right child)))
207 count))
208 (t
209 ;; If WINDOW is not iso-combined, return the maximum value of any
210 ;; subwindow of WINDOW.
211 (let ((child (window-child window))
212 (count 1))
213 (while child
214 (setq count
215 (max (window-iso-combinations child horizontal)
216 count))
217 (setq child (window-right child)))
218 count))))
219
220(defun walk-window-tree-1 (proc walk-window-tree-window any &optional sub-only)
221 "Helper function for `walk-window-tree' and `walk-window-subtree'."
222 (let (walk-window-tree-buffer)
223 (while walk-window-tree-window
224 (setq walk-window-tree-buffer
225 (window-buffer walk-window-tree-window))
226 (when (or walk-window-tree-buffer any)
227 (funcall proc walk-window-tree-window))
228 (unless walk-window-tree-buffer
229 (walk-window-tree-1
230 proc (window-hchild walk-window-tree-window) any)
231 (walk-window-tree-1
232 proc (window-vchild walk-window-tree-window) any))
233 (if sub-only
234 (setq walk-window-tree-window nil)
235 (setq walk-window-tree-window
236 (window-right walk-window-tree-window))))))
237
238(defun walk-window-tree (proc &optional frame any)
239 "Run function PROC on each live window of FRAME.
240PROC must be a function with one argument - a window. FRAME must
241be a live frame and defaults to the selected one. ANY, if
242non-nil means to run PROC on all live and internal windows of
243FRAME.
244
245This function performs a pre-order, depth-first traversal of the
246window tree. If PROC changes the window tree, the result is
247unpredictable."
248 (let ((walk-window-tree-frame (normalize-live-frame frame)))
249 (walk-window-tree-1
250 proc (frame-root-window walk-window-tree-frame) any)))
251
252(defun walk-window-subtree (proc &optional window any)
253 "Run function PROC on each live subwindow of WINDOW.
254WINDOW defaults to the selected window. PROC must be a function
255with one argument - a window. ANY, if non-nil means to run PROC
256on all live and internal subwindows of WINDOW.
257
258This function performs a pre-order, depth-first traversal of the
259window tree rooted at WINDOW. If PROC changes that window tree,
260the result is unpredictable."
261 (setq window (normalize-any-window window))
262 (walk-window-tree-1 proc window any t))
263
264(defun windows-with-parameter (parameter &optional value frame any values)
265 "Return a list of all windows on FRAME with PARAMETER non-nil.
266FRAME defaults to the selected frame. Optional argument VALUE
267non-nil means only return windows whose window-parameter value of
268PARAMETER equals VALUE \(comparison is done using `equal').
269Optional argument ANY non-nil means consider internal windows
270too. Optional argument VALUES non-nil means return a list of cons
271cells whose car is the value of the parameter and whose cdr is
272the window."
273 (let (this-value windows)
274 (walk-window-tree
275 (lambda (window)
276 (when (and (setq this-value (window-parameter window parameter))
277 (or (not value) (or (equal value this-value))))
278 (setq windows
279 (if values
280 (cons (cons this-value window) windows)
281 (cons window windows)))))
282 frame any)
283
284 (nreverse windows)))
285
286(defun window-with-parameter (parameter &optional value frame any)
287 "Return first window on FRAME with PARAMETER non-nil.
288FRAME defaults to the selected frame. Optional argument VALUE
289non-nil means only return a window whose window-parameter value
290for PARAMETER equals VALUE \(comparison is done with `equal').
291Optional argument ANY non-nil means consider internal windows
292too."
293 (let (this-value windows)
294 (catch 'found
295 (walk-window-tree
296 (lambda (window)
297 (when (and (setq this-value (window-parameter window parameter))
298 (or (not value) (equal value this-value)))
299 (throw 'found window)))
300 frame any))))
301
302;;; Atomic windows.
303(defun window-atom-root (&optional window)
304 "Return root of atomic window WINDOW is a part of.
305WINDOW can be any window and defaults to the selected one.
306Return nil if WINDOW is not part of a atomic window."
307 (setq window (normalize-any-window window))
308 (let (root)
309 (while (and window (window-parameter window 'window-atom))
310 (setq root window)
311 (setq window (window-parent window)))
312 root))
313
314(defun make-window-atom (window)
315 "Make WINDOW an atomic window.
316WINDOW must be an internal window. Return WINDOW."
317 (if (not (window-child window))
318 (error "Window %s is not an internal window" window)
319 (walk-window-subtree
320 (lambda (window)
321 (set-window-parameter window 'window-atom t))
322 window t)
323 window))
324
325(defun window-atom-check-1 (window)
326 "Subroutine of `window-atom-check'."
327 (when window
328 (if (window-parameter window 'window-atom)
329 (let ((count 0))
330 (when (or (catch 'reset
331 (walk-window-subtree
332 (lambda (window)
333 (if (window-parameter window 'window-atom)
334 (setq count (1+ count))
335 (throw 'reset t)))
336 window t))
337 ;; count >= 1 must hold here. If there's no other
338 ;; window around dissolve this atomic window.
339 (= count 1))
340 ;; Dissolve atomic window.
341 (walk-window-subtree
342 (lambda (window)
343 (set-window-parameter window 'window-atom nil))
344 window t)))
345 ;; Check children.
346 (unless (window-buffer window)
347 (window-atom-check-1 (window-hchild window))
348 (window-atom-check-1 (window-vchild window))))
349 ;; Check right sibling
350 (window-atom-check-1 (window-right window))))
351
352(defun window-atom-check (&optional frame)
353 "Check atomicity of all windows on FRAME.
354FRAME defaults to the selected frame. If an atomic window is
355wrongly configured, reset the atomicity of all its subwindows to
356nil. An atomic window is wrongly configured if it has no
357subwindows or one of its subwindows is not atomic."
358 (window-atom-check-1 (frame-root-window frame)))
359
360;; Side windows.
361(defvar window-sides '(left top right bottom)
362 "Window sides.")
363
364(defcustom window-sides-vertical nil
365 "If non-nil, left and right side windows are full height.
366Otherwise, top and bottom side windows are full width."
367 :type 'boolean
368 :group 'windows
369 :version "24.1")
370
371(defcustom window-sides-slots '(nil nil nil nil)
372 "Maximum number of side window slots.
373The value is a list of four elements specifying the number of
374side window slots on \(in this order) the left, top, right and
375bottom side of each frame. If an element is a number, this means
376to display at most that many side windows on the corresponding
377side. If an element is nil, this means there's no bound on the
378number of slots on that side."
379 :risky t
380 :type
381 '(list
382 :value (nil nil nil nil)
383 (choice
384 :tag "Left"
385 :help-echo "Maximum slots of left side window."
386 :value nil
387 :format "%[Left%] %v\n"
388 (const :tag "Unlimited" :format "%t" nil)
389 (integer :tag "Number" :value 2 :size 5))
390 (choice
391 :tag "Top"
392 :help-echo "Maximum slots of top side window."
393 :value nil
394 :format "%[Top%] %v\n"
395 (const :tag "Unlimited" :format "%t" nil)
396 (integer :tag "Number" :value 3 :size 5))
397 (choice
398 :tag "Right"
399 :help-echo "Maximum slots of right side window."
400 :value nil
401 :format "%[Right%] %v\n"
402 (const :tag "Unlimited" :format "%t" nil)
403 (integer :tag "Number" :value 2 :size 5))
404 (choice
405 :tag "Bottom"
406 :help-echo "Maximum slots of bottom side window."
407 :value nil
408 :format "%[Bottom%] %v\n"
409 (const :tag "Unlimited" :format "%t" nil)
410 (integer :tag "Number" :value 3 :size 5)))
411 :group 'windows)
412
413(defun window-side-check (&optional frame)
414 "Check the window-side parameter of all windows on FRAME.
415FRAME defaults to the selected frame. If the configuration is
416invalid, reset all window-side parameters to nil.
417
418A valid configuration has to preserve the following invariant:
419
420- If a window has a non-nil window-side parameter, it must have a
421 parent window and the parent window's window-side parameter
422 must be either nil or the same as for window.
423
424- If windows with non-nil window-side parameters exist, there
425 must be at most one window of each side and non-side with a
426 parent whose window-side parameter is nil and there must be no
427 leaf window whose window-side parameter is nil."
428 (let (normal none left top right bottom
429 side parent parent-side code)
430 (when (or (catch 'reset
431 (walk-window-tree
432 (lambda (window)
433 (setq side (window-parameter window 'window-side))
434 (setq parent (window-parent window))
435 (setq parent-side
436 (and parent (window-parameter parent 'window-side)))
437 ;; The following `cond' seems a bit tedious, but I'd
438 ;; rather stick to using just the stack.
439 (cond
440 (parent-side
441 (when (not (eq parent-side side))
442 ;; A parent whose window-side is non-nil must
443 ;; have a child with the same window-side.
444 (throw 'reset t)))
445 ;; Now check that there's more than one main window
446 ;; for any of none, left, top, right and bottom.
447 ((eq side 'none)
448 (if none
449 (throw 'reset t)
450 (setq none t)))
451 ((eq side 'left)
452 (if left
453 (throw 'reset t)
454 (setq left t)))
455 ((eq side 'top)
456 (if top
457 (throw 'reset t)
458 (setq top t)))
459 ((eq side 'right)
460 (if right
461 (throw 'reset t)
462 (setq right t)))
463 ((eq side 'bottom)
464 (if bottom
465 (throw 'reset t)
466 (setq bottom t)))
467 ((window-buffer window)
468 ;; A leaf window without window-side parameter,
469 ;; record its existence.
470 (setq normal t))))
471 frame t))
472 (if none
473 ;; At least one non-side window exists, so there must
474 ;; be at least one side-window and no normal window.
475 (or (not (or left top right bottom)) normal)
476 ;; No non-side window exists, so there must be no side
477 ;; window either.
478 (or left top right bottom)))
479 (walk-window-tree
480 (lambda (window)
481 (set-window-parameter window 'window-side nil))
482 frame t))))
483
484(defun window-check (&optional frame)
485 "Check atomic and side windows on FRAME.
486FRAME defaults to the selected frame."
487 (window-side-check frame)
488 (window-atom-check frame))
489
490;;; Window sizes.
491(defvar window-size-fixed nil
492 "Non-nil in a buffer means windows displaying the buffer are fixed-size.
493If the value is `height', then only the window's height is fixed.
494If the value is `width', then only the window's width is fixed.
495Any other non-nil value fixes both the width and the height.
496
497Emacs won't change the size of any window displaying that buffer,
498unless it has no other choice \(like when deleting a neighboring
499window).")
500(make-variable-buffer-local 'window-size-fixed)
501
a1511caf
MR
502(defsubst window-size-ignore (window ignore)
503 "Return non-nil if IGNORE says to ignore size restrictions for WINDOW."
504 (if (window-any-p ignore) (eq window ignore) ignore))
505
506(defun window-min-size (&optional window horizontal ignore)
507 "Return the minimum number of lines of WINDOW.
508WINDOW can be an arbitrary window and defaults to the selected
509one. Optional argument HORIZONTAL non-nil means return the
510minimum number of columns of WINDOW.
511
512Optional argument IGNORE non-nil means ignore any restrictions
513imposed by fixed size windows, `window-min-height' or
514`window-min-width' settings. IGNORE equal `safe' means live
515windows may get as small as `window-safe-min-height' lines and
516`window-safe-min-width' columns. IGNORE a window means ignore
517restrictions for that window only."
518 (window-min-size-1
519 (normalize-any-window window) horizontal ignore))
520
521(defun window-min-size-1 (window horizontal ignore)
522 "Internal function of `window-min-size'."
523 (let ((sub (window-child window)))
524 (if sub
525 (let ((value 0))
526 ;; WINDOW is an internal window.
527 (if (window-iso-combined-p sub horizontal)
528 ;; The minimum size of an iso-combination is the sum of
529 ;; the minimum sizes of its subwindows.
530 (while sub
531 (setq value (+ value
532 (window-min-size-1 sub horizontal ignore)))
533 (setq sub (window-right sub)))
534 ;; The minimum size of an ortho-combination is the maximum of
535 ;; the minimum sizes of its subwindows.
536 (while sub
537 (setq value (max value
538 (window-min-size-1 sub horizontal ignore)))
539 (setq sub (window-right sub))))
540 value)
541 (with-current-buffer (window-buffer window)
542 (cond
543 ((and (not (window-size-ignore window ignore))
544 (window-size-fixed-p window horizontal))
545 ;; The minimum size of a fixed size window is its size.
546 (window-total-size window horizontal))
547 ((or (eq ignore 'safe) (eq ignore window))
548 ;; If IGNORE equals `safe' or WINDOW return the safe values.
549 (if horizontal window-safe-min-width window-safe-min-height))
550 (horizontal
551 ;; For the minimum width of a window take fringes and
552 ;; scroll-bars into account. This is questionable and should
553 ;; be removed as soon as we are able to split (and resize)
554 ;; windows such that the new (or resized) windows can get a
555 ;; size less than the user-specified `window-min-height' and
556 ;; `window-min-width'.
557 (let ((frame (window-frame window))
558 (fringes (window-fringes window))
559 (scroll-bars (window-scroll-bars window)))
560 (max
561 (+ window-safe-min-width
562 (ceiling (car fringes) (frame-char-width frame))
563 (ceiling (cadr fringes) (frame-char-width frame))
564 (cond
565 ((memq (nth 2 scroll-bars) '(left right))
566 (nth 1 scroll-bars))
567 ((memq (frame-parameter frame 'vertical-scroll-bars)
568 '(left right))
569 (ceiling (or (frame-parameter frame 'scroll-bar-width) 14)
570 (frame-char-width)))
571 (t 0)))
572 (if (and (not (window-size-ignore window ignore))
573 (numberp window-min-width))
574 window-min-width
575 0))))
576 (t
577 ;; For the minimum height of a window take any mode- or
578 ;; header-line into account.
579 (max (+ window-safe-min-height
580 (if header-line-format 1 0)
581 (if mode-line-format 1 0))
582 (if (and (not (window-size-ignore window ignore))
583 (numberp window-min-height))
584 window-min-height
585 0))))))))
586
587(defun window-sizable (window delta &optional horizontal ignore)
588 "Return DELTA if DELTA lines can be added to WINDOW.
589Optional argument HORIZONTAL non-nil means return DELTA if DELTA
590columns can be added to WINDOW. A return value of zero means
591that no lines (or columns) can be added to WINDOW.
592
593This function looks only at WINDOW and its subwindows. The
594function `window-resizable' looks at other windows as well.
595
596DELTA positive means WINDOW shall be enlarged by DELTA lines or
597columns. If WINDOW cannot be enlarged by DELTA lines or columns
598return the maximum value in the range 0..DELTA by which WINDOW
599can be enlarged.
600
601DELTA negative means WINDOW shall be shrunk by -DELTA lines or
602columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
603return the minimum value in the range DELTA..0 by which WINDOW
604can be shrunk.
605
606Optional argument IGNORE non-nil means ignore any restrictions
607imposed by fixed size windows, `window-min-height' or
608`window-min-width' settings. IGNORE equal `safe' means live
609windows may get as small as `window-safe-min-height' lines and
610`window-safe-min-width' columns. IGNORE any window means ignore
611restrictions for that window only."
612 (setq window (normalize-any-window window))
613 (cond
614 ((< delta 0)
615 (max (- (window-min-size window horizontal ignore)
616 (window-total-size window horizontal))
617 delta))
618 ((window-size-ignore window ignore)
619 delta)
620 ((> delta 0)
621 (if (window-size-fixed-p window horizontal)
622 0
623 delta))
624 (t 0)))
625
626(defsubst window-sizable-p (window delta &optional horizontal ignore)
627 "Return t if WINDOW can be resized by DELTA lines.
628For the meaning of the arguments of this function see the
629doc-string of `window-sizable'."
630 (setq window (normalize-any-window window))
631 (if (> delta 0)
632 (>= (window-sizable window delta horizontal ignore) delta)
633 (<= (window-sizable window delta horizontal ignore) delta)))
634
635(defun window-size-fixed-1 (window horizontal)
636 "Internal function for `window-size-fixed-p'."
637 (let ((sub (window-child window)))
638 (catch 'fixed
639 (if sub
640 ;; WINDOW is an internal window.
641 (if (window-iso-combined-p sub horizontal)
642 ;; An iso-combination is fixed size if all its subwindows
643 ;; are fixed-size.
644 (progn
645 (while sub
646 (unless (window-size-fixed-1 sub horizontal)
647 ;; We found a non-fixed-size subwindow, so WINDOW's
648 ;; size is not fixed.
649 (throw 'fixed nil))
650 (setq sub (window-right sub)))
651 ;; All subwindows are fixed-size, so WINDOW's size is
652 ;; fixed.
653 (throw 'fixed t))
654 ;; An ortho-combination is fixed-size if at least one of its
655 ;; subwindows is fixed-size.
656 (while sub
657 (when (window-size-fixed-1 sub horizontal)
658 ;; We found a fixed-size subwindow, so WINDOW's size is
659 ;; fixed.
660 (throw 'fixed t))
661 (setq sub (window-right sub))))
662 ;; WINDOW is a live window.
663 (with-current-buffer (window-buffer window)
664 (if horizontal
665 (memq window-size-fixed '(width t))
666 (memq window-size-fixed '(height t))))))))
667
668(defun window-size-fixed-p (&optional window horizontal)
669 "Return non-nil if WINDOW's height is fixed.
670WINDOW can be an arbitrary window and defaults to the selected
671window. Optional argument HORIZONTAL non-nil means return
672non-nil if WINDOW's width is fixed.
673
674If this function returns nil, this does not necessarily mean that
675WINDOW can be resized in the desired direction. The functions
676`window-resizable' and `window-resizable-p' will tell that."
677 (window-size-fixed-1
678 (normalize-any-window window) horizontal))
679
680(defun window-min-delta-1 (window delta &optional horizontal ignore trail noup)
681 "Internal function for `window-min-delta'."
682 (if (not (window-parent window))
683 ;; If we can't go up, return zero.
684 0
685 ;; Else try to find a non-fixed-size sibling of WINDOW.
686 (let* ((parent (window-parent window))
687 (sub (window-child parent)))
688 (catch 'done
689 (if (window-iso-combined-p sub horizontal)
690 ;; In an iso-combination throw DELTA if we find at least one
691 ;; subwindow and that subwindow is either not of fixed-size
692 ;; or we can ignore fixed-sizeness.
693 (let ((skip (eq trail 'after)))
694 (while sub
695 (cond
696 ((eq sub window)
697 (setq skip (eq trail 'before)))
698 (skip)
699 ((and (not (window-size-ignore window ignore))
700 (window-size-fixed-p sub horizontal)))
701 (t
702 ;; We found a non-fixed-size subwindow.
703 (throw 'done delta)))
704 (setq sub (window-right sub))))
705 ;; In an ortho-combination set DELTA to the minimum value by
706 ;; which other subwindows can shrink.
707 (while sub
708 (unless (eq sub window)
709 (setq delta
710 (min delta
711 (- (window-total-size sub horizontal)
712 (window-min-size sub horizontal ignore)))))
713 (setq sub (window-right sub))))
714 (if noup
715 delta
716 (window-min-delta-1 parent delta horizontal ignore trail))))))
717
718(defun window-min-delta (&optional window horizontal ignore trail noup nodown)
719 "Return number of lines by which WINDOW can be shrunk.
720WINDOW can be an arbitrary window and defaults to the selected
721window. Return zero if WINDOW cannot be shrunk.
722
723Optional argument HORIZONTAL non-nil means return number of
724columns by which WINDOW can be shrunk.
725
726Optional argument IGNORE non-nil means ignore any restrictions
727imposed by fixed size windows, `window-min-height' or
728`window-min-width' settings. IGNORE a window means ignore
729restrictions for that window only. IGNORE equal `safe' means
730live windows may get as small as `window-safe-min-height' lines
731and `window-safe-min-width' columns.
732
733Optional argument TRAIL `before' means only windows to the left
734of or above WINDOW can be enlarged. Optional argument TRAIL
735`after' means only windows to the right of or below WINDOW can be
736enlarged.
737
738Optional argument NOUP non-nil means don't go up in the window
739tree but try to enlarge windows within WINDOW's combination only.
740
741Optional argument NODOWN non-nil means don't check whether WINDOW
742itself \(and its subwindows) can be shrunk; check only whether at
743least one other windows can be enlarged appropriately."
744 (setq window (normalize-any-window window))
745 (let ((size (window-total-size window horizontal))
746 (minimum (window-min-size window horizontal ignore)))
747 (cond
748 (nodown
749 ;; If NODOWN is t, try to recover the entire size of WINDOW.
750 (window-min-delta-1 window size horizontal ignore trail noup))
751 ((= size minimum)
752 ;; If NODOWN is nil and WINDOW's size is already at its minimum,
753 ;; there's nothing to recover.
754 0)
755 (t
756 ;; Otherwise, try to recover whatever WINDOW is larger than its
757 ;; minimum size.
758 (window-min-delta-1
759 window (- size minimum) horizontal ignore trail noup)))))
760
761(defun window-max-delta-1 (window delta &optional horizontal ignore trail noup)
762 "Internal function of `window-max-delta'."
763 (if (not (window-parent window))
764 ;; Can't go up. Return DELTA.
765 delta
766 (let* ((parent (window-parent window))
767 (sub (window-child parent)))
768 (catch 'fixed
769 (if (window-iso-combined-p sub horizontal)
770 ;; For an iso-combination calculate how much we can get from
771 ;; other subwindows.
772 (let ((skip (eq trail 'after)))
773 (while sub
774 (cond
775 ((eq sub window)
776 (setq skip (eq trail 'before)))
777 (skip)
778 (t
779 (setq delta
780 (+ delta
781 (- (window-total-size sub horizontal)
782 (window-min-size sub horizontal ignore))))))
783 (setq sub (window-right sub))))
784 ;; For an ortho-combination throw DELTA when at least one
785 ;; subwindow is fixed-size.
786 (while sub
787 (when (and (not (eq sub window))
788 (not (window-size-ignore sub ignore))
789 (window-size-fixed-p sub horizontal))
790 (throw 'fixed delta))
791 (setq sub (window-right sub))))
792 (if noup
793 ;; When NOUP is nil, DELTA is all we can get.
794 delta
795 ;; Else try with parent of WINDOW, passing the DELTA we
796 ;; recovered so far.
797 (window-max-delta-1 parent delta horizontal ignore trail))))))
798
799(defun window-max-delta (&optional window horizontal ignore trail noup nodown)
800 "Return maximum number of lines WINDOW by which WINDOW can be enlarged.
801WINDOW can be an arbitrary window and defaults to the selected
802window. The return value is zero if WINDOW cannot be enlarged.
803
804Optional argument HORIZONTAL non-nil means return maximum number
805of columns by which WINDOW can be enlarged.
806
807Optional argument IGNORE non-nil means ignore any restrictions
808imposed by fixed size windows, `window-min-height' or
809`window-min-width' settings. IGNORE a window means ignore
810restrictions for that window only. IGNORE equal `safe' means
811live windows may get as small as `window-safe-min-height' lines
812and `window-safe-min-width' columns.
813
814Optional argument TRAIL `before' means only windows to the left
815of or below WINDOW can be shrunk. Optional argument TRAIL
816`after' means only windows to the right of or above WINDOW can be
817shrunk.
818
819Optional argument NOUP non-nil means don't go up in the window
820tree but try to obtain the entire space from windows within
821WINDOW's combination.
822
823Optional argument NODOWN non-nil means do not check whether
824WINDOW itself \(and its subwindows) can be enlarged; check only
825whether other windows can be shrunk appropriately."
826 (setq window (normalize-any-window window))
827 (if (and (not (window-size-ignore window ignore))
828 (not nodown) (window-size-fixed-p window horizontal))
829 ;; With IGNORE and NOWDON nil return zero if WINDOW has fixed
830 ;; size.
831 0
832 ;; WINDOW has no fixed size.
833 (window-max-delta-1 window 0 horizontal ignore trail noup)))
834
835;; Make NOUP also inhibit the min-size check.
836(defun window-resizable (window delta &optional horizontal ignore trail noup nodown)
837 "Return DELTA if WINDOW can be resized vertically by DELTA lines.
838Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
839can be resized horizontally by DELTA columns. A return value of
840zero means that WINDOW is not resizable.
841
842DELTA positive means WINDOW shall be enlarged by DELTA lines or
843columns. If WINDOW cannot be enlarged by DELTA lines or columns
844return the maximum value in the range 0..DELTA by which WINDOW
845can be enlarged.
846
847DELTA negative means WINDOW shall be shrunk by -DELTA lines or
848columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
849return the minimum value in the range DELTA..0 that can be used
850for shrinking WINDOW.
851
852Optional argument IGNORE non-nil means ignore any restrictions
853imposed by fixed size windows, `window-min-height' or
854`window-min-width' settings. IGNORE a window means ignore
855restrictions for that window only. IGNORE equal `safe' means
856live windows may get as small as `window-safe-min-height' lines
857and `window-safe-min-width' columns.
858
859Optional argument TRAIL `before' means only windows to the left
860of or below WINDOW can be shrunk. Optional argument TRAIL
861`after' means only windows to the right of or above WINDOW can be
862shrunk.
863
864Optional argument NOUP non-nil means don't go up in the window
865tree but try to distribute the space among the other windows
866within WINDOW's combination.
867
868Optional argument NODOWN non-nil means don't check whether WINDOW
869and its subwindows can be resized."
870 (setq window (normalize-any-window window))
871 (cond
872 ((< delta 0)
873 (max (- (window-min-delta window horizontal ignore trail noup nodown))
874 delta))
875 ((> delta 0)
876 (min (window-max-delta window horizontal ignore trail noup nodown)
877 delta))
878 (t 0)))
879
880(defun window-resizable-p (window delta &optional horizontal ignore trail noup nodown)
881 "Return t if WINDOW can be resized vertically by DELTA lines.
882For the meaning of the arguments of this function see the
883doc-string of `window-resizable'."
884 (setq window (normalize-any-window window))
885 (if (> delta 0)
886 (>= (window-resizable window delta horizontal ignore trail noup nodown)
887 delta)
888 (<= (window-resizable window delta horizontal ignore trail noup nodown)
889 delta)))
890
891(defsubst window-total-height (&optional window)
892 "Return the total number of lines of WINDOW.
893WINDOW can be any window and defaults to the selected one. The
894return value includes WINDOW's mode line and header line, if any.
895If WINDOW is internal the return value is the sum of the total
896number of lines of WINDOW's child windows if these are vertically
897combined and the height of WINDOW's first child otherwise.
898
899Note: This function does not take into account the value of
900`line-spacing' when calculating the number of lines in WINDOW."
901 (window-total-size window))
3c448ab6 902
ccafbf06 903;; See discussion in bug#4543.
a1511caf
MR
904(defsubst window-full-height-p (&optional window)
905 "Return t if WINDOW is as high as the containing frame.
906More precisely, return t if and only if the total height of
907WINDOW equals the total height of the root window of WINDOW's
908frame. WINDOW can be any window and defaults to the selected
909one."
910 (setq window (normalize-any-window window))
911 (= (window-total-size window)
912 (window-total-size (frame-root-window window))))
913
914(defsubst window-total-width (&optional window)
915 "Return the total number of columns of WINDOW.
916WINDOW can be any window and defaults to the selected one. The
917return value includes any vertical dividers or scrollbars of
918WINDOW. If WINDOW is internal, the return value is the sum of
919the total number of columns of WINDOW's child windows if these
920are horizontally combined and the width of WINDOW's first child
921otherwise."
922 (window-total-size window t))
923
924(defsubst window-full-width-p (&optional window)
925 "Return t if WINDOW is as wide as the containing frame.
926More precisely, return t if and only if the total width of WINDOW
927equals the total width of the root window of WINDOW's frame.
928WINDOW can be any window and defaults to the selected one."
929 (setq window (normalize-any-window window))
930 (= (window-total-size window t)
931 (window-total-size (frame-root-window window) t)))
932
933(defsubst window-body-height (&optional window)
934 "Return the number of lines of WINDOW's body.
935WINDOW must be a live window and defaults to the selected one.
936
937The return value does not include WINDOW's mode line and header
938line, if any. If a line at the bottom of the window is only
939partially visible, that line is included in the return value. If
940you do not want to include a partially visible bottom line in the
941return value, use `window-text-height' instead."
942 (window-body-size window))
943
944(defsubst window-body-width (&optional window)
945 "Return the number of columns of WINDOW's body.
946WINDOW must be a live window and defaults to the selected one.
947
948The return value does not include any vertical dividers or scroll
949bars owned by WINDOW. On a window-system the return value does
950not include the number of columns used for WINDOW's fringes or
951display margins either."
952 (window-body-size window t))
02c6f098 953
3c448ab6
MR
954(defun one-window-p (&optional nomini all-frames)
955 "Return non-nil if the selected window is the only window.
956Optional arg NOMINI non-nil means don't count the minibuffer
957even if it is active. Otherwise, the minibuffer is counted
958when it is active.
959
960The optional arg ALL-FRAMES t means count windows on all frames.
aa248733
MS
961If it is `visible', count windows on all visible frames on the
962current terminal. ALL-FRAMES nil or omitted means count only the
963selected frame, plus the minibuffer it uses (which may be on
964another frame). ALL-FRAMES 0 means count all windows in all
965visible or iconified frames on the current terminal. If
966ALL-FRAMES is anything else, count only the selected frame."
3c448ab6
MR
967 (let ((base-window (selected-window)))
968 (if (and nomini (eq base-window (minibuffer-window)))
969 (setq base-window (next-window base-window)))
970 (eq base-window
971 (next-window base-window (if nomini 'arg) all-frames))))
972
973(defun window-current-scroll-bars (&optional window)
974 "Return the current scroll bar settings for WINDOW.
975WINDOW defaults to the selected window.
976
977The return value is a cons cell (VERTICAL . HORIZONTAL) where
978VERTICAL specifies the current location of the vertical scroll
979bars (`left', `right', or nil), and HORIZONTAL specifies the
980current location of the horizontal scroll bars (`top', `bottom',
981or nil).
982
983Unlike `window-scroll-bars', this function reports the scroll bar
984type actually used, once frame defaults and `scroll-bar-mode' are
985taken into account."
986 (let ((vert (nth 2 (window-scroll-bars window)))
987 (hor nil))
988 (when (or (eq vert t) (eq hor t))
989 (let ((fcsb (frame-current-scroll-bars
990 (window-frame (or window (selected-window))))))
991 (if (eq vert t)
992 (setq vert (car fcsb)))
993 (if (eq hor t)
994 (setq hor (cdr fcsb)))))
995 (cons vert hor)))
996
997(defun walk-windows (proc &optional minibuf all-frames)
998 "Cycle through all windows, calling PROC for each one.
999PROC must specify a function with a window as its sole argument.
1000The optional arguments MINIBUF and ALL-FRAMES specify the set of
1001windows to include in the walk, see also `next-window'.
1002
1003MINIBUF t means include the minibuffer window even if the
1004minibuffer is not active. MINIBUF nil or omitted means include
1005the minibuffer window only if the minibuffer is active. Any
1006other value means do not include the minibuffer window even if
1007the minibuffer is active.
1008
1009Several frames may share a single minibuffer; if the minibuffer
1010is active, all windows on all frames that share that minibuffer
1011are included too. Therefore, if you are using a separate
1012minibuffer frame and the minibuffer is active and MINIBUF says it
1013counts, `walk-windows' includes the windows in the frame from
1014which you entered the minibuffer, as well as the minibuffer
1015window.
1016
fb5f3a23
JB
1017ALL-FRAMES nil or omitted means cycle through all windows on the
1018 selected frame, plus the minibuffer window if specified by the
3c448ab6
MR
1019 MINIBUF argument, see above. If the minibuffer counts, cycle
1020 through all windows on all frames that share that minibuffer
1021 too.
1022ALL-FRAMES t means cycle through all windows on all existing
1023 frames.
1024ALL-FRAMES `visible' means cycle through all windows on all
aa248733 1025 visible frames on the current terminal.
3c448ab6 1026ALL-FRAMES 0 means cycle through all windows on all visible and
aa248733 1027 iconified frames on the current terminal.
3c448ab6
MR
1028ALL-FRAMES a frame means cycle through all windows on that frame
1029 only.
fb5f3a23
JB
1030Anything else means cycle through all windows on the selected
1031 frame and no others.
3c448ab6
MR
1032
1033This function changes neither the order of recently selected
1034windows nor the buffer list."
1035 ;; If we start from the minibuffer window, don't fail to come
1036 ;; back to it.
1037 (when (window-minibuffer-p (selected-window))
1038 (setq minibuf t))
1039 ;; Make sure to not mess up the order of recently selected
1040 ;; windows. Use `save-selected-window' and `select-window'
1041 ;; with second argument non-nil for this purpose.
1042 (save-selected-window
1043 (when (framep all-frames)
1044 (select-window (frame-first-window all-frames) 'norecord))
1045 (let* (walk-windows-already-seen
1046 (walk-windows-current (selected-window)))
1047 (while (progn
1048 (setq walk-windows-current
1049 (next-window walk-windows-current minibuf all-frames))
1050 (not (memq walk-windows-current walk-windows-already-seen)))
1051 (setq walk-windows-already-seen
1052 (cons walk-windows-current walk-windows-already-seen))
1053 (funcall proc walk-windows-current)))))
1054
1055(defun get-window-with-predicate (predicate &optional minibuf
1056 all-frames default)
1057 "Return a window satisfying PREDICATE.
1058More precisely, cycle through all windows using `walk-windows',
1059calling the function PREDICATE on each one of them with the
1060window as its sole argument. Return the first window for which
1061PREDICATE returns non-nil. If no window satisfies PREDICATE,
1062return DEFAULT.
1063
1064The optional arguments MINIBUF and ALL-FRAMES specify the set of
1065windows to include. See `walk-windows' for the meaning of these
1066arguments."
1067 (catch 'found
1068 (walk-windows #'(lambda (window)
1069 (when (funcall predicate window)
1070 (throw 'found window)))
1071 minibuf all-frames)
1072 default))
1073
1074(defalias 'some-window 'get-window-with-predicate)
1075
190b47e6
MR
1076(defun get-lru-window (&optional all-frames dedicated)
1077 "Return the least recently used window on frames specified by ALL-FRAMES.
1078Return a full-width window if possible. A minibuffer window is
1079never a candidate. A dedicated window is never a candidate
1080unless DEDICATED is non-nil, so if all windows are dedicated, the
1081value is nil. Avoid returning the selected window if possible.
1082
1083The following non-nil values of the optional argument ALL-FRAMES
1084have special meanings:
1085
1086- t means consider all windows on all existing frames.
1087
1088- `visible' means consider all windows on all visible frames on
1089 the current terminal.
1090
1091- 0 (the number zero) means consider all windows on all visible
1092 and iconified frames on the current terminal.
1093
1094- A frame means consider all windows on that frame only.
1095
1096Any other value of ALL-FRAMES means consider all windows on the
1097selected frame and no others."
1098 (let (best-window best-time second-best-window second-best-time time)
1099 (dolist (window (window-list-1 nil nil all-frames))
1100 (when (or dedicated (not (window-dedicated-p window)))
1101 (setq time (window-use-time window))
1102 (if (or (eq window (selected-window))
1103 (not (window-full-width-p window)))
1104 (when (or (not second-best-time) (< time second-best-time))
1105 (setq second-best-time time)
1106 (setq second-best-window window))
1107 (when (or (not best-time) (< time best-time))
1108 (setq best-time time)
1109 (setq best-window window)))))
1110 (or best-window second-best-window)))
1111
1112(defun get-largest-window (&optional all-frames dedicated)
1113 "Return the largest window on frames specified by ALL-FRAMES.
1114A minibuffer window is never a candidate. A dedicated window is
1115never a candidate unless DEDICATED is non-nil, so if all windows
1116are dedicated, the value is nil.
1117
1118The following non-nil values of the optional argument ALL-FRAMES
1119have special meanings:
1120
1121- t means consider all windows on all existing frames.
1122
1123- `visible' means consider all windows on all visible frames on
1124 the current terminal.
1125
1126- 0 (the number zero) means consider all windows on all visible
1127 and iconified frames on the current terminal.
1128
1129- A frame means consider all windows on that frame only.
1130
1131Any other value of ALL-FRAMES means consider all windows on the
1132selected frame and no others."
1133 (let ((best-size 0)
1134 best-window size)
1135 (dolist (window (window-list-1 nil nil all-frames))
1136 (when (or dedicated (not (window-dedicated-p window)))
1137 (setq size (* (window-total-size window)
1138 (window-total-size window t)))
1139 (when (> size best-size)
1140 (setq best-size size)
1141 (setq best-window window))))
1142 best-window))
1143
3c448ab6
MR
1144(defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
1145 "Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
1146BUFFER-OR-NAME may be a buffer or the name of an existing buffer
1147and defaults to the current buffer.
1148
190b47e6
MR
1149Any windows showing BUFFER-OR-NAME on the selected frame are listed
1150first.
1151
1152MINIBUF t means include the minibuffer window even if the
1153minibuffer is not active. MINIBUF nil or omitted means include
1154the minibuffer window only if the minibuffer is active. Any
1155other value means do not include the minibuffer window even if
1156the minibuffer is active.
1157
1158ALL-FRAMES nil or omitted means consider all windows on the
1159selected frame, plus the minibuffer window if specified by the
1160MINIBUF argument. If the minibuffer counts, consider all windows
1161on all frames that share that minibuffer too. The following
1162non-nil values of ALL-FRAMES have special meanings:
1163
1164- t means consider all windows on all existing frames.
1165
1166- `visible' means consider all windows on all visible frames on
1167 the current terminal.
1168
1169- 0 (the number zero) means consider all windows on all visible
1170 and iconified frames on the current terminal.
1171
1172- A frame means consider all windows on that frame only.
1173
1174Anything else means consider all windows on the selected frame
1175and no others."
1176 (let ((buffer (normalize-live-buffer buffer-or-name))
3c448ab6 1177 windows)
190b47e6
MR
1178 (dolist (window (window-list-1 (frame-first-window) minibuf all-frames))
1179 (when (eq (window-buffer window) buffer)
1180 (setq windows (cons window windows))))
1181 (nreverse windows)))
3c448ab6
MR
1182
1183(defun minibuffer-window-active-p (window)
1184 "Return t if WINDOW is the currently active minibuffer window."
1185 (eq window (active-minibuffer-window)))
1186\f
1187(defun count-windows (&optional minibuf)
1188 "Return the number of visible windows.
1189The optional argument MINIBUF specifies whether the minibuffer
1190window shall be counted. See `walk-windows' for the precise
1191meaning of this argument."
1192 (let ((count 0))
06b60517 1193 (walk-windows (lambda (_w) (setq count (+ count 1)))
3c448ab6
MR
1194 minibuf)
1195 count))
1196\f
1197;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1198;;; `balance-windows' subroutines using `window-tree'
1199
1200;;; Translate from internal window tree format
1201
1202(defun bw-get-tree (&optional window-or-frame)
1203 "Get a window split tree in our format.
1204
1205WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
1206then the whole window split tree for `selected-frame' is returned.
1207If it is a frame, then this is used instead. If it is a window,
1208then the smallest tree containing that window is returned."
1209 (when window-or-frame
1210 (unless (or (framep window-or-frame)
1211 (windowp window-or-frame))
1212 (error "Not a frame or window: %s" window-or-frame)))
1213 (let ((subtree (bw-find-tree-sub window-or-frame)))
1214 (when subtree
1215 (if (integerp subtree)
1216 nil
1217 (bw-get-tree-1 subtree)))))
1218
1219(defun bw-get-tree-1 (split)
1220 (if (windowp split)
1221 split
1222 (let ((dir (car split))
1223 (edges (car (cdr split)))
1224 (childs (cdr (cdr split))))
1225 (list
1226 (cons 'dir (if dir 'ver 'hor))
1227 (cons 'b (nth 3 edges))
1228 (cons 'r (nth 2 edges))
1229 (cons 't (nth 1 edges))
1230 (cons 'l (nth 0 edges))
1231 (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
1232
1233(defun bw-find-tree-sub (window-or-frame &optional get-parent)
1234 (let* ((window (when (windowp window-or-frame) window-or-frame))
1235 (frame (when (windowp window) (window-frame window)))
1236 (wt (car (window-tree frame))))
1237 (when (< 1 (length (window-list frame 0)))
1238 (if window
1239 (bw-find-tree-sub-1 wt window get-parent)
1240 wt))))
1241
1242(defun bw-find-tree-sub-1 (tree win &optional get-parent)
1243 (unless (windowp win) (error "Not a window: %s" win))
1244 (if (memq win tree)
1245 (if get-parent
1246 get-parent
1247 tree)
1248 (let ((childs (cdr (cdr tree)))
1249 child
1250 subtree)
1251 (while (and childs (not subtree))
1252 (setq child (car childs))
1253 (setq childs (cdr childs))
1254 (when (and child (listp child))
1255 (setq subtree (bw-find-tree-sub-1 child win get-parent))))
1256 (if (integerp subtree)
1257 (progn
1258 (if (= 1 subtree)
1259 tree
1260 (1- subtree)))
1261 subtree
1262 ))))
1263
1264;;; Window or object edges
1265
1266(defun bw-l (obj)
1267 "Left edge of OBJ."
1268 (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
1269(defun bw-t (obj)
1270 "Top edge of OBJ."
1271 (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
1272(defun bw-r (obj)
1273 "Right edge of OBJ."
1274 (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
1275(defun bw-b (obj)
1276 "Bottom edge of OBJ."
1277 (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
1278
1279;;; Split directions
1280
1281(defun bw-dir (obj)
1282 "Return window split tree direction if OBJ.
1283If OBJ is a window return 'both. If it is a window split tree
1284then return its direction."
1285 (if (symbolp obj)
1286 obj
1287 (if (windowp obj)
1288 'both
1289 (let ((dir (cdr (assq 'dir obj))))
1290 (unless (memq dir '(hor ver both))
1291 (error "Can't find dir in %s" obj))
1292 dir))))
1293
1294(defun bw-eqdir (obj1 obj2)
1295 "Return t if window split tree directions are equal.
1296OBJ1 and OBJ2 should be either windows or window split trees in
1297our format. The directions returned by `bw-dir' are compared and
1298t is returned if they are `eq' or one of them is 'both."
1299 (let ((dir1 (bw-dir obj1))
1300 (dir2 (bw-dir obj2)))
1301 (or (eq dir1 dir2)
1302 (eq dir1 'both)
1303 (eq dir2 'both))))
1304
1305;;; Building split tree
1306
1307(defun bw-refresh-edges (obj)
1308 "Refresh the edge information of OBJ and return OBJ."
1309 (unless (windowp obj)
1310 (let ((childs (cdr (assq 'childs obj)))
1311 (ol 1000)
1312 (ot 1000)
1313 (or -1)
1314 (ob -1))
1315 (dolist (o childs)
1316 (when (> ol (bw-l o)) (setq ol (bw-l o)))
1317 (when (> ot (bw-t o)) (setq ot (bw-t o)))
1318 (when (< or (bw-r o)) (setq or (bw-r o)))
1319 (when (< ob (bw-b o)) (setq ob (bw-b o))))
1320 (setq obj (delq 'l obj))
1321 (setq obj (delq 't obj))
1322 (setq obj (delq 'r obj))
1323 (setq obj (delq 'b obj))
1324 (add-to-list 'obj (cons 'l ol))
1325 (add-to-list 'obj (cons 't ot))
1326 (add-to-list 'obj (cons 'r or))
1327 (add-to-list 'obj (cons 'b ob))
1328 ))
1329 obj)
1330
1331;;; Balance windows
1332
1333(defun balance-windows (&optional window-or-frame)
1334 "Make windows the same heights or widths in window split subtrees.
1335
1336When called non-interactively WINDOW-OR-FRAME may be either a
1337window or a frame. It then balances the windows on the implied
1338frame. If the parameter is a window only the corresponding window
1339subtree is balanced."
1340 (interactive)
1341 (let (
1342 (wt (bw-get-tree window-or-frame))
1343 (w)
1344 (h)
1345 (tried-sizes)
1346 (last-sizes)
1347 (windows (window-list nil 0)))
1348 (when wt
1349 (while (not (member last-sizes tried-sizes))
1350 (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
1351 (setq last-sizes (mapcar (lambda (w)
1352 (window-edges w))
1353 windows))
1354 (when (eq 'hor (bw-dir wt))
1355 (setq w (- (bw-r wt) (bw-l wt))))
1356 (when (eq 'ver (bw-dir wt))
1357 (setq h (- (bw-b wt) (bw-t wt))))
1358 (bw-balance-sub wt w h)))))
1359
1360(defun bw-adjust-window (window delta horizontal)
1361 "Wrapper around `adjust-window-trailing-edge' with error checking.
1362Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
1363 ;; `adjust-window-trailing-edge' may fail if delta is too large.
1364 (while (>= (abs delta) 1)
06b60517 1365 (condition-case nil
3c448ab6
MR
1366 (progn
1367 (adjust-window-trailing-edge window delta horizontal)
1368 (setq delta 0))
1369 (error
1370 ;;(message "adjust: %s" (error-message-string err))
1371 (setq delta (/ delta 2))))))
1372
1373(defun bw-balance-sub (wt w h)
1374 (setq wt (bw-refresh-edges wt))
1375 (unless w (setq w (- (bw-r wt) (bw-l wt))))
1376 (unless h (setq h (- (bw-b wt) (bw-t wt))))
1377 (if (windowp wt)
1378 (progn
1379 (when w
1380 (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
1381 (when (/= 0 dw)
1382 (bw-adjust-window wt dw t))))
1383 (when h
1384 (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
1385 (when (/= 0 dh)
1386 (bw-adjust-window wt dh nil)))))
1387 (let* ((childs (cdr (assq 'childs wt)))
1388 (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
1389 (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
1390 (dolist (c childs)
1391 (bw-balance-sub c cw ch)))))
1392
1393(defun window-fixed-size-p (&optional window direction)
1394 "Return t if WINDOW cannot be resized in DIRECTION.
1395WINDOW defaults to the selected window. DIRECTION can be
1396nil (i.e. any), `height' or `width'."
1397 (with-current-buffer (window-buffer window)
1398 (when (and (boundp 'window-size-fixed) window-size-fixed)
1399 (not (and direction
1400 (member (cons direction window-size-fixed)
1401 '((height . width) (width . height))))))))
1402
1403;;; A different solution to balance-windows.
1404
1405(defvar window-area-factor 1
1406 "Factor by which the window area should be over-estimated.
1407This is used by `balance-windows-area'.
1408Changing this globally has no effect.")
1409(make-variable-buffer-local 'window-area-factor)
1410
1411(defun balance-windows-area ()
1412 "Make all visible windows the same area (approximately).
1413See also `window-area-factor' to change the relative size of
1414specific buffers."
1415 (interactive)
1416 (let* ((unchanged 0) (carry 0) (round 0)
1417 ;; Remove fixed-size windows.
1418 (wins (delq nil (mapcar (lambda (win)
1419 (if (not (window-fixed-size-p win)) win))
1420 (window-list nil 'nomini))))
1421 (changelog nil)
1422 next)
1423 ;; Resizing a window changes the size of surrounding windows in complex
1424 ;; ways, so it's difficult to balance them all. The introduction of
1425 ;; `adjust-window-trailing-edge' made it a bit easier, but it is still
1426 ;; very difficult to do. `balance-window' above takes an off-line
1427 ;; approach: get the whole window tree, then balance it, then try to
1428 ;; adjust the windows so they fit the result.
1429 ;; Here, instead, we take a "local optimization" approach, where we just
1430 ;; go through all the windows several times until nothing needs to be
1431 ;; changed. The main problem with this approach is that it's difficult
1432 ;; to make sure it terminates, so we use some heuristic to try and break
1433 ;; off infinite loops.
1434 ;; After a round without any change, we allow a second, to give a chance
1435 ;; to the carry to propagate a minor imbalance from the end back to
1436 ;; the beginning.
1437 (while (< unchanged 2)
1438 ;; (message "New round")
1439 (setq unchanged (1+ unchanged) round (1+ round))
1440 (dolist (win wins)
1441 (setq next win)
1442 (while (progn (setq next (next-window next))
1443 (window-fixed-size-p next)))
1444 ;; (assert (eq next (or (cadr (member win wins)) (car wins))))
1445 (let* ((horiz
1446 (< (car (window-edges win)) (car (window-edges next))))
1447 (areadiff (/ (- (* (window-height next) (window-width next)
1448 (buffer-local-value 'window-area-factor
1449 (window-buffer next)))
1450 (* (window-height win) (window-width win)
1451 (buffer-local-value 'window-area-factor
1452 (window-buffer win))))
1453 (max (buffer-local-value 'window-area-factor
1454 (window-buffer win))
1455 (buffer-local-value 'window-area-factor
1456 (window-buffer next)))))
1457 (edgesize (if horiz
1458 (+ (window-height win) (window-height next))
1459 (+ (window-width win) (window-width next))))
1460 (diff (/ areadiff edgesize)))
1461 (when (zerop diff)
1462 ;; Maybe diff is actually closer to 1 than to 0.
1463 (setq diff (/ (* 3 areadiff) (* 2 edgesize))))
1464 (when (and (zerop diff) (not (zerop areadiff)))
1465 (setq diff (/ (+ areadiff carry) edgesize))
1466 ;; Change things smoothly.
1467 (if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
1468 (if (zerop diff)
1469 ;; Make sure negligible differences don't accumulate to
1470 ;; become significant.
1471 (setq carry (+ carry areadiff))
1472 (bw-adjust-window win diff horiz)
1473 ;; (sit-for 0.5)
1474 (let ((change (cons win (window-edges win))))
1475 ;; If the same change has been seen already for this window,
1476 ;; we're most likely in an endless loop, so don't count it as
1477 ;; a change.
1478 (unless (member change changelog)
1479 (push change changelog)
1480 (setq unchanged 0 carry 0)))))))
1481 ;; We've now basically balanced all the windows.
1482 ;; But there may be some minor off-by-one imbalance left over,
1483 ;; so let's do some fine tuning.
1484 ;; (bw-finetune wins)
1485 ;; (message "Done in %d rounds" round)
1486 ))
1487
1488\f
1489(defcustom display-buffer-function nil
1490 "If non-nil, function to call to handle `display-buffer'.
1491It will receive two args, the buffer and a flag which if non-nil
1492means that the currently selected window is not acceptable. It
1493should choose or create a window, display the specified buffer in
1494it, and return the window.
1495
1496Commands such as `switch-to-buffer-other-window' and
1497`find-file-other-window' work using this function."
1498 :type '(choice
1499 (const nil)
1500 (function :tag "function"))
1501 :group 'windows)
1502
56f31926
MR
1503(defcustom special-display-buffer-names nil
1504 "List of names of buffers that should be displayed specially.
1505Displaying a buffer with `display-buffer' or `pop-to-buffer', if
1506its name is in this list, displays the buffer in a way specified
1507by `special-display-function'. `special-display-popup-frame'
1508\(the default for `special-display-function') usually displays
1509the buffer in a separate frame made with the parameters specified
1510by `special-display-frame-alist'. If `special-display-function'
1511has been set to some other function, that function is called with
1512the buffer as first, and nil as second argument.
1513
1514Alternatively, an element of this list can be specified as
1515\(BUFFER-NAME FRAME-PARAMETERS), where BUFFER-NAME is a buffer
1516name and FRAME-PARAMETERS an alist of \(PARAMETER . VALUE) pairs.
1517`special-display-popup-frame' will interpret such pairs as frame
1518parameters when it creates a special frame, overriding the
1519corresponding values from `special-display-frame-alist'.
1520
1521As a special case, if FRAME-PARAMETERS contains (same-window . t)
1522`special-display-popup-frame' displays that buffer in the
1523selected window. If FRAME-PARAMETERS contains (same-frame . t),
1524it displays that buffer in a window on the selected frame.
1525
1526If `special-display-function' specifies some other function than
1527`special-display-popup-frame', that function is called with the
1528buffer named BUFFER-NAME as first, and FRAME-PARAMETERS as second
1529argument.
1530
1531Finally, an element of this list can be also specified as
1532\(BUFFER-NAME FUNCTION OTHER-ARGS). In that case,
1533`special-display-popup-frame' will call FUNCTION with the buffer
1534named BUFFER-NAME as first argument, and OTHER-ARGS as the
1535second. If `special-display-function' specifies some other
1536function, that function is called with the buffer named
1537BUFFER-NAME as first, and the element's cdr as second argument.
1538
1539If this variable appears \"not to work\", because you added a
1540name to it but the corresponding buffer is displayed in the
1541selected window, look at the values of `same-window-buffer-names'
1542and `same-window-regexps'. Those variables take precedence over
1543this one.
1544
1545See also `special-display-regexps'."
1546 :type '(repeat
1547 (choice :tag "Buffer"
1548 :value ""
1549 (string :format "%v")
1550 (cons :tag "With parameters"
1551 :format "%v"
1552 :value ("" . nil)
1553 (string :format "%v")
1554 (repeat :tag "Parameters"
1555 (cons :format "%v"
1556 (symbol :tag "Parameter")
1557 (sexp :tag "Value"))))
1558 (list :tag "With function"
1559 :format "%v"
1560 :value ("" . nil)
1561 (string :format "%v")
1562 (function :tag "Function")
1563 (repeat :tag "Arguments" (sexp)))))
1564 :group 'windows
1565 :group 'frames)
1566
ac549fa5
GM
1567;;;###autoload
1568(put 'special-display-buffer-names 'risky-local-variable t)
1569
56f31926
MR
1570(defcustom special-display-regexps nil
1571 "List of regexps saying which buffers should be displayed specially.
1572Displaying a buffer with `display-buffer' or `pop-to-buffer', if
1573any regexp in this list matches its name, displays it specially
1574using `special-display-function'. `special-display-popup-frame'
1575\(the default for `special-display-function') usually displays
1576the buffer in a separate frame made with the parameters specified
1577by `special-display-frame-alist'. If `special-display-function'
1578has been set to some other function, that function is called with
1579the buffer as first, and nil as second argument.
1580
1581Alternatively, an element of this list can be specified as
1582\(REGEXP FRAME-PARAMETERS), where REGEXP is a regexp as above and
1583FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
1584`special-display-popup-frame' will then interpret these pairs as
1585frame parameters when creating a special frame for a buffer whose
1586name matches REGEXP, overriding the corresponding values from
1587`special-display-frame-alist'.
1588
1589As a special case, if FRAME-PARAMETERS contains (same-window . t)
1590`special-display-popup-frame' displays buffers matching REGEXP in
1591the selected window. \(same-frame . t) in FRAME-PARAMETERS means
1592to display such buffers in a window on the selected frame.
1593
1594If `special-display-function' specifies some other function than
1595`special-display-popup-frame', that function is called with the
1596buffer whose name matched REGEXP as first, and FRAME-PARAMETERS
1597as second argument.
1598
1599Finally, an element of this list can be also specified as
1600\(REGEXP FUNCTION OTHER-ARGS). `special-display-popup-frame'
1601will then call FUNCTION with the buffer whose name matched
1602REGEXP as first, and OTHER-ARGS as second argument. If
1603`special-display-function' specifies some other function, that
1604function is called with the buffer whose name matched REGEXP
1605as first, and the element's cdr as second argument.
1606
1607If this variable appears \"not to work\", because you added a
1608name to it but the corresponding buffer is displayed in the
1609selected window, look at the values of `same-window-buffer-names'
1610and `same-window-regexps'. Those variables take precedence over
1611this one.
1612
1613See also `special-display-buffer-names'."
1614 :type '(repeat
1615 (choice :tag "Buffer"
1616 :value ""
1617 (regexp :format "%v")
1618 (cons :tag "With parameters"
1619 :format "%v"
1620 :value ("" . nil)
1621 (regexp :format "%v")
1622 (repeat :tag "Parameters"
1623 (cons :format "%v"
1624 (symbol :tag "Parameter")
1625 (sexp :tag "Value"))))
1626 (list :tag "With function"
1627 :format "%v"
1628 :value ("" . nil)
1629 (regexp :format "%v")
1630 (function :tag "Function")
1631 (repeat :tag "Arguments" (sexp)))))
1632 :group 'windows
1633 :group 'frames)
1634
3c448ab6
MR
1635(defun special-display-p (buffer-name)
1636 "Return non-nil if a buffer named BUFFER-NAME gets a special frame.
56f31926
MR
1637More precisely, return t if `special-display-buffer-names' or
1638`special-display-regexps' contain a string entry equaling or
1639matching BUFFER-NAME. If `special-display-buffer-names' or
1640`special-display-regexps' contain a list entry whose car equals
1641or matches BUFFER-NAME, the return value is the cdr of that
1642entry."
98722073
MR
1643 (let (tmp)
1644 (cond
1645 ((not (stringp buffer-name)))
1646 ((member buffer-name special-display-buffer-names)
1647 t)
1648 ((setq tmp (assoc buffer-name special-display-buffer-names))
1649 (cdr tmp))
1650 ((catch 'found
1651 (dolist (regexp special-display-regexps)
1652 (cond
1653 ((stringp regexp)
1654 (when (string-match-p regexp buffer-name)
1655 (throw 'found t)))
1656 ((and (consp regexp) (stringp (car regexp))
1657 (string-match-p (car regexp) buffer-name))
1658 (throw 'found (cdr regexp))))))))))
3c448ab6
MR
1659
1660(defcustom special-display-function 'special-display-popup-frame
56f31926
MR
1661 "Function to call for displaying special buffers.
1662This function is called with two arguments - the buffer and,
1663optionally, a list - and should return a window displaying that
1664buffer. The default value usually makes a separate frame for the
1665buffer using `special-display-frame-alist' to specify the frame
1666parameters. See the definition of `special-display-popup-frame'
1667for how to specify such a function.
1668
1669A buffer is special when its name is either listed in
3c448ab6
MR
1670`special-display-buffer-names' or matches a regexp in
1671`special-display-regexps'."
1672 :type 'function
1673 :group 'frames)
1674
3c448ab6
MR
1675(defcustom same-window-buffer-names nil
1676 "List of names of buffers that should appear in the \"same\" window.
1677`display-buffer' and `pop-to-buffer' show a buffer whose name is
1678on this list in the selected rather than some other window.
1679
1680An element of this list can be a cons cell instead of just a
56f31926
MR
1681string. In that case, the cell's car must be a string specifying
1682the buffer name. This is for compatibility with
3c448ab6
MR
1683`special-display-buffer-names'; the cdr of the cons cell is
1684ignored.
1685
1686See also `same-window-regexps'."
1687 :type '(repeat (string :format "%v"))
1688 :group 'windows)
1689
1690(defcustom same-window-regexps nil
1691 "List of regexps saying which buffers should appear in the \"same\" window.
1692`display-buffer' and `pop-to-buffer' show a buffer whose name
1693matches a regexp on this list in the selected rather than some
1694other window.
1695
1696An element of this list can be a cons cell instead of just a
56f31926 1697string. In that case, the cell's car must be a regexp matching
3c448ab6 1698the buffer name. This is for compatibility with
56f31926 1699`special-display-regexps'; the cdr of the cons cell is ignored.
3c448ab6
MR
1700
1701See also `same-window-buffer-names'."
1702 :type '(repeat (regexp :format "%v"))
1703 :group 'windows)
1704
56f31926
MR
1705(defun same-window-p (buffer-name)
1706 "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
1707This function returns non-nil if `display-buffer' or
1708`pop-to-buffer' would show a buffer named BUFFER-NAME in the
1709selected rather than \(as usual\) some other window. See
1710`same-window-buffer-names' and `same-window-regexps'."
1711 (cond
1712 ((not (stringp buffer-name)))
1713 ;; The elements of `same-window-buffer-names' can be buffer
1714 ;; names or cons cells whose cars are buffer names.
1715 ((member buffer-name same-window-buffer-names))
1716 ((assoc buffer-name same-window-buffer-names))
1717 ((catch 'found
1718 (dolist (regexp same-window-regexps)
1719 ;; The elements of `same-window-regexps' can be regexps
1720 ;; or cons cells whose cars are regexps.
1721 (when (or (and (stringp regexp)
1722 (string-match regexp buffer-name))
1723 (and (consp regexp) (stringp (car regexp))
1724 (string-match-p (car regexp) buffer-name)))
1725 (throw 'found t)))))))
1726
3c448ab6
MR
1727(defcustom pop-up-frames nil
1728 "Whether `display-buffer' should make a separate frame.
d1f18ec0 1729If nil, never make a separate frame.
3c448ab6
MR
1730If the value is `graphic-only', make a separate frame
1731on graphic displays only.
1732Any other non-nil value means always make a separate frame."
1733 :type '(choice
1734 (const :tag "Never" nil)
1735 (const :tag "On graphic displays only" graphic-only)
1736 (const :tag "Always" t))
1737 :group 'windows)
1738
1739(defcustom display-buffer-reuse-frames nil
1740 "Non-nil means `display-buffer' should reuse frames.
1741If the buffer in question is already displayed in a frame, raise
1742that frame."
1743 :type 'boolean
1744 :version "21.1"
1745 :group 'windows)
1746
1747(defcustom pop-up-windows t
1748 "Non-nil means `display-buffer' should make a new window."
1749 :type 'boolean
1750 :group 'windows)
1751
8b10a2d1
MR
1752(defcustom split-window-preferred-function 'split-window-sensibly
1753 "Function called by `display-buffer' routines to split a window.
1754This function is called with a window as single argument and is
1755supposed to split that window and return the new window. If the
1756window can (or shall) not be split, it is supposed to return nil.
1757The default is to call the function `split-window-sensibly' which
1758tries to split the window in a way which seems most suitable.
1759You can customize the options `split-height-threshold' and/or
1760`split-width-threshold' in order to have `split-window-sensibly'
1761prefer either vertical or horizontal splitting.
1762
1763If you set this to any other function, bear in mind that the
1764`display-buffer' routines may call this function two times. The
1765argument of the first call is the largest window on its frame.
1766If that call fails to return a live window, the function is
1767called again with the least recently used window as argument. If
1768that call fails too, `display-buffer' will use an existing window
1769to display its buffer.
1770
1771The window selected at the time `display-buffer' was invoked is
1772still selected when this function is called. Hence you can
1773compare the window argument with the value of `selected-window'
1774if you intend to split the selected window instead or if you do
1775not want to split the selected window."
1776 :type 'function
3c448ab6
MR
1777 :version "23.1"
1778 :group 'windows)
1779
8b10a2d1
MR
1780(defcustom split-height-threshold 80
1781 "Minimum height for splitting windows sensibly.
1782If this is an integer, `split-window-sensibly' may split a window
1783vertically only if it has at least this many lines. If this is
1784nil, `split-window-sensibly' is not allowed to split a window
1785vertically. If, however, a window is the only window on its
1786frame, `split-window-sensibly' may split it vertically
1787disregarding the value of this variable."
1788 :type '(choice (const nil) (integer :tag "lines"))
3c448ab6
MR
1789 :version "23.1"
1790 :group 'windows)
1791
8b10a2d1
MR
1792(defcustom split-width-threshold 160
1793 "Minimum width for splitting windows sensibly.
1794If this is an integer, `split-window-sensibly' may split a window
1795horizontally only if it has at least this many columns. If this
1796is nil, `split-window-sensibly' is not allowed to split a window
1797horizontally."
1798 :type '(choice (const nil) (integer :tag "columns"))
3c448ab6
MR
1799 :version "23.1"
1800 :group 'windows)
1801
8b10a2d1
MR
1802(defun window-splittable-p (window &optional horizontal)
1803 "Return non-nil if `split-window-sensibly' may split WINDOW.
1804Optional argument HORIZONTAL nil or omitted means check whether
1805`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
1806non-nil means check whether WINDOW may be split horizontally.
3c448ab6 1807
8b10a2d1 1808WINDOW may be split vertically when the following conditions
3c448ab6 1809hold:
3c448ab6
MR
1810- `window-size-fixed' is either nil or equals `width' for the
1811 buffer of WINDOW.
8b10a2d1 1812- `split-height-threshold' is an integer and WINDOW is at least as
3c448ab6 1813 high as `split-height-threshold'.
3c448ab6
MR
1814- When WINDOW is split evenly, the emanating windows are at least
1815 `window-min-height' lines tall and can accommodate at least one
1816 line plus - if WINDOW has one - a mode line.
1817
8b10a2d1 1818WINDOW may be split horizontally when the following conditions
3c448ab6 1819hold:
3c448ab6
MR
1820- `window-size-fixed' is either nil or equals `height' for the
1821 buffer of WINDOW.
8b10a2d1 1822- `split-width-threshold' is an integer and WINDOW is at least as
3c448ab6 1823 wide as `split-width-threshold'.
3c448ab6
MR
1824- When WINDOW is split evenly, the emanating windows are at least
1825 `window-min-width' or two (whichever is larger) columns wide."
1826 (when (window-live-p window)
1827 (with-current-buffer (window-buffer window)
1828 (if horizontal
1829 ;; A window can be split horizontally when its width is not
1830 ;; fixed, it is at least `split-width-threshold' columns wide
1831 ;; and at least twice as wide as `window-min-width' and 2 (the
1832 ;; latter value is hardcoded).
1833 (and (memq window-size-fixed '(nil height))
1834 ;; Testing `window-full-width-p' here hardly makes any
1835 ;; sense nowadays. This can be done more intuitively by
1836 ;; setting up `split-width-threshold' appropriately.
1837 (numberp split-width-threshold)
1838 (>= (window-width window)
1839 (max split-width-threshold
1840 (* 2 (max window-min-width 2)))))
1841 ;; A window can be split vertically when its height is not
1842 ;; fixed, it is at least `split-height-threshold' lines high,
1843 ;; and it is at least twice as high as `window-min-height' and 2
1844 ;; if it has a modeline or 1.
1845 (and (memq window-size-fixed '(nil width))
1846 (numberp split-height-threshold)
1847 (>= (window-height window)
1848 (max split-height-threshold
1849 (* 2 (max window-min-height
1850 (if mode-line-format 2 1))))))))))
1851
8b10a2d1
MR
1852(defun split-window-sensibly (window)
1853 "Split WINDOW in a way suitable for `display-buffer'.
1854If `split-height-threshold' specifies an integer, WINDOW is at
1855least `split-height-threshold' lines tall and can be split
1856vertically, split WINDOW into two windows one above the other and
1857return the lower window. Otherwise, if `split-width-threshold'
1858specifies an integer, WINDOW is at least `split-width-threshold'
1859columns wide and can be split horizontally, split WINDOW into two
1860windows side by side and return the window on the right. If this
1861can't be done either and WINDOW is the only window on its frame,
1862try to split WINDOW vertically disregarding any value specified
1863by `split-height-threshold'. If that succeeds, return the lower
1864window. Return nil otherwise.
1865
1866By default `display-buffer' routines call this function to split
1867the largest or least recently used window. To change the default
1868customize the option `split-window-preferred-function'.
1869
1870You can enforce this function to not split WINDOW horizontally,
1871by setting \(or binding) the variable `split-width-threshold' to
1872nil. If, in addition, you set `split-height-threshold' to zero,
1873chances increase that this function does split WINDOW vertically.
1874
1875In order to not split WINDOW vertically, set \(or bind) the
1876variable `split-height-threshold' to nil. Additionally, you can
1877set `split-width-threshold' to zero to make a horizontal split
1878more likely to occur.
1879
1880Have a look at the function `window-splittable-p' if you want to
1881know how `split-window-sensibly' determines whether WINDOW can be
1882split."
1883 (or (and (window-splittable-p window)
1884 ;; Split window vertically.
1885 (with-selected-window window
1886 (split-window-vertically)))
1887 (and (window-splittable-p window t)
1888 ;; Split window horizontally.
1889 (with-selected-window window
1890 (split-window-horizontally)))
1891 (and (eq window (frame-root-window (window-frame window)))
1892 (not (window-minibuffer-p window))
1893 ;; If WINDOW is the only window on its frame and is not the
1894 ;; minibuffer window, try to split it vertically disregarding
1895 ;; the value of `split-height-threshold'.
1896 (let ((split-height-threshold 0))
1897 (when (window-splittable-p window)
1898 (with-selected-window window
1899 (split-window-vertically)))))))
1900
3c448ab6 1901(defun window--try-to-split-window (window)
8b10a2d1
MR
1902 "Try to split WINDOW.
1903Return value returned by `split-window-preferred-function' if it
1904represents a live window, nil otherwise."
1905 (and (window-live-p window)
1906 (not (frame-parameter (window-frame window) 'unsplittable))
1907 (let ((new-window
1908 ;; Since `split-window-preferred-function' might
1909 ;; throw an error use `condition-case'.
1910 (condition-case nil
1911 (funcall split-window-preferred-function window)
1912 (error nil))))
1913 (and (window-live-p new-window) new-window))))
3c448ab6
MR
1914
1915(defun window--frame-usable-p (frame)
1916 "Return FRAME if it can be used to display a buffer."
1917 (when (frame-live-p frame)
1918 (let ((window (frame-root-window frame)))
1919 ;; `frame-root-window' may be an internal window which is considered
1920 ;; "dead" by `window-live-p'. Hence if `window' is not live we
1921 ;; implicitly know that `frame' has a visible window we can use.
4afba819
SM
1922 (unless (and (window-live-p window)
1923 (or (window-minibuffer-p window)
1924 ;; If the window is soft-dedicated, the frame is usable.
064e57de
SM
1925 ;; Actually, even if the window is really dedicated,
1926 ;; the frame is still usable by splitting it.
1927 ;; At least Emacs-22 allowed it, and it is desirable
1928 ;; when displaying same-frame windows.
1929 nil ; (eq t (window-dedicated-p window))
1930 ))
3c448ab6
MR
1931 frame))))
1932
1933(defcustom even-window-heights t
1934 "If non-nil `display-buffer' will try to even window heights.
1935Otherwise `display-buffer' will leave the window configuration
1936alone. Heights are evened only when `display-buffer' chooses a
1937window that appears above or below the selected window."
1938 :type 'boolean
1939 :group 'windows)
1940
1941(defun window--even-window-heights (window)
1942 "Even heights of WINDOW and selected window.
1943Do this only if these windows are vertically adjacent to each
1944other, `even-window-heights' is non-nil, and the selected window
1945is higher than WINDOW."
1946 (when (and even-window-heights
1947 (not (eq window (selected-window)))
1948 ;; Don't resize minibuffer windows.
1949 (not (window-minibuffer-p (selected-window)))
d1f18ec0 1950 (> (window-height (selected-window)) (window-height window))
3c448ab6
MR
1951 (eq (window-frame window) (window-frame (selected-window)))
1952 (let ((sel-edges (window-edges (selected-window)))
1953 (win-edges (window-edges window)))
1954 (and (= (nth 0 sel-edges) (nth 0 win-edges))
1955 (= (nth 2 sel-edges) (nth 2 win-edges))
1956 (or (= (nth 1 sel-edges) (nth 3 win-edges))
1957 (= (nth 3 sel-edges) (nth 1 win-edges))))))
1958 (let ((window-min-height 1))
1959 ;; Don't throw an error if we can't even window heights for
1960 ;; whatever reason.
1961 (condition-case nil
1962 (enlarge-window (/ (- (window-height window) (window-height)) 2))
1963 (error nil)))))
1964
1965(defun window--display-buffer-1 (window)
1966 "Raise the frame containing WINDOW.
1967Do not raise the selected frame. Return WINDOW."
1968 (let* ((frame (window-frame window))
1969 (visible (frame-visible-p frame)))
1970 (unless (or (not visible)
1971 ;; Assume the selected frame is already visible enough.
1972 (eq frame (selected-frame))
1973 ;; Assume the frame from which we invoked the minibuffer
1974 ;; is visible.
1975 (and (minibuffer-window-active-p (selected-window))
1976 (eq frame (window-frame (minibuffer-selected-window)))))
1977 (raise-frame frame))
1978 window))
1979
04ae543a 1980(defun window--display-buffer-2 (buffer window &optional dedicated)
3c448ab6 1981 "Display BUFFER in WINDOW and make its frame visible.
04ae543a 1982Set `window-dedicated-p' to DEDICATED if non-nil.
3c448ab6
MR
1983Return WINDOW."
1984 (when (and (buffer-live-p buffer) (window-live-p window))
1985 (set-window-buffer window buffer)
04ae543a 1986 (when dedicated
782d6e30 1987 (set-window-dedicated-p window dedicated))
3c448ab6
MR
1988 (window--display-buffer-1 window)))
1989
d2c9fc42
SM
1990(defvar display-buffer-mark-dedicated nil
1991 "If non-nil, `display-buffer' marks the windows it creates as dedicated.
1992The actual non-nil value of this variable will be copied to the
1993`window-dedicated-p' flag.")
1994
3c448ab6
MR
1995(defun display-buffer (buffer-or-name &optional not-this-window frame)
1996 "Make buffer BUFFER-OR-NAME appear in some window but don't select it.
1997BUFFER-OR-NAME must be a buffer or the name of an existing
1998buffer. Return the window chosen to display BUFFER-OR-NAME or
1999nil if no such window is found.
2000
2001Optional argument NOT-THIS-WINDOW non-nil means display the
2002buffer in a window other than the selected one, even if it is
2003already displayed in the selected window.
2004
2005Optional argument FRAME specifies which frames to investigate
2006when the specified buffer is already displayed. If the buffer is
2007already displayed in some window on one of these frames simply
2008return that window. Possible values of FRAME are:
2009
aa248733
MS
2010`visible' - consider windows on all visible frames on the current
2011terminal.
3c448ab6 2012
aa248733
MS
20130 - consider windows on all visible or iconified frames on the
2014current terminal.
3c448ab6
MR
2015
2016t - consider windows on all frames.
2017
2018A specific frame - consider windows on that frame only.
2019
2020nil - consider windows on the selected frame \(actually the
2021last non-minibuffer frame\) only. If, however, either
2022`display-buffer-reuse-frames' or `pop-up-frames' is non-nil
2023\(non-nil and not graphic-only on a text-only terminal),
aa248733 2024consider all visible or iconified frames on the current terminal."
3c448ab6
MR
2025 (interactive "BDisplay buffer:\nP")
2026 (let* ((can-use-selected-window
2027 ;; The selected window is usable unless either NOT-THIS-WINDOW
2028 ;; is non-nil, it is dedicated to its buffer, or it is the
2029 ;; `minibuffer-window'.
2030 (not (or not-this-window
2031 (window-dedicated-p (selected-window))
2032 (window-minibuffer-p))))
2033 (buffer (if (bufferp buffer-or-name)
2034 buffer-or-name
2035 (get-buffer buffer-or-name)))
2036 (name-of-buffer (buffer-name buffer))
2037 ;; On text-only terminals do not pop up a new frame when
2038 ;; `pop-up-frames' equals graphic-only.
2039 (use-pop-up-frames (if (eq pop-up-frames 'graphic-only)
2040 (display-graphic-p)
2041 pop-up-frames))
2042 ;; `frame-to-use' is the frame where to show `buffer' - either
2043 ;; the selected frame or the last nonminibuffer frame.
2044 (frame-to-use
2045 (or (window--frame-usable-p (selected-frame))
2046 (window--frame-usable-p (last-nonminibuffer-frame))))
2047 ;; `window-to-use' is the window we use for showing `buffer'.
2048 window-to-use)
2049 (cond
2050 ((not (buffer-live-p buffer))
2051 (error "No such buffer %s" buffer))
2052 (display-buffer-function
2053 ;; Let `display-buffer-function' do the job.
2054 (funcall display-buffer-function buffer not-this-window))
2055 ((and (not not-this-window)
2056 (eq (window-buffer (selected-window)) buffer))
2057 ;; The selected window already displays BUFFER and
2058 ;; `not-this-window' is nil, so use it.
2059 (window--display-buffer-1 (selected-window)))
2060 ((and can-use-selected-window (same-window-p name-of-buffer))
2061 ;; If the buffer's name tells us to use the selected window do so.
2062 (window--display-buffer-2 buffer (selected-window)))
2063 ((let ((frames (or frame
2064 (and (or use-pop-up-frames
2065 display-buffer-reuse-frames
2066 (not (last-nonminibuffer-frame)))
2067 0)
2068 (last-nonminibuffer-frame))))
e331bbf3
MR
2069 (setq window-to-use
2070 (catch 'found
29c45500
MR
2071 ;; Search frames for a window displaying BUFFER. Return
2072 ;; the selected window only if we are allowed to do so.
2073 (dolist (window (get-buffer-window-list buffer 'nomini frames))
e331bbf3
MR
2074 (when (or can-use-selected-window
2075 (not (eq (selected-window) window)))
2076 (throw 'found window))))))
2077 ;; The buffer is already displayed in some window; use that.
3c448ab6
MR
2078 (window--display-buffer-1 window-to-use))
2079 ((and special-display-function
2080 ;; `special-display-p' returns either t or a list of frame
2081 ;; parameters to pass to `special-display-function'.
2082 (let ((pars (special-display-p name-of-buffer)))
2083 (when pars
2084 (funcall special-display-function
2085 buffer (if (listp pars) pars))))))
2086 ((or use-pop-up-frames (not frame-to-use))
2087 ;; We want or need a new frame.
d2c9fc42 2088 (let ((win (frame-selected-window (funcall pop-up-frame-function))))
04ae543a 2089 (window--display-buffer-2 buffer win display-buffer-mark-dedicated)))
3c448ab6
MR
2090 ((and pop-up-windows
2091 ;; Make a new window.
2092 (or (not (frame-parameter frame-to-use 'unsplittable))
2093 ;; If the selected frame cannot be split look at
2094 ;; `last-nonminibuffer-frame'.
2095 (and (eq frame-to-use (selected-frame))
2096 (setq frame-to-use (last-nonminibuffer-frame))
2097 (window--frame-usable-p frame-to-use)
2098 (not (frame-parameter frame-to-use 'unsplittable))))
2099 ;; Attempt to split largest or least recently used window.
2100 (setq window-to-use
2101 (or (window--try-to-split-window
2102 (get-largest-window frame-to-use t))
2103 (window--try-to-split-window
d2c9fc42 2104 (get-lru-window frame-to-use t)))))
04ae543a
SM
2105 (window--display-buffer-2 buffer window-to-use
2106 display-buffer-mark-dedicated))
a9d451f0
MR
2107 ((let ((window-to-undedicate
2108 ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate
2109 ;; the selected window to its buffer, to avoid that some of
2110 ;; the `get-' routines below choose it. (Bug#1415)
2111 (and not-this-window (not (window-dedicated-p))
2112 (set-window-dedicated-p (selected-window) t)
2113 (selected-window))))
2114 (unwind-protect
2115 (setq window-to-use
2116 ;; Reuse an existing window.
2117 (or (get-lru-window frame-to-use)
2118 (let ((window (get-buffer-window buffer 'visible)))
2119 (unless (and not-this-window
2120 (eq window (selected-window)))
2121 window))
2122 (get-largest-window 'visible)
2123 (let ((window (get-buffer-window buffer 0)))
2124 (unless (and not-this-window
2125 (eq window (selected-window)))
2126 window))
2127 (get-largest-window 0)
2128 (frame-selected-window (funcall pop-up-frame-function))))
2129 (when (window-live-p window-to-undedicate)
2130 ;; Restore dedicated status of selected window.
2131 (set-window-dedicated-p window-to-undedicate nil))))
3c448ab6
MR
2132 (window--even-window-heights window-to-use)
2133 (window--display-buffer-2 buffer window-to-use)))))
2134
2135(defun pop-to-buffer (buffer-or-name &optional other-window norecord)
2136 "Select buffer BUFFER-OR-NAME in some window, preferably a different one.
2137BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
2138nil. If BUFFER-OR-NAME is a string not naming an existent
2139buffer, create a buffer with that name. If BUFFER-OR-NAME is
2140nil, choose some other buffer.
2141
2142If `pop-up-windows' is non-nil, windows can be split to display
2143the buffer. If optional second arg OTHER-WINDOW is non-nil,
2144insist on finding another window even if the specified buffer is
2145already visible in the selected window, and ignore
2146`same-window-regexps' and `same-window-buffer-names'.
2147
2148If the window to show BUFFER-OR-NAME is not on the selected
2149frame, raise that window's frame and give it input focus.
2150
2151This function returns the buffer it switched to. This uses the
2152function `display-buffer' as a subroutine; see the documentation
2153of `display-buffer' for additional customization information.
2154
2155Optional third arg NORECORD non-nil means do not put this buffer
2156at the front of the list of recently selected ones."
2157 (let ((buffer
2158 ;; FIXME: This behavior is carried over from the previous C version
2159 ;; of pop-to-buffer, but really we should use just
2160 ;; `get-buffer' here.
2161 (if (null buffer-or-name) (other-buffer (current-buffer))
2162 (or (get-buffer buffer-or-name)
2163 (let ((buf (get-buffer-create buffer-or-name)))
2164 (set-buffer-major-mode buf)
2165 buf))))
3c448ab6
MR
2166 (old-frame (selected-frame))
2167 new-window new-frame)
2168 (set-buffer buffer)
2169 (setq new-window (display-buffer buffer other-window))
13b5221f
MR
2170 (select-window new-window norecord)
2171 (setq new-frame (window-frame new-window))
2172 (unless (eq new-frame old-frame)
2173 ;; `display-buffer' has chosen another frame, make sure it gets
2174 ;; input focus and is risen.
2175 (select-frame-set-input-focus new-frame))
3c448ab6
MR
2176 buffer))
2177
2178;; I think this should be the default; I think people will prefer it--rms.
2179(defcustom split-window-keep-point t
2180 "If non-nil, \\[split-window-vertically] keeps the original point \
2181in both children.
2182This is often more convenient for editing.
2183If nil, adjust point in each of the two windows to minimize redisplay.
2184This is convenient on slow terminals, but point can move strangely.
2185
2186This option applies only to `split-window-vertically' and
2187functions that call it. `split-window' always keeps the original
2188point in both children."
2189 :type 'boolean
2190 :group 'windows)
2191
2192(defun split-window-vertically (&optional size)
2193 "Split selected window into two windows, one above the other.
2194The upper window gets SIZE lines and the lower one gets the rest.
2195SIZE negative means the lower window gets -SIZE lines and the
2196upper one the rest. With no argument, split windows equally or
2197close to it. Both windows display the same buffer, now current.
2198
2199If the variable `split-window-keep-point' is non-nil, both new
2200windows will get the same value of point as the selected window.
2201This is often more convenient for editing. The upper window is
2202the selected window.
2203
2204Otherwise, we choose window starts so as to minimize the amount of
2205redisplay; this is convenient on slow terminals. The new selected
2206window is the one that the current value of point appears in. The
2207value of point can change if the text around point is hidden by the
2208new mode line.
2209
2210Regardless of the value of `split-window-keep-point', the upper
2211window is the original one and the return value is the new, lower
2212window."
2213 (interactive "P")
2214 (let ((old-window (selected-window))
2215 (old-point (point))
2216 (size (and size (prefix-numeric-value size)))
2217 moved-by-window-height moved new-window bottom)
2218 (and size (< size 0)
2219 ;; Handle negative SIZE value.
2220 (setq size (+ (window-height) size)))
2221 (setq new-window (split-window nil size))
2222 (unless split-window-keep-point
7fdbcd83 2223 (with-current-buffer (window-buffer)
3c448ab6
MR
2224 (goto-char (window-start))
2225 (setq moved (vertical-motion (window-height)))
2226 (set-window-start new-window (point))
2227 (when (> (point) (window-point new-window))
2228 (set-window-point new-window (point)))
2229 (when (= moved (window-height))
2230 (setq moved-by-window-height t)
2231 (vertical-motion -1))
2232 (setq bottom (point)))
2233 (and moved-by-window-height
2234 (<= bottom (point))
2235 (set-window-point old-window (1- bottom)))
2236 (and moved-by-window-height
2237 (<= (window-start new-window) old-point)
2238 (set-window-point new-window old-point)
2239 (select-window new-window)))
2240 (split-window-save-restore-data new-window old-window)))
2241
2242;; This is to avoid compiler warnings.
2243(defvar view-return-to-alist)
2244
2245(defun split-window-save-restore-data (new-window old-window)
2246 (with-current-buffer (window-buffer)
2247 (when view-mode
2248 (let ((old-info (assq old-window view-return-to-alist)))
2249 (when old-info
2250 (push (cons new-window (cons (car (cdr old-info)) t))
2251 view-return-to-alist))))
2252 new-window))
2253
2254(defun split-window-horizontally (&optional size)
2255 "Split selected window into two windows side by side.
2256The selected window becomes the left one and gets SIZE columns.
2257SIZE negative means the right window gets -SIZE lines.
2258
2259SIZE includes the width of the window's scroll bar; if there are
2260no scroll bars, it includes the width of the divider column to
2261the window's right, if any. SIZE omitted or nil means split
2262window equally.
2263
2264The selected window remains selected. Return the new window."
2265 (interactive "P")
2266 (let ((old-window (selected-window))
2267 (size (and size (prefix-numeric-value size))))
2268 (and size (< size 0)
2269 ;; Handle negative SIZE value.
2270 (setq size (+ (window-width) size)))
2271 (split-window-save-restore-data (split-window nil size t) old-window)))
2272
2273\f
2274(defun set-window-text-height (window height)
9992ea0c 2275 "Set the height in lines of the text display area of WINDOW to HEIGHT.
3c448ab6
MR
2276HEIGHT doesn't include the mode line or header line, if any, or
2277any partial-height lines in the text display area.
2278
2279Note that the current implementation of this function cannot
2280always set the height exactly, but attempts to be conservative,
2281by allocating more lines than are actually needed in the case
2282where some error may be present."
2283 (let ((delta (- height (window-text-height window))))
2284 (unless (zerop delta)
2285 ;; Setting window-min-height to a value like 1 can lead to very
2286 ;; bizarre displays because it also allows Emacs to make *other*
2287 ;; windows 1-line tall, which means that there's no more space for
2288 ;; the modeline.
2289 (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
2290 (if (and window (not (eq window (selected-window))))
2291 (save-selected-window
2292 (select-window window 'norecord)
2293 (enlarge-window delta))
2294 (enlarge-window delta))))))
2295
2296\f
2297(defun enlarge-window-horizontally (columns)
2298 "Make selected window COLUMNS wider.
2299Interactively, if no argument is given, make selected window one
2300column wider."
2301 (interactive "p")
2302 (enlarge-window columns t))
2303
2304(defun shrink-window-horizontally (columns)
2305 "Make selected window COLUMNS narrower.
2306Interactively, if no argument is given, make selected window one
2307column narrower."
2308 (interactive "p")
2309 (shrink-window columns t))
2310
2311(defun window-buffer-height (window)
2312 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
2313 (with-current-buffer (window-buffer window)
2314 (max 1
2315 (count-screen-lines (point-min) (point-max)
2316 ;; If buffer ends with a newline, ignore it when
2317 ;; counting height unless point is after it.
2318 (eobp)
2319 window))))
2320
2321(defun count-screen-lines (&optional beg end count-final-newline window)
2322 "Return the number of screen lines in the region.
2323The number of screen lines may be different from the number of actual lines,
2324due to line breaking, display table, etc.
2325
2326Optional arguments BEG and END default to `point-min' and `point-max'
2327respectively.
2328
2329If region ends with a newline, ignore it unless optional third argument
2330COUNT-FINAL-NEWLINE is non-nil.
2331
2332The optional fourth argument WINDOW specifies the window used for obtaining
2333parameters such as width, horizontal scrolling, and so on. The default is
2334to use the selected window's parameters.
2335
2336Like `vertical-motion', `count-screen-lines' always uses the current buffer,
2337regardless of which buffer is displayed in WINDOW. This makes possible to use
2338`count-screen-lines' in any buffer, whether or not it is currently displayed
2339in some window."
2340 (unless beg
2341 (setq beg (point-min)))
2342 (unless end
2343 (setq end (point-max)))
2344 (if (= beg end)
2345 0
2346 (save-excursion
2347 (save-restriction
2348 (widen)
2349 (narrow-to-region (min beg end)
2350 (if (and (not count-final-newline)
2351 (= ?\n (char-before (max beg end))))
2352 (1- (max beg end))
2353 (max beg end)))
2354 (goto-char (point-min))
2355 (1+ (vertical-motion (buffer-size) window))))))
2356
2357(defun fit-window-to-buffer (&optional window max-height min-height)
2358 "Adjust height of WINDOW to display its buffer's contents exactly.
9adf1f06 2359WINDOW defaults to the selected window.
3c448ab6 2360Optional argument MAX-HEIGHT specifies the maximum height of the
f7baca20
MR
2361window and defaults to the maximum permissible height of a window
2362on WINDOW's frame.
3c448ab6
MR
2363Optional argument MIN-HEIGHT specifies the minimum height of the
2364window and defaults to `window-min-height'.
2365Both, MAX-HEIGHT and MIN-HEIGHT are specified in lines and
2366include the mode line and header line, if any.
3c448ab6 2367
9adf1f06
MR
2368Return non-nil if height was orderly adjusted, nil otherwise.
2369
f7baca20
MR
2370Caution: This function can delete WINDOW and/or other windows
2371when their height shrinks to less than MIN-HEIGHT."
2372 (interactive)
2373 ;; Do all the work in WINDOW and its buffer and restore the selected
2374 ;; window and the current buffer when we're done.
9adf1f06
MR
2375 (let ((old-buffer (current-buffer))
2376 value)
f7baca20
MR
2377 (with-selected-window (or window (setq window (selected-window)))
2378 (set-buffer (window-buffer))
2379 ;; Use `condition-case' to handle any fixed-size windows and other
2380 ;; pitfalls nearby.
2381 (condition-case nil
2382 (let* (;; MIN-HEIGHT must not be less than 1 and defaults to
2383 ;; `window-min-height'.
2384 (min-height (max (or min-height window-min-height) 1))
2385 (max-window-height
2386 ;; Maximum height of any window on this frame.
2387 (min (window-height (frame-root-window)) (frame-height)))
2388 ;; MAX-HEIGHT must not be larger than max-window-height and
2389 ;; defaults to max-window-height.
2390 (max-height
2391 (min (or max-height max-window-height) max-window-height))
2392 (desired-height
2393 ;; The height necessary to show all of WINDOW's buffer,
2394 ;; constrained by MIN-HEIGHT and MAX-HEIGHT.
2395 (max
2396 (min
2397 ;; For an empty buffer `count-screen-lines' returns zero.
2398 ;; Even in that case we need one line for the cursor.
2399 (+ (max (count-screen-lines) 1)
2400 ;; For non-minibuffers count the mode line, if any.
2401 (if (and (not (window-minibuffer-p)) mode-line-format)
2402 1 0)
2403 ;; Count the header line, if any.
2404 (if header-line-format 1 0))
2405 max-height)
2406 min-height))
2407 (delta
2408 ;; How much the window height has to change.
2409 (if (= (window-height) (window-height (frame-root-window)))
2410 ;; Don't try to resize a full-height window.
2411 0
2412 (- desired-height (window-height))))
2413 ;; Do something reasonable so `enlarge-window' can make
2414 ;; windows as small as MIN-HEIGHT.
2415 (window-min-height (min min-height window-min-height)))
2416 ;; Don't try to redisplay with the cursor at the end on its
2417 ;; own line--that would force a scroll and spoil things.
2418 (when (and (eobp) (bolp) (not (bobp)))
2419 (set-window-point window (1- (window-point))))
2420 ;; Adjust WINDOW's height to the nominally correct one
2421 ;; (which may actually be slightly off because of variable
2422 ;; height text, etc).
2423 (unless (zerop delta)
2424 (enlarge-window delta))
2425 ;; `enlarge-window' might have deleted WINDOW, so make sure
2426 ;; WINDOW's still alive for the remainder of this.
2427 ;; Note: Deleting WINDOW is clearly counter-intuitive in
2428 ;; this context, but we can't do much about it given the
2429 ;; current semantics of `enlarge-window'.
2430 (when (window-live-p window)
2431 ;; Check if the last line is surely fully visible. If
2432 ;; not, enlarge the window.
2433 (let ((end (save-excursion
2434 (goto-char (point-max))
2435 (when (and (bolp) (not (bobp)))
2436 ;; Don't include final newline.
2437 (backward-char 1))
2438 (when truncate-lines
2439 ;; If line-wrapping is turned off, test the
2440 ;; beginning of the last line for
2441 ;; visibility instead of the end, as the
2442 ;; end of the line could be invisible by
2443 ;; virtue of extending past the edge of the
2444 ;; window.
2445 (forward-line 0))
2446 (point))))
2447 (set-window-vscroll window 0)
2448 (while (and (< desired-height max-height)
2449 (= desired-height (window-height))
2450 (not (pos-visible-in-window-p end)))
2451 (enlarge-window 1)
9adf1f06
MR
2452 (setq desired-height (1+ desired-height))))
2453 ;; Return non-nil only if nothing "bad" happened.
2454 (setq value t)))
f7baca20
MR
2455 (error nil)))
2456 (when (buffer-live-p old-buffer)
9adf1f06
MR
2457 (set-buffer old-buffer))
2458 value))
3c448ab6
MR
2459
2460(defun window-safely-shrinkable-p (&optional window)
2461 "Return t if WINDOW can be shrunk without shrinking other windows.
2462WINDOW defaults to the selected window."
2463 (with-selected-window (or window (selected-window))
2464 (let ((edges (window-edges)))
2465 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
2466 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
2467
2468(defun shrink-window-if-larger-than-buffer (&optional window)
2469 "Shrink height of WINDOW if its buffer doesn't need so many lines.
2470More precisely, shrink WINDOW vertically to be as small as
2471possible, while still showing the full contents of its buffer.
2472WINDOW defaults to the selected window.
2473
2474Do not shrink to less than `window-min-height' lines. Do nothing
2475if the buffer contains more lines than the present window height,
2476or if some of the window's contents are scrolled out of view, or
2477if shrinking this window would also shrink another window, or if
2478the window is the only window of its frame.
2479
2480Return non-nil if the window was shrunk, nil otherwise."
2481 (interactive)
2482 (when (null window)
2483 (setq window (selected-window)))
2484 (let* ((frame (window-frame window))
2485 (mini (frame-parameter frame 'minibuffer))
2486 (edges (window-edges window)))
2487 (if (and (not (eq window (frame-root-window frame)))
2488 (window-safely-shrinkable-p window)
2489 (pos-visible-in-window-p (point-min) window)
2490 (not (eq mini 'only))
2491 (or (not mini)
2492 (let ((mini-window (minibuffer-window frame)))
2493 (or (null mini-window)
2494 (not (eq frame (window-frame mini-window)))
2495 (< (nth 3 edges)
2496 (nth 1 (window-edges mini-window)))
2497 (> (nth 1 edges)
2498 (frame-parameter frame 'menu-bar-lines))))))
2499 (fit-window-to-buffer window (window-height window)))))
2500
2501(defun kill-buffer-and-window ()
2502 "Kill the current buffer and delete the selected window."
2503 (interactive)
2504 (let ((window-to-delete (selected-window))
2505 (buffer-to-kill (current-buffer))
2506 (delete-window-hook (lambda ()
2507 (condition-case nil
2508 (delete-window)
2509 (error nil)))))
2510 (unwind-protect
2511 (progn
2512 (add-hook 'kill-buffer-hook delete-window-hook t t)
2513 (if (kill-buffer (current-buffer))
2514 ;; If `delete-window' failed before, we rerun it to regenerate
2515 ;; the error so it can be seen in the echo area.
2516 (when (eq (selected-window) window-to-delete)
2517 (delete-window))))
2518 ;; If the buffer is not dead for some reason (probably because
2519 ;; of a `quit' signal), remove the hook again.
2520 (condition-case nil
2521 (with-current-buffer buffer-to-kill
2522 (remove-hook 'kill-buffer-hook delete-window-hook t))
2523 (error nil)))))
2524
2525(defun quit-window (&optional kill window)
2526 "Quit WINDOW and bury its buffer.
2527With a prefix argument, kill the buffer instead. WINDOW defaults
2528to the selected window.
2529
2530If WINDOW is non-nil, dedicated, or a minibuffer window, delete
2531it and, if it's alone on its frame, its frame too. Otherwise, or
2532if deleting WINDOW fails in any of the preceding cases, display
2533another buffer in WINDOW using `switch-to-buffer'.
2534
2535Optional argument KILL non-nil means kill WINDOW's buffer.
2536Otherwise, bury WINDOW's buffer, see `bury-buffer'."
2537 (interactive "P")
2538 (let ((buffer (window-buffer window)))
2539 (if (or window
2540 (window-minibuffer-p window)
2541 (window-dedicated-p window))
2542 ;; WINDOW is either non-nil, a minibuffer window, or dedicated;
2543 ;; try to delete it.
a0c859f0
MR
2544 (let* ((window (or window (selected-window)))
2545 (frame (window-frame window)))
3c448ab6
MR
2546 (if (eq window (frame-root-window frame))
2547 ;; WINDOW is alone on its frame. `delete-windows-on'
2548 ;; knows how to handle that case.
2549 (delete-windows-on buffer frame)
2550 ;; There are other windows on its frame, delete WINDOW.
2551 (delete-window window)))
2552 ;; Otherwise, switch to another buffer in the selected window.
2553 (switch-to-buffer nil))
2554
2555 ;; Deal with the buffer.
2556 (if kill
2557 (kill-buffer buffer)
2558 (bury-buffer buffer))))
2559
74f806a1 2560\f
3c448ab6
MR
2561(defvar recenter-last-op nil
2562 "Indicates the last recenter operation performed.
0116abbd
JL
2563Possible values: `top', `middle', `bottom', integer or float numbers.")
2564
2565(defcustom recenter-positions '(middle top bottom)
2566 "Cycling order for `recenter-top-bottom'.
2567A list of elements with possible values `top', `middle', `bottom',
2568integer or float numbers that define the cycling order for
2569the command `recenter-top-bottom'.
2570
2571Top and bottom destinations are `scroll-margin' lines the from true
2572window top and bottom. Middle redraws the frame and centers point
2573vertically within the window. Integer number moves current line to
2574the specified absolute window-line. Float number between 0.0 and 1.0
2575means the percentage of the screen space from the top. The default
2576cycling order is middle -> top -> bottom."
2577 :type '(repeat (choice
2578 (const :tag "Top" top)
2579 (const :tag "Middle" middle)
2580 (const :tag "Bottom" bottom)
2581 (integer :tag "Line number")
2582 (float :tag "Percentage")))
2583 :version "23.2"
2584 :group 'windows)
3c448ab6
MR
2585
2586(defun recenter-top-bottom (&optional arg)
0116abbd
JL
2587 "Move current buffer line to the specified window line.
2588With no prefix argument, successive calls place point according
2589to the cycling order defined by `recenter-positions'.
3c448ab6
MR
2590
2591A prefix argument is handled like `recenter':
2592 With numeric prefix ARG, move current line to window-line ARG.
0116abbd 2593 With plain `C-u', move current line to window center."
3c448ab6
MR
2594 (interactive "P")
2595 (cond
0116abbd 2596 (arg (recenter arg)) ; Always respect ARG.
3c448ab6 2597 (t
0116abbd
JL
2598 (setq recenter-last-op
2599 (if (eq this-command last-command)
2600 (car (or (cdr (member recenter-last-op recenter-positions))
2601 recenter-positions))
2602 (car recenter-positions)))
3c448ab6
MR
2603 (let ((this-scroll-margin
2604 (min (max 0 scroll-margin)
2605 (truncate (/ (window-body-height) 4.0)))))
2606 (cond ((eq recenter-last-op 'middle)
0116abbd 2607 (recenter))
3c448ab6 2608 ((eq recenter-last-op 'top)
0116abbd
JL
2609 (recenter this-scroll-margin))
2610 ((eq recenter-last-op 'bottom)
2611 (recenter (- -1 this-scroll-margin)))
2612 ((integerp recenter-last-op)
2613 (recenter recenter-last-op))
2614 ((floatp recenter-last-op)
2615 (recenter (round (* recenter-last-op (window-height))))))))))
3c448ab6
MR
2616
2617(define-key global-map [?\C-l] 'recenter-top-bottom)
216349f8 2618
216349f8
SM
2619(defun move-to-window-line-top-bottom (&optional arg)
2620 "Position point relative to window.
2621
0f202d5d 2622With a prefix argument ARG, acts like `move-to-window-line'.
216349f8
SM
2623
2624With no argument, positions point at center of window.
0116abbd
JL
2625Successive calls position point at positions defined
2626by `recenter-positions'."
216349f8
SM
2627 (interactive "P")
2628 (cond
0116abbd 2629 (arg (move-to-window-line arg)) ; Always respect ARG.
216349f8 2630 (t
0116abbd
JL
2631 (setq recenter-last-op
2632 (if (eq this-command last-command)
2633 (car (or (cdr (member recenter-last-op recenter-positions))
2634 recenter-positions))
2635 (car recenter-positions)))
216349f8
SM
2636 (let ((this-scroll-margin
2637 (min (max 0 scroll-margin)
2638 (truncate (/ (window-body-height) 4.0)))))
0f202d5d 2639 (cond ((eq recenter-last-op 'middle)
0116abbd 2640 (call-interactively 'move-to-window-line))
0f202d5d 2641 ((eq recenter-last-op 'top)
0116abbd
JL
2642 (move-to-window-line this-scroll-margin))
2643 ((eq recenter-last-op 'bottom)
2644 (move-to-window-line (- -1 this-scroll-margin)))
2645 ((integerp recenter-last-op)
2646 (move-to-window-line recenter-last-op))
2647 ((floatp recenter-last-op)
2648 (move-to-window-line (round (* recenter-last-op (window-height))))))))))
216349f8
SM
2649
2650(define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
2651
3c448ab6 2652\f
74f806a1
JL
2653;;; Scrolling commands.
2654
2655;;; Scrolling commands which does not signal errors at top/bottom
2656;;; of buffer at first key-press (instead moves to top/bottom
2657;;; of buffer).
2658
2659(defcustom scroll-error-top-bottom nil
2660 "Move point to top/bottom of buffer before signalling a scrolling error.
2661A value of nil means just signal an error if no more scrolling possible.
2662A value of t means point moves to the beginning or the end of the buffer
2663\(depending on scrolling direction) when no more scrolling possible.
2664When point is already on that position, then signal an error."
2665 :type 'boolean
2666 :group 'scrolling
2667 :version "24.1")
2668
2669(defun scroll-up-command (&optional arg)
2670 "Scroll text of selected window upward ARG lines; or near full screen if no ARG.
2671If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
2672scroll window further, move cursor to the bottom line.
2673When point is already on that position, then signal an error.
2674A near full screen is `next-screen-context-lines' less than a full screen.
2675Negative ARG means scroll downward.
2676If ARG is the atom `-', scroll downward by nearly full screen."
2677 (interactive "^P")
2678 (cond
2679 ((null scroll-error-top-bottom)
2680 (scroll-up arg))
2681 ((eq arg '-)
2682 (scroll-down-command nil))
2683 ((< (prefix-numeric-value arg) 0)
2684 (scroll-down-command (- (prefix-numeric-value arg))))
2685 ((eobp)
2686 (scroll-up arg)) ; signal error
2687 (t
2688 (condition-case nil
2689 (scroll-up arg)
2690 (end-of-buffer
2691 (if arg
2692 ;; When scrolling by ARG lines can't be done,
2693 ;; move by ARG lines instead.
2694 (forward-line arg)
2695 ;; When ARG is nil for full-screen scrolling,
2696 ;; move to the bottom of the buffer.
2697 (goto-char (point-max))))))))
2698
2699(put 'scroll-up-command 'scroll-command t)
2700
2701(defun scroll-down-command (&optional arg)
2702 "Scroll text of selected window down ARG lines; or near full screen if no ARG.
2703If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
2704scroll window further, move cursor to the top line.
2705When point is already on that position, then signal an error.
2706A near full screen is `next-screen-context-lines' less than a full screen.
2707Negative ARG means scroll upward.
2708If ARG is the atom `-', scroll upward by nearly full screen."
2709 (interactive "^P")
2710 (cond
2711 ((null scroll-error-top-bottom)
2712 (scroll-down arg))
2713 ((eq arg '-)
2714 (scroll-up-command nil))
2715 ((< (prefix-numeric-value arg) 0)
2716 (scroll-up-command (- (prefix-numeric-value arg))))
2717 ((bobp)
2718 (scroll-down arg)) ; signal error
2719 (t
2720 (condition-case nil
2721 (scroll-down arg)
2722 (beginning-of-buffer
2723 (if arg
2724 ;; When scrolling by ARG lines can't be done,
2725 ;; move by ARG lines instead.
2726 (forward-line (- arg))
2727 ;; When ARG is nil for full-screen scrolling,
2728 ;; move to the top of the buffer.
2729 (goto-char (point-min))))))))
2730
2731(put 'scroll-down-command 'scroll-command t)
2732
2733;;; Scrolling commands which scroll a line instead of full screen.
2734
2735(defun scroll-up-line (&optional arg)
2736 "Scroll text of selected window upward ARG lines; or one line if no ARG.
2737If ARG is omitted or nil, scroll upward by one line.
2738This is different from `scroll-up-command' that scrolls a full screen."
2739 (interactive "p")
2740 (scroll-up (or arg 1)))
2741
2742(put 'scroll-up-line 'scroll-command t)
2743
2744(defun scroll-down-line (&optional arg)
2745 "Scroll text of selected window down ARG lines; or one line if no ARG.
2746If ARG is omitted or nil, scroll down by one line.
2747This is different from `scroll-down-command' that scrolls a full screen."
2748 (interactive "p")
2749 (scroll-down (or arg 1)))
2750
2751(put 'scroll-down-line 'scroll-command t)
2752
2753\f
2754(defun scroll-other-window-down (lines)
2755 "Scroll the \"other window\" down.
2756For more details, see the documentation for `scroll-other-window'."
2757 (interactive "P")
2758 (scroll-other-window
2759 ;; Just invert the argument's meaning.
2760 ;; We can do that without knowing which window it will be.
2761 (if (eq lines '-) nil
2762 (if (null lines) '-
2763 (- (prefix-numeric-value lines))))))
2764
2765(defun beginning-of-buffer-other-window (arg)
2766 "Move point to the beginning of the buffer in the other window.
2767Leave mark at previous position.
2768With arg N, put point N/10 of the way from the true beginning."
2769 (interactive "P")
2770 (let ((orig-window (selected-window))
2771 (window (other-window-for-scrolling)))
2772 ;; We use unwind-protect rather than save-window-excursion
2773 ;; because the latter would preserve the things we want to change.
2774 (unwind-protect
2775 (progn
2776 (select-window window)
2777 ;; Set point and mark in that window's buffer.
2778 (with-no-warnings
2779 (beginning-of-buffer arg))
2780 ;; Set point accordingly.
2781 (recenter '(t)))
2782 (select-window orig-window))))
2783
2784(defun end-of-buffer-other-window (arg)
2785 "Move point to the end of the buffer in the other window.
2786Leave mark at previous position.
2787With arg N, put point N/10 of the way from the true end."
2788 (interactive "P")
2789 ;; See beginning-of-buffer-other-window for comments.
2790 (let ((orig-window (selected-window))
2791 (window (other-window-for-scrolling)))
2792 (unwind-protect
2793 (progn
2794 (select-window window)
2795 (with-no-warnings
2796 (end-of-buffer arg))
2797 (recenter '(t)))
2798 (select-window orig-window))))
2799
2800\f
3c448ab6
MR
2801(defvar mouse-autoselect-window-timer nil
2802 "Timer used by delayed window autoselection.")
2803
2804(defvar mouse-autoselect-window-position nil
2805 "Last mouse position recorded by delayed window autoselection.")
2806
2807(defvar mouse-autoselect-window-window nil
2808 "Last window recorded by delayed window autoselection.")
2809
2810(defvar mouse-autoselect-window-state nil
2811 "When non-nil, special state of delayed window autoselection.
2812Possible values are `suspend' \(suspend autoselection after a menu or
2813scrollbar interaction\) and `select' \(the next invocation of
2814'handle-select-window' shall select the window immediately\).")
2815
2816(defun mouse-autoselect-window-cancel (&optional force)
2817 "Cancel delayed window autoselection.
2818Optional argument FORCE means cancel unconditionally."
2819 (unless (and (not force)
2820 ;; Don't cancel for select-window or select-frame events
2821 ;; or when the user drags a scroll bar.
2822 (or (memq this-command
2823 '(handle-select-window handle-switch-frame))
2824 (and (eq this-command 'scroll-bar-toolkit-scroll)
2825 (memq (nth 4 (event-end last-input-event))
2826 '(handle end-scroll)))))
2827 (setq mouse-autoselect-window-state nil)
2828 (when (timerp mouse-autoselect-window-timer)
2829 (cancel-timer mouse-autoselect-window-timer))
2830 (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
2831
2832(defun mouse-autoselect-window-start (mouse-position &optional window suspend)
2833 "Start delayed window autoselection.
2834MOUSE-POSITION is the last position where the mouse was seen as returned
2835by `mouse-position'. Optional argument WINDOW non-nil denotes the
2836window where the mouse was seen. Optional argument SUSPEND non-nil
2837means suspend autoselection."
2838 ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
2839 (setq mouse-autoselect-window-position mouse-position)
2840 (when window (setq mouse-autoselect-window-window window))
2841 (setq mouse-autoselect-window-state (when suspend 'suspend))
2842 ;; Install timer which runs `mouse-autoselect-window-select' after
2843 ;; `mouse-autoselect-window' seconds.
2844 (setq mouse-autoselect-window-timer
2845 (run-at-time
2846 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
2847
2848(defun mouse-autoselect-window-select ()
2849 "Select window with delayed window autoselection.
2850If the mouse position has stabilized in a non-selected window, select
2851that window. The minibuffer window is selected only if the minibuffer is
2852active. This function is run by `mouse-autoselect-window-timer'."
2853 (condition-case nil
2854 (let* ((mouse-position (mouse-position))
2855 (window
2856 (condition-case nil
2857 (window-at (cadr mouse-position) (cddr mouse-position)
2858 (car mouse-position))
2859 (error nil))))
2860 (cond
2861 ((or (menu-or-popup-active-p)
2862 (and window
2863 (not (coordinates-in-window-p (cdr mouse-position) window))))
2864 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
2865 ;; of WINDOW, temporarily suspend delayed autoselection.
2866 (mouse-autoselect-window-start mouse-position nil t))
2867 ((eq mouse-autoselect-window-state 'suspend)
2868 ;; Delayed autoselection was temporarily suspended, reenable it.
2869 (mouse-autoselect-window-start mouse-position))
2870 ((and window (not (eq window (selected-window)))
2871 (or (not (numberp mouse-autoselect-window))
2872 (and (> mouse-autoselect-window 0)
2873 ;; If `mouse-autoselect-window' is positive, select
2874 ;; window if the window is the same as before.
2875 (eq window mouse-autoselect-window-window))
2876 ;; Otherwise select window if the mouse is at the same
2877 ;; position as before. Observe that the first test after
2878 ;; starting autoselection usually fails since the value of
2879 ;; `mouse-autoselect-window-position' recorded there is the
2880 ;; position where the mouse has entered the new window and
2881 ;; not necessarily where the mouse has stopped moving.
2882 (equal mouse-position mouse-autoselect-window-position))
2883 ;; The minibuffer is a candidate window if it's active.
2884 (or (not (window-minibuffer-p window))
2885 (eq window (active-minibuffer-window))))
2886 ;; Mouse position has stabilized in non-selected window: Cancel
2887 ;; delayed autoselection and try to select that window.
2888 (mouse-autoselect-window-cancel t)
2889 ;; Select window where mouse appears unless the selected window is the
2890 ;; minibuffer. Use `unread-command-events' in order to execute pre-
2891 ;; and post-command hooks and trigger idle timers. To avoid delaying
2892 ;; autoselection again, set `mouse-autoselect-window-state'."
2893 (unless (window-minibuffer-p (selected-window))
2894 (setq mouse-autoselect-window-state 'select)
2895 (setq unread-command-events
2896 (cons (list 'select-window (list window))
2897 unread-command-events))))
2898 ((or (and window (eq window (selected-window)))
2899 (not (numberp mouse-autoselect-window))
2900 (equal mouse-position mouse-autoselect-window-position))
2901 ;; Mouse position has either stabilized in the selected window or at
2902 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
2903 (mouse-autoselect-window-cancel t))
2904 (t
2905 ;; Mouse position has not stabilized yet, resume delayed
2906 ;; autoselection.
2907 (mouse-autoselect-window-start mouse-position window))))
2908 (error nil)))
2909
2910(defun handle-select-window (event)
2911 "Handle select-window events."
2912 (interactive "e")
2913 (let ((window (posn-window (event-start event))))
2914 (unless (or (not (window-live-p window))
2915 ;; Don't switch if we're currently in the minibuffer.
2916 ;; This tries to work around problems where the
2917 ;; minibuffer gets unselected unexpectedly, and where
2918 ;; you then have to move your mouse all the way down to
2919 ;; the minibuffer to select it.
2920 (window-minibuffer-p (selected-window))
2921 ;; Don't switch to minibuffer window unless it's active.
2922 (and (window-minibuffer-p window)
2923 (not (minibuffer-window-active-p window)))
2924 ;; Don't switch when autoselection shall be delayed.
2925 (and (numberp mouse-autoselect-window)
2926 (not (zerop mouse-autoselect-window))
2927 (not (eq mouse-autoselect-window-state 'select))
2928 (progn
2929 ;; Cancel any delayed autoselection.
2930 (mouse-autoselect-window-cancel t)
2931 ;; Start delayed autoselection from current mouse
2932 ;; position and window.
2933 (mouse-autoselect-window-start (mouse-position) window)
2934 ;; Executing a command cancels delayed autoselection.
2935 (add-hook
2936 'pre-command-hook 'mouse-autoselect-window-cancel))))
2937 (when mouse-autoselect-window
2938 ;; Reset state of delayed autoselection.
2939 (setq mouse-autoselect-window-state nil)
2940 ;; Run `mouse-leave-buffer-hook' when autoselecting window.
2941 (run-hooks 'mouse-leave-buffer-hook))
2942 (select-window window))))
2943
2944(defun delete-other-windows-vertically (&optional window)
2945 "Delete the windows in the same column with WINDOW, but not WINDOW itself.
2946This may be a useful alternative binding for \\[delete-other-windows]
2947 if you often split windows horizontally."
2948 (interactive)
2949 (let* ((window (or window (selected-window)))
2950 (edges (window-edges window))
2951 (w window) delenda)
2952 (while (not (eq (setq w (next-window w 1)) window))
2953 (let ((e (window-edges w)))
2954 (when (and (= (car e) (car edges))
2955 (= (caddr e) (caddr edges)))
2956 (push w delenda))))
2957 (mapc 'delete-window delenda)))
2958
2959(defun truncated-partial-width-window-p (&optional window)
2960 "Return non-nil if lines in WINDOW are specifically truncated due to its width.
2961WINDOW defaults to the selected window.
2962Return nil if WINDOW is not a partial-width window
2963 (regardless of the value of `truncate-lines').
2964Otherwise, consult the value of `truncate-partial-width-windows'
2965 for the buffer shown in WINDOW."
2966 (unless window
2967 (setq window (selected-window)))
2968 (unless (window-full-width-p window)
2969 (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
2970 (window-buffer window))))
2971 (if (integerp t-p-w-w)
2972 (< (window-width window) t-p-w-w)
2973 t-p-w-w))))
2974
2975(define-key ctl-x-map "2" 'split-window-vertically)
2976(define-key ctl-x-map "3" 'split-window-horizontally)
2977(define-key ctl-x-map "}" 'enlarge-window-horizontally)
2978(define-key ctl-x-map "{" 'shrink-window-horizontally)
2979(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
2980(define-key ctl-x-map "+" 'balance-windows)
2981(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
2982
3c448ab6 2983;;; window.el ends here