Merge from trunk.
[bpt/emacs.git] / lisp / window.el
1 ;;; window.el --- GNU Emacs window commands aside from those written in C
2
3 ;; Copyright (C) 1985, 1989, 1992-1994, 2000-2011
4 ;; Free Software Foundation, Inc.
5
6 ;; Maintainer: FSF
7 ;; Keywords: internal
8 ;; Package: emacs
9
10 ;; This file is part of GNU Emacs.
11
12 ;; GNU Emacs is free software: you can redistribute it and/or modify
13 ;; it under the terms of the GNU General Public License as published by
14 ;; the Free Software Foundation, either version 3 of the License, or
15 ;; (at your option) any later version.
16
17 ;; GNU Emacs is distributed in the hope that it will be useful,
18 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
19 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
20 ;; GNU General Public License for more details.
21
22 ;; You should have received a copy of the GNU General Public License
23 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
24
25 ;;; Commentary:
26
27 ;; Window tree functions.
28
29 ;;; Code:
30
31 (eval-when-compile (require 'cl))
32
33 (defmacro save-selected-window (&rest body)
34 "Execute BODY, then select the previously selected window.
35 The value returned is the value of the last form in BODY.
36
37 This macro saves and restores the selected window, as well as the
38 selected window in each frame. If the previously selected window
39 is no longer live, then whatever window is selected at the end of
40 BODY remains selected. If the previously selected window of some
41 frame is no longer live at the end of BODY, that frame's selected
42 window is left alone.
43
44 This macro saves and restores the current buffer, since otherwise
45 its normal operation could make a different buffer current. The
46 order of recently selected windows and the buffer list ordering
47 are not altered by this macro (unless they are altered in BODY)."
48 (declare (indent 0) (debug t))
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
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.
72 Return nil if WINDOW is the root window of its frame. WINDOW can
73 be any window."
74 (and window (window-parent window) (window-next window)))
75
76 (defsubst window-left (window)
77 "Return WINDOW's left sibling.
78 Return nil if WINDOW is the root window of its frame. WINDOW can
79 be 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.
111 BUFFER-OR-NAME must be either a buffer or a string naming a live
112 buffer 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.
126 FRAME 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.
135 WINDOW must be a window that has not been deleted and defaults to
136 the 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.
145 WINDOW 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.
154 The functions currently affected by this are `split-window',
155 `delete-window', `delete-other-windows' and `other-window'.
156
157 An application may bind this to a non-nil value around calls to
158 these functions to inhibit processing of window parameters.")
159
160 (defconst window-safe-min-height 1
161 "The absolut minimum number of lines of a window.
162 Anything less might crash Emacs.")
163
164 (defconst window-safe-min-width 2
165 "The absolut minimum number of columns of a window.
166 Anything less might crash Emacs.")
167
168 (defun window-iso-combination-p (&optional window horizontal)
169 "If WINDOW is a vertical combination return WINDOW's first child.
170 WINDOW can be any window and defaults to the selected one.
171 Optional argument HORIZONTAL non-nil means return WINDOW's first
172 child 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.
180 WINDOW can be any window and defaults to the selected one.
181 Optional argument HORIZONTAL non-nil means return non-nil if and
182 only 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.
189 WINDOW can be any window and defaults to the selected one.
190 Optional argument HORIZONTAL non-nil means to return the largest
191 number 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.
240 PROC must be a function with one argument - a window. FRAME must
241 be a live frame and defaults to the selected one. ANY, if
242 non-nil means to run PROC on all live and internal windows of
243 FRAME.
244
245 This function performs a pre-order, depth-first traversal of the
246 window tree. If PROC changes the window tree, the result is
247 unpredictable."
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.
254 WINDOW defaults to the selected window. PROC must be a function
255 with one argument - a window. ANY, if non-nil means to run PROC
256 on all live and internal subwindows of WINDOW.
257
258 This function performs a pre-order, depth-first traversal of the
259 window tree rooted at WINDOW. If PROC changes that window tree,
260 the 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.
266 FRAME defaults to the selected frame. Optional argument VALUE
267 non-nil means only return windows whose window-parameter value of
268 PARAMETER equals VALUE \(comparison is done using `equal').
269 Optional argument ANY non-nil means consider internal windows
270 too. Optional argument VALUES non-nil means return a list of cons
271 cells whose car is the value of the parameter and whose cdr is
272 the 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.
288 FRAME defaults to the selected frame. Optional argument VALUE
289 non-nil means only return a window whose window-parameter value
290 for PARAMETER equals VALUE \(comparison is done with `equal').
291 Optional argument ANY non-nil means consider internal windows
292 too."
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.
305 WINDOW can be any window and defaults to the selected one.
306 Return 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.
316 WINDOW 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.
354 FRAME defaults to the selected frame. If an atomic window is
355 wrongly configured, reset the atomicity of all its subwindows to
356 nil. An atomic window is wrongly configured if it has no
357 subwindows 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.
366 Otherwise, 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.
373 The value is a list of four elements specifying the number of
374 side window slots on \(in this order) the left, top, right and
375 bottom side of each frame. If an element is a number, this means
376 to display at most that many side windows on the corresponding
377 side. If an element is nil, this means there's no bound on the
378 number 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.
415 FRAME defaults to the selected frame. If the configuration is
416 invalid, reset all window-side parameters to nil.
417
418 A 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.
486 FRAME 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.
493 If the value is `height', then only the window's height is fixed.
494 If the value is `width', then only the window's width is fixed.
495 Any other non-nil value fixes both the width and the height.
496
497 Emacs won't change the size of any window displaying that buffer,
498 unless it has no other choice \(like when deleting a neighboring
499 window).")
500 (make-variable-buffer-local 'window-size-fixed)
501
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.
508 WINDOW can be an arbitrary window and defaults to the selected
509 one. Optional argument HORIZONTAL non-nil means return the
510 minimum number of columns of WINDOW.
511
512 Optional argument IGNORE non-nil means ignore any restrictions
513 imposed by fixed size windows, `window-min-height' or
514 `window-min-width' settings. IGNORE equal `safe' means live
515 windows may get as small as `window-safe-min-height' lines and
516 `window-safe-min-width' columns. IGNORE a window means ignore
517 restrictions 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.
589 Optional argument HORIZONTAL non-nil means return DELTA if DELTA
590 columns can be added to WINDOW. A return value of zero means
591 that no lines (or columns) can be added to WINDOW.
592
593 This function looks only at WINDOW and its subwindows. The
594 function `window-resizable' looks at other windows as well.
595
596 DELTA positive means WINDOW shall be enlarged by DELTA lines or
597 columns. If WINDOW cannot be enlarged by DELTA lines or columns
598 return the maximum value in the range 0..DELTA by which WINDOW
599 can be enlarged.
600
601 DELTA negative means WINDOW shall be shrunk by -DELTA lines or
602 columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
603 return the minimum value in the range DELTA..0 by which WINDOW
604 can be shrunk.
605
606 Optional argument IGNORE non-nil means ignore any restrictions
607 imposed by fixed size windows, `window-min-height' or
608 `window-min-width' settings. IGNORE equal `safe' means live
609 windows may get as small as `window-safe-min-height' lines and
610 `window-safe-min-width' columns. IGNORE any window means ignore
611 restrictions 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.
628 For the meaning of the arguments of this function see the
629 doc-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.
670 WINDOW can be an arbitrary window and defaults to the selected
671 window. Optional argument HORIZONTAL non-nil means return
672 non-nil if WINDOW's width is fixed.
673
674 If this function returns nil, this does not necessarily mean that
675 WINDOW 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.
720 WINDOW can be an arbitrary window and defaults to the selected
721 window. Return zero if WINDOW cannot be shrunk.
722
723 Optional argument HORIZONTAL non-nil means return number of
724 columns by which WINDOW can be shrunk.
725
726 Optional argument IGNORE non-nil means ignore any restrictions
727 imposed by fixed size windows, `window-min-height' or
728 `window-min-width' settings. IGNORE a window means ignore
729 restrictions for that window only. IGNORE equal `safe' means
730 live windows may get as small as `window-safe-min-height' lines
731 and `window-safe-min-width' columns.
732
733 Optional argument TRAIL `before' means only windows to the left
734 of or above WINDOW can be enlarged. Optional argument TRAIL
735 `after' means only windows to the right of or below WINDOW can be
736 enlarged.
737
738 Optional argument NOUP non-nil means don't go up in the window
739 tree but try to enlarge windows within WINDOW's combination only.
740
741 Optional argument NODOWN non-nil means don't check whether WINDOW
742 itself \(and its subwindows) can be shrunk; check only whether at
743 least 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.
801 WINDOW can be an arbitrary window and defaults to the selected
802 window. The return value is zero if WINDOW cannot be enlarged.
803
804 Optional argument HORIZONTAL non-nil means return maximum number
805 of columns by which WINDOW can be enlarged.
806
807 Optional argument IGNORE non-nil means ignore any restrictions
808 imposed by fixed size windows, `window-min-height' or
809 `window-min-width' settings. IGNORE a window means ignore
810 restrictions for that window only. IGNORE equal `safe' means
811 live windows may get as small as `window-safe-min-height' lines
812 and `window-safe-min-width' columns.
813
814 Optional argument TRAIL `before' means only windows to the left
815 of or below WINDOW can be shrunk. Optional argument TRAIL
816 `after' means only windows to the right of or above WINDOW can be
817 shrunk.
818
819 Optional argument NOUP non-nil means don't go up in the window
820 tree but try to obtain the entire space from windows within
821 WINDOW's combination.
822
823 Optional argument NODOWN non-nil means do not check whether
824 WINDOW itself \(and its subwindows) can be enlarged; check only
825 whether 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.
838 Optional argument HORIZONTAL non-nil means return DELTA if WINDOW
839 can be resized horizontally by DELTA columns. A return value of
840 zero means that WINDOW is not resizable.
841
842 DELTA positive means WINDOW shall be enlarged by DELTA lines or
843 columns. If WINDOW cannot be enlarged by DELTA lines or columns
844 return the maximum value in the range 0..DELTA by which WINDOW
845 can be enlarged.
846
847 DELTA negative means WINDOW shall be shrunk by -DELTA lines or
848 columns. If WINDOW cannot be shrunk by -DELTA lines or columns,
849 return the minimum value in the range DELTA..0 that can be used
850 for shrinking WINDOW.
851
852 Optional argument IGNORE non-nil means ignore any restrictions
853 imposed by fixed size windows, `window-min-height' or
854 `window-min-width' settings. IGNORE a window means ignore
855 restrictions for that window only. IGNORE equal `safe' means
856 live windows may get as small as `window-safe-min-height' lines
857 and `window-safe-min-width' columns.
858
859 Optional argument TRAIL `before' means only windows to the left
860 of or below WINDOW can be shrunk. Optional argument TRAIL
861 `after' means only windows to the right of or above WINDOW can be
862 shrunk.
863
864 Optional argument NOUP non-nil means don't go up in the window
865 tree but try to distribute the space among the other windows
866 within WINDOW's combination.
867
868 Optional argument NODOWN non-nil means don't check whether WINDOW
869 and 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.
882 For the meaning of the arguments of this function see the
883 doc-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.
893 WINDOW can be any window and defaults to the selected one. The
894 return value includes WINDOW's mode line and header line, if any.
895 If WINDOW is internal the return value is the sum of the total
896 number of lines of WINDOW's child windows if these are vertically
897 combined and the height of WINDOW's first child otherwise.
898
899 Note: 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))
902
903 ;; Eventually we should make `window-height' obsolete.
904 (defalias 'window-height 'window-total-height)
905
906 ;; See discussion in bug#4543.
907 (defsubst window-full-height-p (&optional window)
908 "Return t if WINDOW is as high as the containing frame.
909 More precisely, return t if and only if the total height of
910 WINDOW equals the total height of the root window of WINDOW's
911 frame. WINDOW can be any window and defaults to the selected
912 one."
913 (setq window (normalize-any-window window))
914 (= (window-total-size window)
915 (window-total-size (frame-root-window window))))
916
917 (defsubst window-total-width (&optional window)
918 "Return the total number of columns of WINDOW.
919 WINDOW can be any window and defaults to the selected one. The
920 return value includes any vertical dividers or scrollbars of
921 WINDOW. If WINDOW is internal, the return value is the sum of
922 the total number of columns of WINDOW's child windows if these
923 are horizontally combined and the width of WINDOW's first child
924 otherwise."
925 (window-total-size window t))
926
927 (defsubst window-full-width-p (&optional window)
928 "Return t if WINDOW is as wide as the containing frame.
929 More precisely, return t if and only if the total width of WINDOW
930 equals the total width of the root window of WINDOW's frame.
931 WINDOW can be any window and defaults to the selected one."
932 (setq window (normalize-any-window window))
933 (= (window-total-size window t)
934 (window-total-size (frame-root-window window) t)))
935
936 (defsubst window-body-height (&optional window)
937 "Return the number of lines of WINDOW's body.
938 WINDOW must be a live window and defaults to the selected one.
939
940 The return value does not include WINDOW's mode line and header
941 line, if any. If a line at the bottom of the window is only
942 partially visible, that line is included in the return value. If
943 you do not want to include a partially visible bottom line in the
944 return value, use `window-text-height' instead."
945 (window-body-size window))
946
947 (defsubst window-body-width (&optional window)
948 "Return the number of columns of WINDOW's body.
949 WINDOW must be a live window and defaults to the selected one.
950
951 The return value does not include any vertical dividers or scroll
952 bars owned by WINDOW. On a window-system the return value does
953 not include the number of columns used for WINDOW's fringes or
954 display margins either."
955 (window-body-size window t))
956
957 ;; Eventually we should make `window-height' obsolete.
958 (defalias 'window-width 'window-body-width)
959
960 (defun window-current-scroll-bars (&optional window)
961 "Return the current scroll bar settings for WINDOW.
962 WINDOW must be a live window and defaults to the selected one.
963
964 The return value is a cons cell (VERTICAL . HORIZONTAL) where
965 VERTICAL specifies the current location of the vertical scroll
966 bars (`left', `right', or nil), and HORIZONTAL specifies the
967 current location of the horizontal scroll bars (`top', `bottom',
968 or nil).
969
970 Unlike `window-scroll-bars', this function reports the scroll bar
971 type actually used, once frame defaults and `scroll-bar-mode' are
972 taken into account."
973 (setq window (normalize-live-window window))
974 (let ((vert (nth 2 (window-scroll-bars window)))
975 (hor nil))
976 (when (or (eq vert t) (eq hor t))
977 (let ((fcsb (frame-current-scroll-bars (window-frame window))))
978 (if (eq vert t)
979 (setq vert (car fcsb)))
980 (if (eq hor t)
981 (setq hor (cdr fcsb)))))
982 (cons vert hor)))
983
984 (defun walk-windows (proc &optional minibuf all-frames)
985 "Cycle through all live windows, calling PROC for each one.
986 PROC must specify a function with a window as its sole argument.
987 The optional arguments MINIBUF and ALL-FRAMES specify the set of
988 windows to include in the walk.
989
990 MINIBUF t means include the minibuffer window even if the
991 minibuffer is not active. MINIBUF nil or omitted means include
992 the minibuffer window only if the minibuffer is active. Any
993 other value means do not include the minibuffer window even if
994 the minibuffer is active.
995
996 ALL-FRAMES nil or omitted means consider all windows on the
997 selected frame, plus the minibuffer window if specified by the
998 MINIBUF argument. If the minibuffer counts, consider all windows
999 on all frames that share that minibuffer too. The following
1000 non-nil values of ALL-FRAMES have special meanings:
1001
1002 - t means consider all windows on all existing frames.
1003
1004 - `visible' means consider all windows on all visible frames on
1005 the current terminal.
1006
1007 - 0 (the number zero) means consider all windows on all visible
1008 and iconified frames on the current terminal.
1009
1010 - A frame means consider all windows on that frame only.
1011
1012 Anything else means consider all windows on the selected frame
1013 and no others.
1014
1015 This function changes neither the order of recently selected
1016 windows nor the buffer list."
1017 ;; If we start from the minibuffer window, don't fail to come
1018 ;; back to it.
1019 (when (window-minibuffer-p (selected-window))
1020 (setq minibuf t))
1021 ;; Make sure to not mess up the order of recently selected
1022 ;; windows. Use `save-selected-window' and `select-window'
1023 ;; with second argument non-nil for this purpose.
1024 (save-selected-window
1025 (when (framep all-frames)
1026 (select-window (frame-first-window all-frames) 'norecord))
1027 (dolist (walk-windows-window (window-list-1 nil minibuf all-frames))
1028 (funcall proc walk-windows-window))))
1029
1030 (defun window-in-direction-2 (window posn &optional horizontal)
1031 "Support function for `window-in-direction'."
1032 (if horizontal
1033 (let ((top (window-top-line window)))
1034 (if (> top posn)
1035 (- top posn)
1036 (- posn top (window-total-height window))))
1037 (let ((left (window-left-column window)))
1038 (if (> left posn)
1039 (- left posn)
1040 (- posn left (window-total-width window))))))
1041
1042 (defun window-in-direction (direction &optional window ignore)
1043 "Return window in DIRECTION as seen from WINDOW.
1044 DIRECTION must be one of `above', `below', `left' or `right'.
1045 WINDOW must be a live window and defaults to the selected one.
1046 IGNORE, when non-nil means a window can be returned even if its
1047 `no-other-window' parameter is non-nil."
1048 (setq window (normalize-live-window window))
1049 (unless (memq direction '(above below left right))
1050 (error "Wrong direction %s" direction))
1051 (let* ((frame (window-frame window))
1052 (hor (memq direction '(left right)))
1053 (first (if hor
1054 (window-left-column window)
1055 (window-top-line window)))
1056 (last (+ first (if hor
1057 (window-total-width window)
1058 (window-total-height window))))
1059 (posn-cons (nth 6 (posn-at-point (window-point window) window)))
1060 ;; The column / row value of `posn-at-point' can be nil for the
1061 ;; mini-window, guard against that.
1062 (posn (if hor
1063 (+ (or (cdr posn-cons) 1) (window-top-line window))
1064 (+ (or (car posn-cons) 1) (window-left-column window))))
1065 (best-edge
1066 (cond
1067 ((eq direction 'below) (frame-height frame))
1068 ((eq direction 'right) (frame-width frame))
1069 (t -1)))
1070 (best-edge-2 best-edge)
1071 (best-diff-2 (if hor (frame-height frame) (frame-width frame)))
1072 best best-2 best-diff-2-new)
1073 (walk-window-tree
1074 (lambda (w)
1075 (let* ((w-top (window-top-line w))
1076 (w-left (window-left-column w)))
1077 (cond
1078 ((or (eq window w)
1079 ;; Ignore ourselves.
1080 (and (window-parameter w 'no-other-window)
1081 ;; Ignore W unless IGNORE is non-nil.
1082 (not ignore))))
1083 (hor
1084 (cond
1085 ((and (<= w-top posn)
1086 (< posn (+ w-top (window-total-height w))))
1087 ;; W is to the left or right of WINDOW and covers POSN.
1088 (when (or (and (eq direction 'left)
1089 (<= w-left first) (> w-left best-edge))
1090 (and (eq direction 'right)
1091 (>= w-left last) (< w-left best-edge)))
1092 (setq best-edge w-left)
1093 (setq best w)))
1094 ((and (or (and (eq direction 'left)
1095 (<= (+ w-left (window-total-width w)) first))
1096 (and (eq direction 'right) (<= last w-left)))
1097 ;; W is to the left or right of WINDOW but does not
1098 ;; cover POSN.
1099 (setq best-diff-2-new
1100 (window-in-direction-2 w posn hor))
1101 (or (< best-diff-2-new best-diff-2)
1102 (and (= best-diff-2-new best-diff-2)
1103 (if (eq direction 'left)
1104 (> w-left best-edge-2)
1105 (< w-left best-edge-2)))))
1106 (setq best-edge-2 w-left)
1107 (setq best-diff-2 best-diff-2-new)
1108 (setq best-2 w))))
1109 (t
1110 (cond
1111 ((and (<= w-left posn)
1112 (< posn (+ w-left (window-total-width w))))
1113 ;; W is above or below WINDOW and covers POSN.
1114 (when (or (and (eq direction 'above)
1115 (<= w-top first) (> w-top best-edge))
1116 (and (eq direction 'below)
1117 (>= w-top first) (< w-top best-edge)))
1118 (setq best-edge w-top)
1119 (setq best w)))
1120 ((and (or (and (eq direction 'above)
1121 (<= (+ w-top (window-total-height w)) first))
1122 (and (eq direction 'below) (<= last w-top)))
1123 ;; W is above or below WINDOW but does not cover POSN.
1124 (setq best-diff-2-new
1125 (window-in-direction-2 w posn hor))
1126 (or (< best-diff-2-new best-diff-2)
1127 (and (= best-diff-2-new best-diff-2)
1128 (if (eq direction 'above)
1129 (> w-top best-edge-2)
1130 (< w-top best-edge-2)))))
1131 (setq best-edge-2 w-top)
1132 (setq best-diff-2 best-diff-2-new)
1133 (setq best-2 w)))))))
1134 (window-frame window))
1135 (or best best-2)))
1136
1137 (defun get-window-with-predicate (predicate &optional minibuf
1138 all-frames default)
1139 "Return a live window satisfying PREDICATE.
1140 More precisely, cycle through all windows calling the function
1141 PREDICATE on each one of them with the window as its sole
1142 argument. Return the first window for which PREDICATE returns
1143 non-nil. If no window satisfies PREDICATE, return DEFAULT.
1144
1145 ALL-FRAMES nil or omitted means consider all windows on the selected
1146 frame, plus the minibuffer window if specified by the MINIBUF
1147 argument. If the minibuffer counts, consider all windows on all
1148 frames that share that minibuffer too. The following non-nil
1149 values of ALL-FRAMES have special meanings:
1150
1151 - t means consider all windows on all existing frames.
1152
1153 - `visible' means consider all windows on all visible frames on
1154 the current terminal.
1155
1156 - 0 (the number zero) means consider all windows on all visible
1157 and iconified frames on the current terminal.
1158
1159 - A frame means consider all windows on that frame only.
1160
1161 Anything else means consider all windows on the selected frame
1162 and no others."
1163 (catch 'found
1164 (dolist (window (window-list-1 nil minibuf all-frames))
1165 (when (funcall predicate window)
1166 (throw 'found window)))
1167 default))
1168
1169 (defalias 'some-window 'get-window-with-predicate)
1170
1171 (defun get-lru-window (&optional all-frames dedicated)
1172 "Return the least recently used window on frames specified by ALL-FRAMES.
1173 Return a full-width window if possible. A minibuffer window is
1174 never a candidate. A dedicated window is never a candidate
1175 unless DEDICATED is non-nil, so if all windows are dedicated, the
1176 value is nil. Avoid returning the selected window if possible.
1177
1178 The following non-nil values of the optional argument ALL-FRAMES
1179 have special meanings:
1180
1181 - t means consider all windows on all existing frames.
1182
1183 - `visible' means consider all windows on all visible frames on
1184 the current terminal.
1185
1186 - 0 (the number zero) means consider all windows on all visible
1187 and iconified frames on the current terminal.
1188
1189 - A frame means consider all windows on that frame only.
1190
1191 Any other value of ALL-FRAMES means consider all windows on the
1192 selected frame and no others."
1193 (let (best-window best-time second-best-window second-best-time time)
1194 (dolist (window (window-list-1 nil nil all-frames))
1195 (when (or dedicated (not (window-dedicated-p window)))
1196 (setq time (window-use-time window))
1197 (if (or (eq window (selected-window))
1198 (not (window-full-width-p window)))
1199 (when (or (not second-best-time) (< time second-best-time))
1200 (setq second-best-time time)
1201 (setq second-best-window window))
1202 (when (or (not best-time) (< time best-time))
1203 (setq best-time time)
1204 (setq best-window window)))))
1205 (or best-window second-best-window)))
1206
1207 (defun get-mru-window (&optional all-frames)
1208 "Return the most recently used window on frames specified by ALL-FRAMES.
1209 Do not return a minibuffer window.
1210
1211 The following non-nil values of the optional argument ALL-FRAMES
1212 have special meanings:
1213
1214 - t means consider all windows on all existing frames.
1215
1216 - `visible' means consider all windows on all visible frames on
1217 the current terminal.
1218
1219 - 0 (the number zero) means consider all windows on all visible
1220 and iconified frames on the current terminal.
1221
1222 - A frame means consider all windows on that frame only.
1223
1224 Any other value of ALL-FRAMES means consider all windows on the
1225 selected frame and no others."
1226 (let (best-window best-time time)
1227 (dolist (window (window-list-1 nil nil all-frames))
1228 (setq time (window-use-time window))
1229 (when (or (not best-time) (> time best-time))
1230 (setq best-time time)
1231 (setq best-window window)))
1232 best-window))
1233
1234 (defun get-largest-window (&optional all-frames dedicated)
1235 "Return the largest window on frames specified by ALL-FRAMES.
1236 A minibuffer window is never a candidate. A dedicated window is
1237 never a candidate unless DEDICATED is non-nil, so if all windows
1238 are dedicated, the value is nil.
1239
1240 The following non-nil values of the optional argument ALL-FRAMES
1241 have special meanings:
1242
1243 - t means consider all windows on all existing frames.
1244
1245 - `visible' means consider all windows on all visible frames on
1246 the current terminal.
1247
1248 - 0 (the number zero) means consider all windows on all visible
1249 and iconified frames on the current terminal.
1250
1251 - A frame means consider all windows on that frame only.
1252
1253 Any other value of ALL-FRAMES means consider all windows on the
1254 selected frame and no others."
1255 (let ((best-size 0)
1256 best-window size)
1257 (dolist (window (window-list-1 nil nil all-frames))
1258 (when (or dedicated (not (window-dedicated-p window)))
1259 (setq size (* (window-total-size window)
1260 (window-total-size window t)))
1261 (when (> size best-size)
1262 (setq best-size size)
1263 (setq best-window window))))
1264 best-window))
1265
1266 (defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
1267 "Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
1268 BUFFER-OR-NAME may be a buffer or the name of an existing buffer
1269 and defaults to the current buffer.
1270
1271 Any windows showing BUFFER-OR-NAME on the selected frame are listed
1272 first.
1273
1274 MINIBUF t means include the minibuffer window even if the
1275 minibuffer is not active. MINIBUF nil or omitted means include
1276 the minibuffer window only if the minibuffer is active. Any
1277 other value means do not include the minibuffer window even if
1278 the minibuffer is active.
1279
1280 ALL-FRAMES nil or omitted means consider all windows on the
1281 selected frame, plus the minibuffer window if specified by the
1282 MINIBUF argument. If the minibuffer counts, consider all windows
1283 on all frames that share that minibuffer too. The following
1284 non-nil values of ALL-FRAMES have special meanings:
1285
1286 - t means consider all windows on all existing frames.
1287
1288 - `visible' means consider all windows on all visible frames on
1289 the current terminal.
1290
1291 - 0 (the number zero) means consider all windows on all visible
1292 and iconified frames on the current terminal.
1293
1294 - A frame means consider all windows on that frame only.
1295
1296 Anything else means consider all windows on the selected frame
1297 and no others."
1298 (let ((buffer (normalize-live-buffer buffer-or-name))
1299 windows)
1300 (dolist (window (window-list-1 (frame-first-window) minibuf all-frames))
1301 (when (eq (window-buffer window) buffer)
1302 (setq windows (cons window windows))))
1303 (nreverse windows)))
1304
1305 (defun minibuffer-window-active-p (window)
1306 "Return t if WINDOW is the currently active minibuffer window."
1307 (eq window (active-minibuffer-window)))
1308
1309 (defun count-windows (&optional minibuf)
1310 "Return the number of live windows on the selected frame.
1311 The optional argument MINIBUF specifies whether the minibuffer
1312 window shall be counted. See `walk-windows' for the precise
1313 meaning of this argument."
1314 (length (window-list-1 nil minibuf)))
1315
1316 ;; This should probably return non-nil when the selected window is part
1317 ;; of an atomic window whose root is the frame's root window.
1318 (defun one-window-p (&optional nomini all-frames)
1319 "Return non-nil if the selected window is the only window.
1320 Optional arg NOMINI non-nil means don't count the minibuffer
1321 even if it is active. Otherwise, the minibuffer is counted
1322 when it is active.
1323
1324 Optional argument ALL-FRAMES specifies the set of frames to
1325 consider, see also `next-window'. ALL-FRAMES nil or omitted
1326 means consider windows on the selected frame only, plus the
1327 minibuffer window if specified by the NOMINI argument. If the
1328 minibuffer counts, consider all windows on all frames that share
1329 that minibuffer too. The remaining non-nil values of ALL-FRAMES
1330 with a special meaning are:
1331
1332 - t means consider all windows on all existing frames.
1333
1334 - `visible' means consider all windows on all visible frames on
1335 the current terminal.
1336
1337 - 0 (the number zero) means consider all windows on all visible
1338 and iconified frames on the current terminal.
1339
1340 - A frame means consider all windows on that frame only.
1341
1342 Anything else means consider all windows on the selected frame
1343 and no others."
1344 (let ((base-window (selected-window)))
1345 (if (and nomini (eq base-window (minibuffer-window)))
1346 (setq base-window (next-window base-window)))
1347 (eq base-window
1348 (next-window base-window (if nomini 'arg) all-frames))))
1349 \f
1350 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
1351 ;;; `balance-windows' subroutines using `window-tree'
1352
1353 ;;; Translate from internal window tree format
1354
1355 (defun bw-get-tree (&optional window-or-frame)
1356 "Get a window split tree in our format.
1357
1358 WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
1359 then the whole window split tree for `selected-frame' is returned.
1360 If it is a frame, then this is used instead. If it is a window,
1361 then the smallest tree containing that window is returned."
1362 (when window-or-frame
1363 (unless (or (framep window-or-frame)
1364 (windowp window-or-frame))
1365 (error "Not a frame or window: %s" window-or-frame)))
1366 (let ((subtree (bw-find-tree-sub window-or-frame)))
1367 (when subtree
1368 (if (integerp subtree)
1369 nil
1370 (bw-get-tree-1 subtree)))))
1371
1372 (defun bw-get-tree-1 (split)
1373 (if (windowp split)
1374 split
1375 (let ((dir (car split))
1376 (edges (car (cdr split)))
1377 (childs (cdr (cdr split))))
1378 (list
1379 (cons 'dir (if dir 'ver 'hor))
1380 (cons 'b (nth 3 edges))
1381 (cons 'r (nth 2 edges))
1382 (cons 't (nth 1 edges))
1383 (cons 'l (nth 0 edges))
1384 (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
1385
1386 (defun bw-find-tree-sub (window-or-frame &optional get-parent)
1387 (let* ((window (when (windowp window-or-frame) window-or-frame))
1388 (frame (when (windowp window) (window-frame window)))
1389 (wt (car (window-tree frame))))
1390 (when (< 1 (length (window-list frame 0)))
1391 (if window
1392 (bw-find-tree-sub-1 wt window get-parent)
1393 wt))))
1394
1395 (defun bw-find-tree-sub-1 (tree win &optional get-parent)
1396 (unless (windowp win) (error "Not a window: %s" win))
1397 (if (memq win tree)
1398 (if get-parent
1399 get-parent
1400 tree)
1401 (let ((childs (cdr (cdr tree)))
1402 child
1403 subtree)
1404 (while (and childs (not subtree))
1405 (setq child (car childs))
1406 (setq childs (cdr childs))
1407 (when (and child (listp child))
1408 (setq subtree (bw-find-tree-sub-1 child win get-parent))))
1409 (if (integerp subtree)
1410 (progn
1411 (if (= 1 subtree)
1412 tree
1413 (1- subtree)))
1414 subtree
1415 ))))
1416
1417 ;;; Window or object edges
1418
1419 (defun bw-l (obj)
1420 "Left edge of OBJ."
1421 (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
1422 (defun bw-t (obj)
1423 "Top edge of OBJ."
1424 (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
1425 (defun bw-r (obj)
1426 "Right edge of OBJ."
1427 (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
1428 (defun bw-b (obj)
1429 "Bottom edge of OBJ."
1430 (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
1431
1432 ;;; Split directions
1433
1434 (defun bw-dir (obj)
1435 "Return window split tree direction if OBJ.
1436 If OBJ is a window return 'both. If it is a window split tree
1437 then return its direction."
1438 (if (symbolp obj)
1439 obj
1440 (if (windowp obj)
1441 'both
1442 (let ((dir (cdr (assq 'dir obj))))
1443 (unless (memq dir '(hor ver both))
1444 (error "Can't find dir in %s" obj))
1445 dir))))
1446
1447 (defun bw-eqdir (obj1 obj2)
1448 "Return t if window split tree directions are equal.
1449 OBJ1 and OBJ2 should be either windows or window split trees in
1450 our format. The directions returned by `bw-dir' are compared and
1451 t is returned if they are `eq' or one of them is 'both."
1452 (let ((dir1 (bw-dir obj1))
1453 (dir2 (bw-dir obj2)))
1454 (or (eq dir1 dir2)
1455 (eq dir1 'both)
1456 (eq dir2 'both))))
1457
1458 ;;; Building split tree
1459
1460 (defun bw-refresh-edges (obj)
1461 "Refresh the edge information of OBJ and return OBJ."
1462 (unless (windowp obj)
1463 (let ((childs (cdr (assq 'childs obj)))
1464 (ol 1000)
1465 (ot 1000)
1466 (or -1)
1467 (ob -1))
1468 (dolist (o childs)
1469 (when (> ol (bw-l o)) (setq ol (bw-l o)))
1470 (when (> ot (bw-t o)) (setq ot (bw-t o)))
1471 (when (< or (bw-r o)) (setq or (bw-r o)))
1472 (when (< ob (bw-b o)) (setq ob (bw-b o))))
1473 (setq obj (delq 'l obj))
1474 (setq obj (delq 't obj))
1475 (setq obj (delq 'r obj))
1476 (setq obj (delq 'b obj))
1477 (add-to-list 'obj (cons 'l ol))
1478 (add-to-list 'obj (cons 't ot))
1479 (add-to-list 'obj (cons 'r or))
1480 (add-to-list 'obj (cons 'b ob))
1481 ))
1482 obj)
1483
1484 ;;; Balance windows
1485
1486 (defun balance-windows (&optional window-or-frame)
1487 "Make windows the same heights or widths in window split subtrees.
1488
1489 When called non-interactively WINDOW-OR-FRAME may be either a
1490 window or a frame. It then balances the windows on the implied
1491 frame. If the parameter is a window only the corresponding window
1492 subtree is balanced."
1493 (interactive)
1494 (let (
1495 (wt (bw-get-tree window-or-frame))
1496 (w)
1497 (h)
1498 (tried-sizes)
1499 (last-sizes)
1500 (windows (window-list nil 0)))
1501 (when wt
1502 (while (not (member last-sizes tried-sizes))
1503 (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
1504 (setq last-sizes (mapcar (lambda (w)
1505 (window-edges w))
1506 windows))
1507 (when (eq 'hor (bw-dir wt))
1508 (setq w (- (bw-r wt) (bw-l wt))))
1509 (when (eq 'ver (bw-dir wt))
1510 (setq h (- (bw-b wt) (bw-t wt))))
1511 (bw-balance-sub wt w h)))))
1512
1513 (defun bw-adjust-window (window delta horizontal)
1514 "Wrapper around `adjust-window-trailing-edge' with error checking.
1515 Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
1516 ;; `adjust-window-trailing-edge' may fail if delta is too large.
1517 (while (>= (abs delta) 1)
1518 (condition-case nil
1519 (progn
1520 (adjust-window-trailing-edge window delta horizontal)
1521 (setq delta 0))
1522 (error
1523 ;;(message "adjust: %s" (error-message-string err))
1524 (setq delta (/ delta 2))))))
1525
1526 (defun bw-balance-sub (wt w h)
1527 (setq wt (bw-refresh-edges wt))
1528 (unless w (setq w (- (bw-r wt) (bw-l wt))))
1529 (unless h (setq h (- (bw-b wt) (bw-t wt))))
1530 (if (windowp wt)
1531 (progn
1532 (when w
1533 (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
1534 (when (/= 0 dw)
1535 (bw-adjust-window wt dw t))))
1536 (when h
1537 (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
1538 (when (/= 0 dh)
1539 (bw-adjust-window wt dh nil)))))
1540 (let* ((childs (cdr (assq 'childs wt)))
1541 (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
1542 (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
1543 (dolist (c childs)
1544 (bw-balance-sub c cw ch)))))
1545
1546 (defun window-fixed-size-p (&optional window direction)
1547 "Return t if WINDOW cannot be resized in DIRECTION.
1548 WINDOW defaults to the selected window. DIRECTION can be
1549 nil (i.e. any), `height' or `width'."
1550 (with-current-buffer (window-buffer window)
1551 (when (and (boundp 'window-size-fixed) window-size-fixed)
1552 (not (and direction
1553 (member (cons direction window-size-fixed)
1554 '((height . width) (width . height))))))))
1555
1556 ;;; A different solution to balance-windows.
1557
1558 (defvar window-area-factor 1
1559 "Factor by which the window area should be over-estimated.
1560 This is used by `balance-windows-area'.
1561 Changing this globally has no effect.")
1562 (make-variable-buffer-local 'window-area-factor)
1563
1564 (defun balance-windows-area ()
1565 "Make all visible windows the same area (approximately).
1566 See also `window-area-factor' to change the relative size of
1567 specific buffers."
1568 (interactive)
1569 (let* ((unchanged 0) (carry 0) (round 0)
1570 ;; Remove fixed-size windows.
1571 (wins (delq nil (mapcar (lambda (win)
1572 (if (not (window-fixed-size-p win)) win))
1573 (window-list nil 'nomini))))
1574 (changelog nil)
1575 next)
1576 ;; Resizing a window changes the size of surrounding windows in complex
1577 ;; ways, so it's difficult to balance them all. The introduction of
1578 ;; `adjust-window-trailing-edge' made it a bit easier, but it is still
1579 ;; very difficult to do. `balance-window' above takes an off-line
1580 ;; approach: get the whole window tree, then balance it, then try to
1581 ;; adjust the windows so they fit the result.
1582 ;; Here, instead, we take a "local optimization" approach, where we just
1583 ;; go through all the windows several times until nothing needs to be
1584 ;; changed. The main problem with this approach is that it's difficult
1585 ;; to make sure it terminates, so we use some heuristic to try and break
1586 ;; off infinite loops.
1587 ;; After a round without any change, we allow a second, to give a chance
1588 ;; to the carry to propagate a minor imbalance from the end back to
1589 ;; the beginning.
1590 (while (< unchanged 2)
1591 ;; (message "New round")
1592 (setq unchanged (1+ unchanged) round (1+ round))
1593 (dolist (win wins)
1594 (setq next win)
1595 (while (progn (setq next (next-window next))
1596 (window-fixed-size-p next)))
1597 ;; (assert (eq next (or (cadr (member win wins)) (car wins))))
1598 (let* ((horiz
1599 (< (car (window-edges win)) (car (window-edges next))))
1600 (areadiff (/ (- (* (window-height next) (window-width next)
1601 (buffer-local-value 'window-area-factor
1602 (window-buffer next)))
1603 (* (window-height win) (window-width win)
1604 (buffer-local-value 'window-area-factor
1605 (window-buffer win))))
1606 (max (buffer-local-value 'window-area-factor
1607 (window-buffer win))
1608 (buffer-local-value 'window-area-factor
1609 (window-buffer next)))))
1610 (edgesize (if horiz
1611 (+ (window-height win) (window-height next))
1612 (+ (window-width win) (window-width next))))
1613 (diff (/ areadiff edgesize)))
1614 (when (zerop diff)
1615 ;; Maybe diff is actually closer to 1 than to 0.
1616 (setq diff (/ (* 3 areadiff) (* 2 edgesize))))
1617 (when (and (zerop diff) (not (zerop areadiff)))
1618 (setq diff (/ (+ areadiff carry) edgesize))
1619 ;; Change things smoothly.
1620 (if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
1621 (if (zerop diff)
1622 ;; Make sure negligible differences don't accumulate to
1623 ;; become significant.
1624 (setq carry (+ carry areadiff))
1625 (bw-adjust-window win diff horiz)
1626 ;; (sit-for 0.5)
1627 (let ((change (cons win (window-edges win))))
1628 ;; If the same change has been seen already for this window,
1629 ;; we're most likely in an endless loop, so don't count it as
1630 ;; a change.
1631 (unless (member change changelog)
1632 (push change changelog)
1633 (setq unchanged 0 carry 0)))))))
1634 ;; We've now basically balanced all the windows.
1635 ;; But there may be some minor off-by-one imbalance left over,
1636 ;; so let's do some fine tuning.
1637 ;; (bw-finetune wins)
1638 ;; (message "Done in %d rounds" round)
1639 ))
1640
1641 \f
1642 (defcustom display-buffer-function nil
1643 "If non-nil, function to call to handle `display-buffer'.
1644 It will receive two args, the buffer and a flag which if non-nil
1645 means that the currently selected window is not acceptable. It
1646 should choose or create a window, display the specified buffer in
1647 it, and return the window.
1648
1649 Commands such as `switch-to-buffer-other-window' and
1650 `find-file-other-window' work using this function."
1651 :type '(choice
1652 (const nil)
1653 (function :tag "function"))
1654 :group 'windows)
1655
1656 (defcustom special-display-buffer-names nil
1657 "List of names of buffers that should be displayed specially.
1658 Displaying a buffer with `display-buffer' or `pop-to-buffer', if
1659 its name is in this list, displays the buffer in a way specified
1660 by `special-display-function'. `special-display-popup-frame'
1661 \(the default for `special-display-function') usually displays
1662 the buffer in a separate frame made with the parameters specified
1663 by `special-display-frame-alist'. If `special-display-function'
1664 has been set to some other function, that function is called with
1665 the buffer as first, and nil as second argument.
1666
1667 Alternatively, an element of this list can be specified as
1668 \(BUFFER-NAME FRAME-PARAMETERS), where BUFFER-NAME is a buffer
1669 name and FRAME-PARAMETERS an alist of \(PARAMETER . VALUE) pairs.
1670 `special-display-popup-frame' will interpret such pairs as frame
1671 parameters when it creates a special frame, overriding the
1672 corresponding values from `special-display-frame-alist'.
1673
1674 As a special case, if FRAME-PARAMETERS contains (same-window . t)
1675 `special-display-popup-frame' displays that buffer in the
1676 selected window. If FRAME-PARAMETERS contains (same-frame . t),
1677 it displays that buffer in a window on the selected frame.
1678
1679 If `special-display-function' specifies some other function than
1680 `special-display-popup-frame', that function is called with the
1681 buffer named BUFFER-NAME as first, and FRAME-PARAMETERS as second
1682 argument.
1683
1684 Finally, an element of this list can be also specified as
1685 \(BUFFER-NAME FUNCTION OTHER-ARGS). In that case,
1686 `special-display-popup-frame' will call FUNCTION with the buffer
1687 named BUFFER-NAME as first argument, and OTHER-ARGS as the
1688 second. If `special-display-function' specifies some other
1689 function, that function is called with the buffer named
1690 BUFFER-NAME as first, and the element's cdr as second argument.
1691
1692 If this variable appears \"not to work\", because you added a
1693 name to it but the corresponding buffer is displayed in the
1694 selected window, look at the values of `same-window-buffer-names'
1695 and `same-window-regexps'. Those variables take precedence over
1696 this one.
1697
1698 See also `special-display-regexps'."
1699 :type '(repeat
1700 (choice :tag "Buffer"
1701 :value ""
1702 (string :format "%v")
1703 (cons :tag "With parameters"
1704 :format "%v"
1705 :value ("" . nil)
1706 (string :format "%v")
1707 (repeat :tag "Parameters"
1708 (cons :format "%v"
1709 (symbol :tag "Parameter")
1710 (sexp :tag "Value"))))
1711 (list :tag "With function"
1712 :format "%v"
1713 :value ("" . nil)
1714 (string :format "%v")
1715 (function :tag "Function")
1716 (repeat :tag "Arguments" (sexp)))))
1717 :group 'windows
1718 :group 'frames)
1719
1720 ;;;###autoload
1721 (put 'special-display-buffer-names 'risky-local-variable t)
1722
1723 (defcustom special-display-regexps nil
1724 "List of regexps saying which buffers should be displayed specially.
1725 Displaying a buffer with `display-buffer' or `pop-to-buffer', if
1726 any regexp in this list matches its name, displays it specially
1727 using `special-display-function'. `special-display-popup-frame'
1728 \(the default for `special-display-function') usually displays
1729 the buffer in a separate frame made with the parameters specified
1730 by `special-display-frame-alist'. If `special-display-function'
1731 has been set to some other function, that function is called with
1732 the buffer as first, and nil as second argument.
1733
1734 Alternatively, an element of this list can be specified as
1735 \(REGEXP FRAME-PARAMETERS), where REGEXP is a regexp as above and
1736 FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
1737 `special-display-popup-frame' will then interpret these pairs as
1738 frame parameters when creating a special frame for a buffer whose
1739 name matches REGEXP, overriding the corresponding values from
1740 `special-display-frame-alist'.
1741
1742 As a special case, if FRAME-PARAMETERS contains (same-window . t)
1743 `special-display-popup-frame' displays buffers matching REGEXP in
1744 the selected window. \(same-frame . t) in FRAME-PARAMETERS means
1745 to display such buffers in a window on the selected frame.
1746
1747 If `special-display-function' specifies some other function than
1748 `special-display-popup-frame', that function is called with the
1749 buffer whose name matched REGEXP as first, and FRAME-PARAMETERS
1750 as second argument.
1751
1752 Finally, an element of this list can be also specified as
1753 \(REGEXP FUNCTION OTHER-ARGS). `special-display-popup-frame'
1754 will then call FUNCTION with the buffer whose name matched
1755 REGEXP as first, and OTHER-ARGS as second argument. If
1756 `special-display-function' specifies some other function, that
1757 function is called with the buffer whose name matched REGEXP
1758 as first, and the element's cdr as second argument.
1759
1760 If this variable appears \"not to work\", because you added a
1761 name to it but the corresponding buffer is displayed in the
1762 selected window, look at the values of `same-window-buffer-names'
1763 and `same-window-regexps'. Those variables take precedence over
1764 this one.
1765
1766 See also `special-display-buffer-names'."
1767 :type '(repeat
1768 (choice :tag "Buffer"
1769 :value ""
1770 (regexp :format "%v")
1771 (cons :tag "With parameters"
1772 :format "%v"
1773 :value ("" . nil)
1774 (regexp :format "%v")
1775 (repeat :tag "Parameters"
1776 (cons :format "%v"
1777 (symbol :tag "Parameter")
1778 (sexp :tag "Value"))))
1779 (list :tag "With function"
1780 :format "%v"
1781 :value ("" . nil)
1782 (regexp :format "%v")
1783 (function :tag "Function")
1784 (repeat :tag "Arguments" (sexp)))))
1785 :group 'windows
1786 :group 'frames)
1787
1788 (defun special-display-p (buffer-name)
1789 "Return non-nil if a buffer named BUFFER-NAME gets a special frame.
1790 More precisely, return t if `special-display-buffer-names' or
1791 `special-display-regexps' contain a string entry equaling or
1792 matching BUFFER-NAME. If `special-display-buffer-names' or
1793 `special-display-regexps' contain a list entry whose car equals
1794 or matches BUFFER-NAME, the return value is the cdr of that
1795 entry."
1796 (let (tmp)
1797 (cond
1798 ((not (stringp buffer-name)))
1799 ((member buffer-name special-display-buffer-names)
1800 t)
1801 ((setq tmp (assoc buffer-name special-display-buffer-names))
1802 (cdr tmp))
1803 ((catch 'found
1804 (dolist (regexp special-display-regexps)
1805 (cond
1806 ((stringp regexp)
1807 (when (string-match-p regexp buffer-name)
1808 (throw 'found t)))
1809 ((and (consp regexp) (stringp (car regexp))
1810 (string-match-p (car regexp) buffer-name))
1811 (throw 'found (cdr regexp))))))))))
1812
1813 (defcustom special-display-function 'special-display-popup-frame
1814 "Function to call for displaying special buffers.
1815 This function is called with two arguments - the buffer and,
1816 optionally, a list - and should return a window displaying that
1817 buffer. The default value usually makes a separate frame for the
1818 buffer using `special-display-frame-alist' to specify the frame
1819 parameters. See the definition of `special-display-popup-frame'
1820 for how to specify such a function.
1821
1822 A buffer is special when its name is either listed in
1823 `special-display-buffer-names' or matches a regexp in
1824 `special-display-regexps'."
1825 :type 'function
1826 :group 'frames)
1827
1828 (defcustom same-window-buffer-names nil
1829 "List of names of buffers that should appear in the \"same\" window.
1830 `display-buffer' and `pop-to-buffer' show a buffer whose name is
1831 on this list in the selected rather than some other window.
1832
1833 An element of this list can be a cons cell instead of just a
1834 string. In that case, the cell's car must be a string specifying
1835 the buffer name. This is for compatibility with
1836 `special-display-buffer-names'; the cdr of the cons cell is
1837 ignored.
1838
1839 See also `same-window-regexps'."
1840 :type '(repeat (string :format "%v"))
1841 :group 'windows)
1842
1843 (defcustom same-window-regexps nil
1844 "List of regexps saying which buffers should appear in the \"same\" window.
1845 `display-buffer' and `pop-to-buffer' show a buffer whose name
1846 matches a regexp on this list in the selected rather than some
1847 other window.
1848
1849 An element of this list can be a cons cell instead of just a
1850 string. In that case, the cell's car must be a regexp matching
1851 the buffer name. This is for compatibility with
1852 `special-display-regexps'; the cdr of the cons cell is ignored.
1853
1854 See also `same-window-buffer-names'."
1855 :type '(repeat (regexp :format "%v"))
1856 :group 'windows)
1857
1858 (defun same-window-p (buffer-name)
1859 "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
1860 This function returns non-nil if `display-buffer' or
1861 `pop-to-buffer' would show a buffer named BUFFER-NAME in the
1862 selected rather than \(as usual\) some other window. See
1863 `same-window-buffer-names' and `same-window-regexps'."
1864 (cond
1865 ((not (stringp buffer-name)))
1866 ;; The elements of `same-window-buffer-names' can be buffer
1867 ;; names or cons cells whose cars are buffer names.
1868 ((member buffer-name same-window-buffer-names))
1869 ((assoc buffer-name same-window-buffer-names))
1870 ((catch 'found
1871 (dolist (regexp same-window-regexps)
1872 ;; The elements of `same-window-regexps' can be regexps
1873 ;; or cons cells whose cars are regexps.
1874 (when (or (and (stringp regexp)
1875 (string-match regexp buffer-name))
1876 (and (consp regexp) (stringp (car regexp))
1877 (string-match-p (car regexp) buffer-name)))
1878 (throw 'found t)))))))
1879
1880 (defcustom pop-up-frames nil
1881 "Whether `display-buffer' should make a separate frame.
1882 If nil, never make a separate frame.
1883 If the value is `graphic-only', make a separate frame
1884 on graphic displays only.
1885 Any other non-nil value means always make a separate frame."
1886 :type '(choice
1887 (const :tag "Never" nil)
1888 (const :tag "On graphic displays only" graphic-only)
1889 (const :tag "Always" t))
1890 :group 'windows)
1891
1892 (defcustom display-buffer-reuse-frames nil
1893 "Non-nil means `display-buffer' should reuse frames.
1894 If the buffer in question is already displayed in a frame, raise
1895 that frame."
1896 :type 'boolean
1897 :version "21.1"
1898 :group 'windows)
1899
1900 (defcustom pop-up-windows t
1901 "Non-nil means `display-buffer' should make a new window."
1902 :type 'boolean
1903 :group 'windows)
1904
1905 (defcustom split-window-preferred-function 'split-window-sensibly
1906 "Function called by `display-buffer' routines to split a window.
1907 This function is called with a window as single argument and is
1908 supposed to split that window and return the new window. If the
1909 window can (or shall) not be split, it is supposed to return nil.
1910 The default is to call the function `split-window-sensibly' which
1911 tries to split the window in a way which seems most suitable.
1912 You can customize the options `split-height-threshold' and/or
1913 `split-width-threshold' in order to have `split-window-sensibly'
1914 prefer either vertical or horizontal splitting.
1915
1916 If you set this to any other function, bear in mind that the
1917 `display-buffer' routines may call this function two times. The
1918 argument of the first call is the largest window on its frame.
1919 If that call fails to return a live window, the function is
1920 called again with the least recently used window as argument. If
1921 that call fails too, `display-buffer' will use an existing window
1922 to display its buffer.
1923
1924 The window selected at the time `display-buffer' was invoked is
1925 still selected when this function is called. Hence you can
1926 compare the window argument with the value of `selected-window'
1927 if you intend to split the selected window instead or if you do
1928 not want to split the selected window."
1929 :type 'function
1930 :version "23.1"
1931 :group 'windows)
1932
1933 (defcustom split-height-threshold 80
1934 "Minimum height for splitting windows sensibly.
1935 If this is an integer, `split-window-sensibly' may split a window
1936 vertically only if it has at least this many lines. If this is
1937 nil, `split-window-sensibly' is not allowed to split a window
1938 vertically. If, however, a window is the only window on its
1939 frame, `split-window-sensibly' may split it vertically
1940 disregarding the value of this variable."
1941 :type '(choice (const nil) (integer :tag "lines"))
1942 :version "23.1"
1943 :group 'windows)
1944
1945 (defcustom split-width-threshold 160
1946 "Minimum width for splitting windows sensibly.
1947 If this is an integer, `split-window-sensibly' may split a window
1948 horizontally only if it has at least this many columns. If this
1949 is nil, `split-window-sensibly' is not allowed to split a window
1950 horizontally."
1951 :type '(choice (const nil) (integer :tag "columns"))
1952 :version "23.1"
1953 :group 'windows)
1954
1955 (defun window-splittable-p (window &optional horizontal)
1956 "Return non-nil if `split-window-sensibly' may split WINDOW.
1957 Optional argument HORIZONTAL nil or omitted means check whether
1958 `split-window-sensibly' may split WINDOW vertically. HORIZONTAL
1959 non-nil means check whether WINDOW may be split horizontally.
1960
1961 WINDOW may be split vertically when the following conditions
1962 hold:
1963 - `window-size-fixed' is either nil or equals `width' for the
1964 buffer of WINDOW.
1965 - `split-height-threshold' is an integer and WINDOW is at least as
1966 high as `split-height-threshold'.
1967 - When WINDOW is split evenly, the emanating windows are at least
1968 `window-min-height' lines tall and can accommodate at least one
1969 line plus - if WINDOW has one - a mode line.
1970
1971 WINDOW may be split horizontally when the following conditions
1972 hold:
1973 - `window-size-fixed' is either nil or equals `height' for the
1974 buffer of WINDOW.
1975 - `split-width-threshold' is an integer and WINDOW is at least as
1976 wide as `split-width-threshold'.
1977 - When WINDOW is split evenly, the emanating windows are at least
1978 `window-min-width' or two (whichever is larger) columns wide."
1979 (when (window-live-p window)
1980 (with-current-buffer (window-buffer window)
1981 (if horizontal
1982 ;; A window can be split horizontally when its width is not
1983 ;; fixed, it is at least `split-width-threshold' columns wide
1984 ;; and at least twice as wide as `window-min-width' and 2 (the
1985 ;; latter value is hardcoded).
1986 (and (memq window-size-fixed '(nil height))
1987 ;; Testing `window-full-width-p' here hardly makes any
1988 ;; sense nowadays. This can be done more intuitively by
1989 ;; setting up `split-width-threshold' appropriately.
1990 (numberp split-width-threshold)
1991 (>= (window-width window)
1992 (max split-width-threshold
1993 (* 2 (max window-min-width 2)))))
1994 ;; A window can be split vertically when its height is not
1995 ;; fixed, it is at least `split-height-threshold' lines high,
1996 ;; and it is at least twice as high as `window-min-height' and 2
1997 ;; if it has a modeline or 1.
1998 (and (memq window-size-fixed '(nil width))
1999 (numberp split-height-threshold)
2000 (>= (window-height window)
2001 (max split-height-threshold
2002 (* 2 (max window-min-height
2003 (if mode-line-format 2 1))))))))))
2004
2005 (defun split-window-sensibly (window)
2006 "Split WINDOW in a way suitable for `display-buffer'.
2007 If `split-height-threshold' specifies an integer, WINDOW is at
2008 least `split-height-threshold' lines tall and can be split
2009 vertically, split WINDOW into two windows one above the other and
2010 return the lower window. Otherwise, if `split-width-threshold'
2011 specifies an integer, WINDOW is at least `split-width-threshold'
2012 columns wide and can be split horizontally, split WINDOW into two
2013 windows side by side and return the window on the right. If this
2014 can't be done either and WINDOW is the only window on its frame,
2015 try to split WINDOW vertically disregarding any value specified
2016 by `split-height-threshold'. If that succeeds, return the lower
2017 window. Return nil otherwise.
2018
2019 By default `display-buffer' routines call this function to split
2020 the largest or least recently used window. To change the default
2021 customize the option `split-window-preferred-function'.
2022
2023 You can enforce this function to not split WINDOW horizontally,
2024 by setting \(or binding) the variable `split-width-threshold' to
2025 nil. If, in addition, you set `split-height-threshold' to zero,
2026 chances increase that this function does split WINDOW vertically.
2027
2028 In order to not split WINDOW vertically, set \(or bind) the
2029 variable `split-height-threshold' to nil. Additionally, you can
2030 set `split-width-threshold' to zero to make a horizontal split
2031 more likely to occur.
2032
2033 Have a look at the function `window-splittable-p' if you want to
2034 know how `split-window-sensibly' determines whether WINDOW can be
2035 split."
2036 (or (and (window-splittable-p window)
2037 ;; Split window vertically.
2038 (with-selected-window window
2039 (split-window-vertically)))
2040 (and (window-splittable-p window t)
2041 ;; Split window horizontally.
2042 (with-selected-window window
2043 (split-window-horizontally)))
2044 (and (eq window (frame-root-window (window-frame window)))
2045 (not (window-minibuffer-p window))
2046 ;; If WINDOW is the only window on its frame and is not the
2047 ;; minibuffer window, try to split it vertically disregarding
2048 ;; the value of `split-height-threshold'.
2049 (let ((split-height-threshold 0))
2050 (when (window-splittable-p window)
2051 (with-selected-window window
2052 (split-window-vertically)))))))
2053
2054 (defun window--try-to-split-window (window)
2055 "Try to split WINDOW.
2056 Return value returned by `split-window-preferred-function' if it
2057 represents a live window, nil otherwise."
2058 (and (window-live-p window)
2059 (not (frame-parameter (window-frame window) 'unsplittable))
2060 (let ((new-window
2061 ;; Since `split-window-preferred-function' might
2062 ;; throw an error use `condition-case'.
2063 (condition-case nil
2064 (funcall split-window-preferred-function window)
2065 (error nil))))
2066 (and (window-live-p new-window) new-window))))
2067
2068 (defun window--frame-usable-p (frame)
2069 "Return FRAME if it can be used to display a buffer."
2070 (when (frame-live-p frame)
2071 (let ((window (frame-root-window frame)))
2072 ;; `frame-root-window' may be an internal window which is considered
2073 ;; "dead" by `window-live-p'. Hence if `window' is not live we
2074 ;; implicitly know that `frame' has a visible window we can use.
2075 (unless (and (window-live-p window)
2076 (or (window-minibuffer-p window)
2077 ;; If the window is soft-dedicated, the frame is usable.
2078 ;; Actually, even if the window is really dedicated,
2079 ;; the frame is still usable by splitting it.
2080 ;; At least Emacs-22 allowed it, and it is desirable
2081 ;; when displaying same-frame windows.
2082 nil ; (eq t (window-dedicated-p window))
2083 ))
2084 frame))))
2085
2086 (defcustom even-window-heights t
2087 "If non-nil `display-buffer' will try to even window heights.
2088 Otherwise `display-buffer' will leave the window configuration
2089 alone. Heights are evened only when `display-buffer' chooses a
2090 window that appears above or below the selected window."
2091 :type 'boolean
2092 :group 'windows)
2093
2094 (defun window--even-window-heights (window)
2095 "Even heights of WINDOW and selected window.
2096 Do this only if these windows are vertically adjacent to each
2097 other, `even-window-heights' is non-nil, and the selected window
2098 is higher than WINDOW."
2099 (when (and even-window-heights
2100 (not (eq window (selected-window)))
2101 ;; Don't resize minibuffer windows.
2102 (not (window-minibuffer-p (selected-window)))
2103 (> (window-height (selected-window)) (window-height window))
2104 (eq (window-frame window) (window-frame (selected-window)))
2105 (let ((sel-edges (window-edges (selected-window)))
2106 (win-edges (window-edges window)))
2107 (and (= (nth 0 sel-edges) (nth 0 win-edges))
2108 (= (nth 2 sel-edges) (nth 2 win-edges))
2109 (or (= (nth 1 sel-edges) (nth 3 win-edges))
2110 (= (nth 3 sel-edges) (nth 1 win-edges))))))
2111 (let ((window-min-height 1))
2112 ;; Don't throw an error if we can't even window heights for
2113 ;; whatever reason.
2114 (condition-case nil
2115 (enlarge-window (/ (- (window-height window) (window-height)) 2))
2116 (error nil)))))
2117
2118 (defun window--display-buffer-1 (window)
2119 "Raise the frame containing WINDOW.
2120 Do not raise the selected frame. Return WINDOW."
2121 (let* ((frame (window-frame window))
2122 (visible (frame-visible-p frame)))
2123 (unless (or (not visible)
2124 ;; Assume the selected frame is already visible enough.
2125 (eq frame (selected-frame))
2126 ;; Assume the frame from which we invoked the minibuffer
2127 ;; is visible.
2128 (and (minibuffer-window-active-p (selected-window))
2129 (eq frame (window-frame (minibuffer-selected-window)))))
2130 (raise-frame frame))
2131 window))
2132
2133 (defun window--display-buffer-2 (buffer window &optional dedicated)
2134 "Display BUFFER in WINDOW and make its frame visible.
2135 Set `window-dedicated-p' to DEDICATED if non-nil.
2136 Return WINDOW."
2137 (when (and (buffer-live-p buffer) (window-live-p window))
2138 (set-window-buffer window buffer)
2139 (when dedicated
2140 (set-window-dedicated-p window dedicated))
2141 (window--display-buffer-1 window)))
2142
2143 (defvar display-buffer-mark-dedicated nil
2144 "If non-nil, `display-buffer' marks the windows it creates as dedicated.
2145 The actual non-nil value of this variable will be copied to the
2146 `window-dedicated-p' flag.")
2147
2148 (defun display-buffer (buffer-or-name &optional not-this-window frame)
2149 "Make buffer BUFFER-OR-NAME appear in some window but don't select it.
2150 BUFFER-OR-NAME must be a buffer or the name of an existing
2151 buffer. Return the window chosen to display BUFFER-OR-NAME or
2152 nil if no such window is found.
2153
2154 Optional argument NOT-THIS-WINDOW non-nil means display the
2155 buffer in a window other than the selected one, even if it is
2156 already displayed in the selected window.
2157
2158 Optional argument FRAME specifies which frames to investigate
2159 when the specified buffer is already displayed. If the buffer is
2160 already displayed in some window on one of these frames simply
2161 return that window. Possible values of FRAME are:
2162
2163 `visible' - consider windows on all visible frames on the current
2164 terminal.
2165
2166 0 - consider windows on all visible or iconified frames on the
2167 current terminal.
2168
2169 t - consider windows on all frames.
2170
2171 A specific frame - consider windows on that frame only.
2172
2173 nil - consider windows on the selected frame \(actually the
2174 last non-minibuffer frame\) only. If, however, either
2175 `display-buffer-reuse-frames' or `pop-up-frames' is non-nil
2176 \(non-nil and not graphic-only on a text-only terminal),
2177 consider all visible or iconified frames on the current terminal."
2178 (interactive "BDisplay buffer:\nP")
2179 (let* ((can-use-selected-window
2180 ;; The selected window is usable unless either NOT-THIS-WINDOW
2181 ;; is non-nil, it is dedicated to its buffer, or it is the
2182 ;; `minibuffer-window'.
2183 (not (or not-this-window
2184 (window-dedicated-p (selected-window))
2185 (window-minibuffer-p))))
2186 (buffer (if (bufferp buffer-or-name)
2187 buffer-or-name
2188 (get-buffer buffer-or-name)))
2189 (name-of-buffer (buffer-name buffer))
2190 ;; On text-only terminals do not pop up a new frame when
2191 ;; `pop-up-frames' equals graphic-only.
2192 (use-pop-up-frames (if (eq pop-up-frames 'graphic-only)
2193 (display-graphic-p)
2194 pop-up-frames))
2195 ;; `frame-to-use' is the frame where to show `buffer' - either
2196 ;; the selected frame or the last nonminibuffer frame.
2197 (frame-to-use
2198 (or (window--frame-usable-p (selected-frame))
2199 (window--frame-usable-p (last-nonminibuffer-frame))))
2200 ;; `window-to-use' is the window we use for showing `buffer'.
2201 window-to-use)
2202 (cond
2203 ((not (buffer-live-p buffer))
2204 (error "No such buffer %s" buffer))
2205 (display-buffer-function
2206 ;; Let `display-buffer-function' do the job.
2207 (funcall display-buffer-function buffer not-this-window))
2208 ((and (not not-this-window)
2209 (eq (window-buffer (selected-window)) buffer))
2210 ;; The selected window already displays BUFFER and
2211 ;; `not-this-window' is nil, so use it.
2212 (window--display-buffer-1 (selected-window)))
2213 ((and can-use-selected-window (same-window-p name-of-buffer))
2214 ;; If the buffer's name tells us to use the selected window do so.
2215 (window--display-buffer-2 buffer (selected-window)))
2216 ((let ((frames (or frame
2217 (and (or use-pop-up-frames
2218 display-buffer-reuse-frames
2219 (not (last-nonminibuffer-frame)))
2220 0)
2221 (last-nonminibuffer-frame))))
2222 (setq window-to-use
2223 (catch 'found
2224 ;; Search frames for a window displaying BUFFER. Return
2225 ;; the selected window only if we are allowed to do so.
2226 (dolist (window (get-buffer-window-list buffer 'nomini frames))
2227 (when (or can-use-selected-window
2228 (not (eq (selected-window) window)))
2229 (throw 'found window))))))
2230 ;; The buffer is already displayed in some window; use that.
2231 (window--display-buffer-1 window-to-use))
2232 ((and special-display-function
2233 ;; `special-display-p' returns either t or a list of frame
2234 ;; parameters to pass to `special-display-function'.
2235 (let ((pars (special-display-p name-of-buffer)))
2236 (when pars
2237 (funcall special-display-function
2238 buffer (if (listp pars) pars))))))
2239 ((or use-pop-up-frames (not frame-to-use))
2240 ;; We want or need a new frame.
2241 (let ((win (frame-selected-window (funcall pop-up-frame-function))))
2242 (window--display-buffer-2 buffer win display-buffer-mark-dedicated)))
2243 ((and pop-up-windows
2244 ;; Make a new window.
2245 (or (not (frame-parameter frame-to-use 'unsplittable))
2246 ;; If the selected frame cannot be split look at
2247 ;; `last-nonminibuffer-frame'.
2248 (and (eq frame-to-use (selected-frame))
2249 (setq frame-to-use (last-nonminibuffer-frame))
2250 (window--frame-usable-p frame-to-use)
2251 (not (frame-parameter frame-to-use 'unsplittable))))
2252 ;; Attempt to split largest or least recently used window.
2253 (setq window-to-use
2254 (or (window--try-to-split-window
2255 (get-largest-window frame-to-use t))
2256 (window--try-to-split-window
2257 (get-lru-window frame-to-use t)))))
2258 (window--display-buffer-2 buffer window-to-use
2259 display-buffer-mark-dedicated))
2260 ((let ((window-to-undedicate
2261 ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate
2262 ;; the selected window to its buffer, to avoid that some of
2263 ;; the `get-' routines below choose it. (Bug#1415)
2264 (and not-this-window (not (window-dedicated-p))
2265 (set-window-dedicated-p (selected-window) t)
2266 (selected-window))))
2267 (unwind-protect
2268 (setq window-to-use
2269 ;; Reuse an existing window.
2270 (or (get-lru-window frame-to-use)
2271 (let ((window (get-buffer-window buffer 'visible)))
2272 (unless (and not-this-window
2273 (eq window (selected-window)))
2274 window))
2275 (get-largest-window 'visible)
2276 (let ((window (get-buffer-window buffer 0)))
2277 (unless (and not-this-window
2278 (eq window (selected-window)))
2279 window))
2280 (get-largest-window 0)
2281 (frame-selected-window (funcall pop-up-frame-function))))
2282 (when (window-live-p window-to-undedicate)
2283 ;; Restore dedicated status of selected window.
2284 (set-window-dedicated-p window-to-undedicate nil))))
2285 (window--even-window-heights window-to-use)
2286 (window--display-buffer-2 buffer window-to-use)))))
2287
2288 (defun pop-to-buffer (buffer-or-name &optional other-window norecord)
2289 "Select buffer BUFFER-OR-NAME in some window, preferably a different one.
2290 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
2291 nil. If BUFFER-OR-NAME is a string not naming an existent
2292 buffer, create a buffer with that name. If BUFFER-OR-NAME is
2293 nil, choose some other buffer.
2294
2295 If `pop-up-windows' is non-nil, windows can be split to display
2296 the buffer. If optional second arg OTHER-WINDOW is non-nil,
2297 insist on finding another window even if the specified buffer is
2298 already visible in the selected window, and ignore
2299 `same-window-regexps' and `same-window-buffer-names'.
2300
2301 If the window to show BUFFER-OR-NAME is not on the selected
2302 frame, raise that window's frame and give it input focus.
2303
2304 This function returns the buffer it switched to. This uses the
2305 function `display-buffer' as a subroutine; see the documentation
2306 of `display-buffer' for additional customization information.
2307
2308 Optional third arg NORECORD non-nil means do not put this buffer
2309 at the front of the list of recently selected ones."
2310 (let ((buffer
2311 ;; FIXME: This behavior is carried over from the previous C version
2312 ;; of pop-to-buffer, but really we should use just
2313 ;; `get-buffer' here.
2314 (if (null buffer-or-name) (other-buffer (current-buffer))
2315 (or (get-buffer buffer-or-name)
2316 (let ((buf (get-buffer-create buffer-or-name)))
2317 (set-buffer-major-mode buf)
2318 buf))))
2319 (old-frame (selected-frame))
2320 new-window new-frame)
2321 (set-buffer buffer)
2322 (setq new-window (display-buffer buffer other-window))
2323 (select-window new-window norecord)
2324 (setq new-frame (window-frame new-window))
2325 (unless (eq new-frame old-frame)
2326 ;; `display-buffer' has chosen another frame, make sure it gets
2327 ;; input focus and is risen.
2328 (select-frame-set-input-focus new-frame))
2329 buffer))
2330
2331 ;; I think this should be the default; I think people will prefer it--rms.
2332 (defcustom split-window-keep-point t
2333 "If non-nil, \\[split-window-vertically] keeps the original point \
2334 in both children.
2335 This is often more convenient for editing.
2336 If nil, adjust point in each of the two windows to minimize redisplay.
2337 This is convenient on slow terminals, but point can move strangely.
2338
2339 This option applies only to `split-window-vertically' and
2340 functions that call it. `split-window' always keeps the original
2341 point in both children."
2342 :type 'boolean
2343 :group 'windows)
2344
2345 (defun split-window-vertically (&optional size)
2346 "Split selected window into two windows, one above the other.
2347 The upper window gets SIZE lines and the lower one gets the rest.
2348 SIZE negative means the lower window gets -SIZE lines and the
2349 upper one the rest. With no argument, split windows equally or
2350 close to it. Both windows display the same buffer, now current.
2351
2352 If the variable `split-window-keep-point' is non-nil, both new
2353 windows will get the same value of point as the selected window.
2354 This is often more convenient for editing. The upper window is
2355 the selected window.
2356
2357 Otherwise, we choose window starts so as to minimize the amount of
2358 redisplay; this is convenient on slow terminals. The new selected
2359 window is the one that the current value of point appears in. The
2360 value of point can change if the text around point is hidden by the
2361 new mode line.
2362
2363 Regardless of the value of `split-window-keep-point', the upper
2364 window is the original one and the return value is the new, lower
2365 window."
2366 (interactive "P")
2367 (let ((old-window (selected-window))
2368 (old-point (point))
2369 (size (and size (prefix-numeric-value size)))
2370 moved-by-window-height moved new-window bottom)
2371 (and size (< size 0)
2372 ;; Handle negative SIZE value.
2373 (setq size (+ (window-height) size)))
2374 (setq new-window (split-window nil size))
2375 (unless split-window-keep-point
2376 (with-current-buffer (window-buffer)
2377 (goto-char (window-start))
2378 (setq moved (vertical-motion (window-height)))
2379 (set-window-start new-window (point))
2380 (when (> (point) (window-point new-window))
2381 (set-window-point new-window (point)))
2382 (when (= moved (window-height))
2383 (setq moved-by-window-height t)
2384 (vertical-motion -1))
2385 (setq bottom (point)))
2386 (and moved-by-window-height
2387 (<= bottom (point))
2388 (set-window-point old-window (1- bottom)))
2389 (and moved-by-window-height
2390 (<= (window-start new-window) old-point)
2391 (set-window-point new-window old-point)
2392 (select-window new-window)))
2393 (split-window-save-restore-data new-window old-window)))
2394
2395 ;; This is to avoid compiler warnings.
2396 (defvar view-return-to-alist)
2397
2398 (defun split-window-save-restore-data (new-window old-window)
2399 (with-current-buffer (window-buffer)
2400 (when view-mode
2401 (let ((old-info (assq old-window view-return-to-alist)))
2402 (when old-info
2403 (push (cons new-window (cons (car (cdr old-info)) t))
2404 view-return-to-alist))))
2405 new-window))
2406
2407 (defun split-window-horizontally (&optional size)
2408 "Split selected window into two windows side by side.
2409 The selected window becomes the left one and gets SIZE columns.
2410 SIZE negative means the right window gets -SIZE lines.
2411
2412 SIZE includes the width of the window's scroll bar; if there are
2413 no scroll bars, it includes the width of the divider column to
2414 the window's right, if any. SIZE omitted or nil means split
2415 window equally.
2416
2417 The selected window remains selected. Return the new window."
2418 (interactive "P")
2419 (let ((old-window (selected-window))
2420 (size (and size (prefix-numeric-value size))))
2421 (and size (< size 0)
2422 ;; Handle negative SIZE value.
2423 (setq size (+ (window-width) size)))
2424 (split-window-save-restore-data (split-window nil size t) old-window)))
2425
2426 \f
2427 (defun set-window-text-height (window height)
2428 "Set the height in lines of the text display area of WINDOW to HEIGHT.
2429 HEIGHT doesn't include the mode line or header line, if any, or
2430 any partial-height lines in the text display area.
2431
2432 Note that the current implementation of this function cannot
2433 always set the height exactly, but attempts to be conservative,
2434 by allocating more lines than are actually needed in the case
2435 where some error may be present."
2436 (let ((delta (- height (window-text-height window))))
2437 (unless (zerop delta)
2438 ;; Setting window-min-height to a value like 1 can lead to very
2439 ;; bizarre displays because it also allows Emacs to make *other*
2440 ;; windows 1-line tall, which means that there's no more space for
2441 ;; the modeline.
2442 (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
2443 (if (and window (not (eq window (selected-window))))
2444 (save-selected-window
2445 (select-window window 'norecord)
2446 (enlarge-window delta))
2447 (enlarge-window delta))))))
2448
2449 \f
2450 (defun enlarge-window-horizontally (columns)
2451 "Make selected window COLUMNS wider.
2452 Interactively, if no argument is given, make selected window one
2453 column wider."
2454 (interactive "p")
2455 (enlarge-window columns t))
2456
2457 (defun shrink-window-horizontally (columns)
2458 "Make selected window COLUMNS narrower.
2459 Interactively, if no argument is given, make selected window one
2460 column narrower."
2461 (interactive "p")
2462 (shrink-window columns t))
2463
2464 (defun window-buffer-height (window)
2465 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
2466 (with-current-buffer (window-buffer window)
2467 (max 1
2468 (count-screen-lines (point-min) (point-max)
2469 ;; If buffer ends with a newline, ignore it when
2470 ;; counting height unless point is after it.
2471 (eobp)
2472 window))))
2473
2474 (defun count-screen-lines (&optional beg end count-final-newline window)
2475 "Return the number of screen lines in the region.
2476 The number of screen lines may be different from the number of actual lines,
2477 due to line breaking, display table, etc.
2478
2479 Optional arguments BEG and END default to `point-min' and `point-max'
2480 respectively.
2481
2482 If region ends with a newline, ignore it unless optional third argument
2483 COUNT-FINAL-NEWLINE is non-nil.
2484
2485 The optional fourth argument WINDOW specifies the window used for obtaining
2486 parameters such as width, horizontal scrolling, and so on. The default is
2487 to use the selected window's parameters.
2488
2489 Like `vertical-motion', `count-screen-lines' always uses the current buffer,
2490 regardless of which buffer is displayed in WINDOW. This makes possible to use
2491 `count-screen-lines' in any buffer, whether or not it is currently displayed
2492 in some window."
2493 (unless beg
2494 (setq beg (point-min)))
2495 (unless end
2496 (setq end (point-max)))
2497 (if (= beg end)
2498 0
2499 (save-excursion
2500 (save-restriction
2501 (widen)
2502 (narrow-to-region (min beg end)
2503 (if (and (not count-final-newline)
2504 (= ?\n (char-before (max beg end))))
2505 (1- (max beg end))
2506 (max beg end)))
2507 (goto-char (point-min))
2508 (1+ (vertical-motion (buffer-size) window))))))
2509
2510 (defun fit-window-to-buffer (&optional window max-height min-height)
2511 "Adjust height of WINDOW to display its buffer's contents exactly.
2512 WINDOW defaults to the selected window.
2513 Optional argument MAX-HEIGHT specifies the maximum height of the
2514 window and defaults to the maximum permissible height of a window
2515 on WINDOW's frame.
2516 Optional argument MIN-HEIGHT specifies the minimum height of the
2517 window and defaults to `window-min-height'.
2518 Both, MAX-HEIGHT and MIN-HEIGHT are specified in lines and
2519 include the mode line and header line, if any.
2520
2521 Return non-nil if height was orderly adjusted, nil otherwise.
2522
2523 Caution: This function can delete WINDOW and/or other windows
2524 when their height shrinks to less than MIN-HEIGHT."
2525 (interactive)
2526 ;; Do all the work in WINDOW and its buffer and restore the selected
2527 ;; window and the current buffer when we're done.
2528 (let ((old-buffer (current-buffer))
2529 value)
2530 (with-selected-window (or window (setq window (selected-window)))
2531 (set-buffer (window-buffer))
2532 ;; Use `condition-case' to handle any fixed-size windows and other
2533 ;; pitfalls nearby.
2534 (condition-case nil
2535 (let* (;; MIN-HEIGHT must not be less than 1 and defaults to
2536 ;; `window-min-height'.
2537 (min-height (max (or min-height window-min-height) 1))
2538 (max-window-height
2539 ;; Maximum height of any window on this frame.
2540 (min (window-height (frame-root-window)) (frame-height)))
2541 ;; MAX-HEIGHT must not be larger than max-window-height and
2542 ;; defaults to max-window-height.
2543 (max-height
2544 (min (or max-height max-window-height) max-window-height))
2545 (desired-height
2546 ;; The height necessary to show all of WINDOW's buffer,
2547 ;; constrained by MIN-HEIGHT and MAX-HEIGHT.
2548 (max
2549 (min
2550 ;; For an empty buffer `count-screen-lines' returns zero.
2551 ;; Even in that case we need one line for the cursor.
2552 (+ (max (count-screen-lines) 1)
2553 ;; For non-minibuffers count the mode line, if any.
2554 (if (and (not (window-minibuffer-p)) mode-line-format)
2555 1 0)
2556 ;; Count the header line, if any.
2557 (if header-line-format 1 0))
2558 max-height)
2559 min-height))
2560 (delta
2561 ;; How much the window height has to change.
2562 (if (= (window-height) (window-height (frame-root-window)))
2563 ;; Don't try to resize a full-height window.
2564 0
2565 (- desired-height (window-height))))
2566 ;; Do something reasonable so `enlarge-window' can make
2567 ;; windows as small as MIN-HEIGHT.
2568 (window-min-height (min min-height window-min-height)))
2569 ;; Don't try to redisplay with the cursor at the end on its
2570 ;; own line--that would force a scroll and spoil things.
2571 (when (and (eobp) (bolp) (not (bobp)))
2572 (set-window-point window (1- (window-point))))
2573 ;; Adjust WINDOW's height to the nominally correct one
2574 ;; (which may actually be slightly off because of variable
2575 ;; height text, etc).
2576 (unless (zerop delta)
2577 (enlarge-window delta))
2578 ;; `enlarge-window' might have deleted WINDOW, so make sure
2579 ;; WINDOW's still alive for the remainder of this.
2580 ;; Note: Deleting WINDOW is clearly counter-intuitive in
2581 ;; this context, but we can't do much about it given the
2582 ;; current semantics of `enlarge-window'.
2583 (when (window-live-p window)
2584 ;; Check if the last line is surely fully visible. If
2585 ;; not, enlarge the window.
2586 (let ((end (save-excursion
2587 (goto-char (point-max))
2588 (when (and (bolp) (not (bobp)))
2589 ;; Don't include final newline.
2590 (backward-char 1))
2591 (when truncate-lines
2592 ;; If line-wrapping is turned off, test the
2593 ;; beginning of the last line for
2594 ;; visibility instead of the end, as the
2595 ;; end of the line could be invisible by
2596 ;; virtue of extending past the edge of the
2597 ;; window.
2598 (forward-line 0))
2599 (point))))
2600 (set-window-vscroll window 0)
2601 (while (and (< desired-height max-height)
2602 (= desired-height (window-height))
2603 (not (pos-visible-in-window-p end)))
2604 (enlarge-window 1)
2605 (setq desired-height (1+ desired-height))))
2606 ;; Return non-nil only if nothing "bad" happened.
2607 (setq value t)))
2608 (error nil)))
2609 (when (buffer-live-p old-buffer)
2610 (set-buffer old-buffer))
2611 value))
2612
2613 (defun window-safely-shrinkable-p (&optional window)
2614 "Return t if WINDOW can be shrunk without shrinking other windows.
2615 WINDOW defaults to the selected window."
2616 (with-selected-window (or window (selected-window))
2617 (let ((edges (window-edges)))
2618 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
2619 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
2620
2621 (defun shrink-window-if-larger-than-buffer (&optional window)
2622 "Shrink height of WINDOW if its buffer doesn't need so many lines.
2623 More precisely, shrink WINDOW vertically to be as small as
2624 possible, while still showing the full contents of its buffer.
2625 WINDOW defaults to the selected window.
2626
2627 Do not shrink to less than `window-min-height' lines. Do nothing
2628 if the buffer contains more lines than the present window height,
2629 or if some of the window's contents are scrolled out of view, or
2630 if shrinking this window would also shrink another window, or if
2631 the window is the only window of its frame.
2632
2633 Return non-nil if the window was shrunk, nil otherwise."
2634 (interactive)
2635 (when (null window)
2636 (setq window (selected-window)))
2637 (let* ((frame (window-frame window))
2638 (mini (frame-parameter frame 'minibuffer))
2639 (edges (window-edges window)))
2640 (if (and (not (eq window (frame-root-window frame)))
2641 (window-safely-shrinkable-p window)
2642 (pos-visible-in-window-p (point-min) window)
2643 (not (eq mini 'only))
2644 (or (not mini)
2645 (let ((mini-window (minibuffer-window frame)))
2646 (or (null mini-window)
2647 (not (eq frame (window-frame mini-window)))
2648 (< (nth 3 edges)
2649 (nth 1 (window-edges mini-window)))
2650 (> (nth 1 edges)
2651 (frame-parameter frame 'menu-bar-lines))))))
2652 (fit-window-to-buffer window (window-height window)))))
2653
2654 (defun kill-buffer-and-window ()
2655 "Kill the current buffer and delete the selected window."
2656 (interactive)
2657 (let ((window-to-delete (selected-window))
2658 (buffer-to-kill (current-buffer))
2659 (delete-window-hook (lambda ()
2660 (condition-case nil
2661 (delete-window)
2662 (error nil)))))
2663 (unwind-protect
2664 (progn
2665 (add-hook 'kill-buffer-hook delete-window-hook t t)
2666 (if (kill-buffer (current-buffer))
2667 ;; If `delete-window' failed before, we rerun it to regenerate
2668 ;; the error so it can be seen in the echo area.
2669 (when (eq (selected-window) window-to-delete)
2670 (delete-window))))
2671 ;; If the buffer is not dead for some reason (probably because
2672 ;; of a `quit' signal), remove the hook again.
2673 (condition-case nil
2674 (with-current-buffer buffer-to-kill
2675 (remove-hook 'kill-buffer-hook delete-window-hook t))
2676 (error nil)))))
2677
2678 (defun quit-window (&optional kill window)
2679 "Quit WINDOW and bury its buffer.
2680 With a prefix argument, kill the buffer instead. WINDOW defaults
2681 to the selected window.
2682
2683 If WINDOW is non-nil, dedicated, or a minibuffer window, delete
2684 it and, if it's alone on its frame, its frame too. Otherwise, or
2685 if deleting WINDOW fails in any of the preceding cases, display
2686 another buffer in WINDOW using `switch-to-buffer'.
2687
2688 Optional argument KILL non-nil means kill WINDOW's buffer.
2689 Otherwise, bury WINDOW's buffer, see `bury-buffer'."
2690 (interactive "P")
2691 (let ((buffer (window-buffer window)))
2692 (if (or window
2693 (window-minibuffer-p window)
2694 (window-dedicated-p window))
2695 ;; WINDOW is either non-nil, a minibuffer window, or dedicated;
2696 ;; try to delete it.
2697 (let* ((window (or window (selected-window)))
2698 (frame (window-frame window)))
2699 (if (eq window (frame-root-window frame))
2700 ;; WINDOW is alone on its frame. `delete-windows-on'
2701 ;; knows how to handle that case.
2702 (delete-windows-on buffer frame)
2703 ;; There are other windows on its frame, delete WINDOW.
2704 (delete-window window)))
2705 ;; Otherwise, switch to another buffer in the selected window.
2706 (switch-to-buffer nil))
2707
2708 ;; Deal with the buffer.
2709 (if kill
2710 (kill-buffer buffer)
2711 (bury-buffer buffer))))
2712
2713 \f
2714 (defvar recenter-last-op nil
2715 "Indicates the last recenter operation performed.
2716 Possible values: `top', `middle', `bottom', integer or float numbers.")
2717
2718 (defcustom recenter-positions '(middle top bottom)
2719 "Cycling order for `recenter-top-bottom'.
2720 A list of elements with possible values `top', `middle', `bottom',
2721 integer or float numbers that define the cycling order for
2722 the command `recenter-top-bottom'.
2723
2724 Top and bottom destinations are `scroll-margin' lines the from true
2725 window top and bottom. Middle redraws the frame and centers point
2726 vertically within the window. Integer number moves current line to
2727 the specified absolute window-line. Float number between 0.0 and 1.0
2728 means the percentage of the screen space from the top. The default
2729 cycling order is middle -> top -> bottom."
2730 :type '(repeat (choice
2731 (const :tag "Top" top)
2732 (const :tag "Middle" middle)
2733 (const :tag "Bottom" bottom)
2734 (integer :tag "Line number")
2735 (float :tag "Percentage")))
2736 :version "23.2"
2737 :group 'windows)
2738
2739 (defun recenter-top-bottom (&optional arg)
2740 "Move current buffer line to the specified window line.
2741 With no prefix argument, successive calls place point according
2742 to the cycling order defined by `recenter-positions'.
2743
2744 A prefix argument is handled like `recenter':
2745 With numeric prefix ARG, move current line to window-line ARG.
2746 With plain `C-u', move current line to window center."
2747 (interactive "P")
2748 (cond
2749 (arg (recenter arg)) ; Always respect ARG.
2750 (t
2751 (setq recenter-last-op
2752 (if (eq this-command last-command)
2753 (car (or (cdr (member recenter-last-op recenter-positions))
2754 recenter-positions))
2755 (car recenter-positions)))
2756 (let ((this-scroll-margin
2757 (min (max 0 scroll-margin)
2758 (truncate (/ (window-body-height) 4.0)))))
2759 (cond ((eq recenter-last-op 'middle)
2760 (recenter))
2761 ((eq recenter-last-op 'top)
2762 (recenter this-scroll-margin))
2763 ((eq recenter-last-op 'bottom)
2764 (recenter (- -1 this-scroll-margin)))
2765 ((integerp recenter-last-op)
2766 (recenter recenter-last-op))
2767 ((floatp recenter-last-op)
2768 (recenter (round (* recenter-last-op (window-height))))))))))
2769
2770 (define-key global-map [?\C-l] 'recenter-top-bottom)
2771
2772 (defun move-to-window-line-top-bottom (&optional arg)
2773 "Position point relative to window.
2774
2775 With a prefix argument ARG, acts like `move-to-window-line'.
2776
2777 With no argument, positions point at center of window.
2778 Successive calls position point at positions defined
2779 by `recenter-positions'."
2780 (interactive "P")
2781 (cond
2782 (arg (move-to-window-line arg)) ; Always respect ARG.
2783 (t
2784 (setq recenter-last-op
2785 (if (eq this-command last-command)
2786 (car (or (cdr (member recenter-last-op recenter-positions))
2787 recenter-positions))
2788 (car recenter-positions)))
2789 (let ((this-scroll-margin
2790 (min (max 0 scroll-margin)
2791 (truncate (/ (window-body-height) 4.0)))))
2792 (cond ((eq recenter-last-op 'middle)
2793 (call-interactively 'move-to-window-line))
2794 ((eq recenter-last-op 'top)
2795 (move-to-window-line this-scroll-margin))
2796 ((eq recenter-last-op 'bottom)
2797 (move-to-window-line (- -1 this-scroll-margin)))
2798 ((integerp recenter-last-op)
2799 (move-to-window-line recenter-last-op))
2800 ((floatp recenter-last-op)
2801 (move-to-window-line (round (* recenter-last-op (window-height))))))))))
2802
2803 (define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
2804
2805 \f
2806 ;;; Scrolling commands.
2807
2808 ;;; Scrolling commands which does not signal errors at top/bottom
2809 ;;; of buffer at first key-press (instead moves to top/bottom
2810 ;;; of buffer).
2811
2812 (defcustom scroll-error-top-bottom nil
2813 "Move point to top/bottom of buffer before signalling a scrolling error.
2814 A value of nil means just signal an error if no more scrolling possible.
2815 A value of t means point moves to the beginning or the end of the buffer
2816 \(depending on scrolling direction) when no more scrolling possible.
2817 When point is already on that position, then signal an error."
2818 :type 'boolean
2819 :group 'scrolling
2820 :version "24.1")
2821
2822 (defun scroll-up-command (&optional arg)
2823 "Scroll text of selected window upward ARG lines; or near full screen if no ARG.
2824 If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
2825 scroll window further, move cursor to the bottom line.
2826 When point is already on that position, then signal an error.
2827 A near full screen is `next-screen-context-lines' less than a full screen.
2828 Negative ARG means scroll downward.
2829 If ARG is the atom `-', scroll downward by nearly full screen."
2830 (interactive "^P")
2831 (cond
2832 ((null scroll-error-top-bottom)
2833 (scroll-up arg))
2834 ((eq arg '-)
2835 (scroll-down-command nil))
2836 ((< (prefix-numeric-value arg) 0)
2837 (scroll-down-command (- (prefix-numeric-value arg))))
2838 ((eobp)
2839 (scroll-up arg)) ; signal error
2840 (t
2841 (condition-case nil
2842 (scroll-up arg)
2843 (end-of-buffer
2844 (if arg
2845 ;; When scrolling by ARG lines can't be done,
2846 ;; move by ARG lines instead.
2847 (forward-line arg)
2848 ;; When ARG is nil for full-screen scrolling,
2849 ;; move to the bottom of the buffer.
2850 (goto-char (point-max))))))))
2851
2852 (put 'scroll-up-command 'scroll-command t)
2853
2854 (defun scroll-down-command (&optional arg)
2855 "Scroll text of selected window down ARG lines; or near full screen if no ARG.
2856 If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
2857 scroll window further, move cursor to the top line.
2858 When point is already on that position, then signal an error.
2859 A near full screen is `next-screen-context-lines' less than a full screen.
2860 Negative ARG means scroll upward.
2861 If ARG is the atom `-', scroll upward by nearly full screen."
2862 (interactive "^P")
2863 (cond
2864 ((null scroll-error-top-bottom)
2865 (scroll-down arg))
2866 ((eq arg '-)
2867 (scroll-up-command nil))
2868 ((< (prefix-numeric-value arg) 0)
2869 (scroll-up-command (- (prefix-numeric-value arg))))
2870 ((bobp)
2871 (scroll-down arg)) ; signal error
2872 (t
2873 (condition-case nil
2874 (scroll-down arg)
2875 (beginning-of-buffer
2876 (if arg
2877 ;; When scrolling by ARG lines can't be done,
2878 ;; move by ARG lines instead.
2879 (forward-line (- arg))
2880 ;; When ARG is nil for full-screen scrolling,
2881 ;; move to the top of the buffer.
2882 (goto-char (point-min))))))))
2883
2884 (put 'scroll-down-command 'scroll-command t)
2885
2886 ;;; Scrolling commands which scroll a line instead of full screen.
2887
2888 (defun scroll-up-line (&optional arg)
2889 "Scroll text of selected window upward ARG lines; or one line if no ARG.
2890 If ARG is omitted or nil, scroll upward by one line.
2891 This is different from `scroll-up-command' that scrolls a full screen."
2892 (interactive "p")
2893 (scroll-up (or arg 1)))
2894
2895 (put 'scroll-up-line 'scroll-command t)
2896
2897 (defun scroll-down-line (&optional arg)
2898 "Scroll text of selected window down ARG lines; or one line if no ARG.
2899 If ARG is omitted or nil, scroll down by one line.
2900 This is different from `scroll-down-command' that scrolls a full screen."
2901 (interactive "p")
2902 (scroll-down (or arg 1)))
2903
2904 (put 'scroll-down-line 'scroll-command t)
2905
2906 \f
2907 (defun scroll-other-window-down (lines)
2908 "Scroll the \"other window\" down.
2909 For more details, see the documentation for `scroll-other-window'."
2910 (interactive "P")
2911 (scroll-other-window
2912 ;; Just invert the argument's meaning.
2913 ;; We can do that without knowing which window it will be.
2914 (if (eq lines '-) nil
2915 (if (null lines) '-
2916 (- (prefix-numeric-value lines))))))
2917
2918 (defun beginning-of-buffer-other-window (arg)
2919 "Move point to the beginning of the buffer in the other window.
2920 Leave mark at previous position.
2921 With arg N, put point N/10 of the way from the true beginning."
2922 (interactive "P")
2923 (let ((orig-window (selected-window))
2924 (window (other-window-for-scrolling)))
2925 ;; We use unwind-protect rather than save-window-excursion
2926 ;; because the latter would preserve the things we want to change.
2927 (unwind-protect
2928 (progn
2929 (select-window window)
2930 ;; Set point and mark in that window's buffer.
2931 (with-no-warnings
2932 (beginning-of-buffer arg))
2933 ;; Set point accordingly.
2934 (recenter '(t)))
2935 (select-window orig-window))))
2936
2937 (defun end-of-buffer-other-window (arg)
2938 "Move point to the end of the buffer in the other window.
2939 Leave mark at previous position.
2940 With arg N, put point N/10 of the way from the true end."
2941 (interactive "P")
2942 ;; See beginning-of-buffer-other-window for comments.
2943 (let ((orig-window (selected-window))
2944 (window (other-window-for-scrolling)))
2945 (unwind-protect
2946 (progn
2947 (select-window window)
2948 (with-no-warnings
2949 (end-of-buffer arg))
2950 (recenter '(t)))
2951 (select-window orig-window))))
2952
2953 \f
2954 (defvar mouse-autoselect-window-timer nil
2955 "Timer used by delayed window autoselection.")
2956
2957 (defvar mouse-autoselect-window-position nil
2958 "Last mouse position recorded by delayed window autoselection.")
2959
2960 (defvar mouse-autoselect-window-window nil
2961 "Last window recorded by delayed window autoselection.")
2962
2963 (defvar mouse-autoselect-window-state nil
2964 "When non-nil, special state of delayed window autoselection.
2965 Possible values are `suspend' \(suspend autoselection after a menu or
2966 scrollbar interaction\) and `select' \(the next invocation of
2967 'handle-select-window' shall select the window immediately\).")
2968
2969 (defun mouse-autoselect-window-cancel (&optional force)
2970 "Cancel delayed window autoselection.
2971 Optional argument FORCE means cancel unconditionally."
2972 (unless (and (not force)
2973 ;; Don't cancel for select-window or select-frame events
2974 ;; or when the user drags a scroll bar.
2975 (or (memq this-command
2976 '(handle-select-window handle-switch-frame))
2977 (and (eq this-command 'scroll-bar-toolkit-scroll)
2978 (memq (nth 4 (event-end last-input-event))
2979 '(handle end-scroll)))))
2980 (setq mouse-autoselect-window-state nil)
2981 (when (timerp mouse-autoselect-window-timer)
2982 (cancel-timer mouse-autoselect-window-timer))
2983 (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
2984
2985 (defun mouse-autoselect-window-start (mouse-position &optional window suspend)
2986 "Start delayed window autoselection.
2987 MOUSE-POSITION is the last position where the mouse was seen as returned
2988 by `mouse-position'. Optional argument WINDOW non-nil denotes the
2989 window where the mouse was seen. Optional argument SUSPEND non-nil
2990 means suspend autoselection."
2991 ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
2992 (setq mouse-autoselect-window-position mouse-position)
2993 (when window (setq mouse-autoselect-window-window window))
2994 (setq mouse-autoselect-window-state (when suspend 'suspend))
2995 ;; Install timer which runs `mouse-autoselect-window-select' after
2996 ;; `mouse-autoselect-window' seconds.
2997 (setq mouse-autoselect-window-timer
2998 (run-at-time
2999 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
3000
3001 (defun mouse-autoselect-window-select ()
3002 "Select window with delayed window autoselection.
3003 If the mouse position has stabilized in a non-selected window, select
3004 that window. The minibuffer window is selected only if the minibuffer is
3005 active. This function is run by `mouse-autoselect-window-timer'."
3006 (condition-case nil
3007 (let* ((mouse-position (mouse-position))
3008 (window
3009 (condition-case nil
3010 (window-at (cadr mouse-position) (cddr mouse-position)
3011 (car mouse-position))
3012 (error nil))))
3013 (cond
3014 ((or (menu-or-popup-active-p)
3015 (and window
3016 (not (coordinates-in-window-p (cdr mouse-position) window))))
3017 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
3018 ;; of WINDOW, temporarily suspend delayed autoselection.
3019 (mouse-autoselect-window-start mouse-position nil t))
3020 ((eq mouse-autoselect-window-state 'suspend)
3021 ;; Delayed autoselection was temporarily suspended, reenable it.
3022 (mouse-autoselect-window-start mouse-position))
3023 ((and window (not (eq window (selected-window)))
3024 (or (not (numberp mouse-autoselect-window))
3025 (and (> mouse-autoselect-window 0)
3026 ;; If `mouse-autoselect-window' is positive, select
3027 ;; window if the window is the same as before.
3028 (eq window mouse-autoselect-window-window))
3029 ;; Otherwise select window if the mouse is at the same
3030 ;; position as before. Observe that the first test after
3031 ;; starting autoselection usually fails since the value of
3032 ;; `mouse-autoselect-window-position' recorded there is the
3033 ;; position where the mouse has entered the new window and
3034 ;; not necessarily where the mouse has stopped moving.
3035 (equal mouse-position mouse-autoselect-window-position))
3036 ;; The minibuffer is a candidate window if it's active.
3037 (or (not (window-minibuffer-p window))
3038 (eq window (active-minibuffer-window))))
3039 ;; Mouse position has stabilized in non-selected window: Cancel
3040 ;; delayed autoselection and try to select that window.
3041 (mouse-autoselect-window-cancel t)
3042 ;; Select window where mouse appears unless the selected window is the
3043 ;; minibuffer. Use `unread-command-events' in order to execute pre-
3044 ;; and post-command hooks and trigger idle timers. To avoid delaying
3045 ;; autoselection again, set `mouse-autoselect-window-state'."
3046 (unless (window-minibuffer-p (selected-window))
3047 (setq mouse-autoselect-window-state 'select)
3048 (setq unread-command-events
3049 (cons (list 'select-window (list window))
3050 unread-command-events))))
3051 ((or (and window (eq window (selected-window)))
3052 (not (numberp mouse-autoselect-window))
3053 (equal mouse-position mouse-autoselect-window-position))
3054 ;; Mouse position has either stabilized in the selected window or at
3055 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
3056 (mouse-autoselect-window-cancel t))
3057 (t
3058 ;; Mouse position has not stabilized yet, resume delayed
3059 ;; autoselection.
3060 (mouse-autoselect-window-start mouse-position window))))
3061 (error nil)))
3062
3063 (defun handle-select-window (event)
3064 "Handle select-window events."
3065 (interactive "e")
3066 (let ((window (posn-window (event-start event))))
3067 (unless (or (not (window-live-p window))
3068 ;; Don't switch if we're currently in the minibuffer.
3069 ;; This tries to work around problems where the
3070 ;; minibuffer gets unselected unexpectedly, and where
3071 ;; you then have to move your mouse all the way down to
3072 ;; the minibuffer to select it.
3073 (window-minibuffer-p (selected-window))
3074 ;; Don't switch to minibuffer window unless it's active.
3075 (and (window-minibuffer-p window)
3076 (not (minibuffer-window-active-p window)))
3077 ;; Don't switch when autoselection shall be delayed.
3078 (and (numberp mouse-autoselect-window)
3079 (not (zerop mouse-autoselect-window))
3080 (not (eq mouse-autoselect-window-state 'select))
3081 (progn
3082 ;; Cancel any delayed autoselection.
3083 (mouse-autoselect-window-cancel t)
3084 ;; Start delayed autoselection from current mouse
3085 ;; position and window.
3086 (mouse-autoselect-window-start (mouse-position) window)
3087 ;; Executing a command cancels delayed autoselection.
3088 (add-hook
3089 'pre-command-hook 'mouse-autoselect-window-cancel))))
3090 (when mouse-autoselect-window
3091 ;; Reset state of delayed autoselection.
3092 (setq mouse-autoselect-window-state nil)
3093 ;; Run `mouse-leave-buffer-hook' when autoselecting window.
3094 (run-hooks 'mouse-leave-buffer-hook))
3095 (select-window window))))
3096
3097 (defun delete-other-windows-vertically (&optional window)
3098 "Delete the windows in the same column with WINDOW, but not WINDOW itself.
3099 This may be a useful alternative binding for \\[delete-other-windows]
3100 if you often split windows horizontally."
3101 (interactive)
3102 (let* ((window (or window (selected-window)))
3103 (edges (window-edges window))
3104 (w window) delenda)
3105 (while (not (eq (setq w (next-window w 1)) window))
3106 (let ((e (window-edges w)))
3107 (when (and (= (car e) (car edges))
3108 (= (caddr e) (caddr edges)))
3109 (push w delenda))))
3110 (mapc 'delete-window delenda)))
3111
3112 (defun truncated-partial-width-window-p (&optional window)
3113 "Return non-nil if lines in WINDOW are specifically truncated due to its width.
3114 WINDOW defaults to the selected window.
3115 Return nil if WINDOW is not a partial-width window
3116 (regardless of the value of `truncate-lines').
3117 Otherwise, consult the value of `truncate-partial-width-windows'
3118 for the buffer shown in WINDOW."
3119 (unless window
3120 (setq window (selected-window)))
3121 (unless (window-full-width-p window)
3122 (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
3123 (window-buffer window))))
3124 (if (integerp t-p-w-w)
3125 (< (window-width window) t-p-w-w)
3126 t-p-w-w))))
3127
3128 (define-key ctl-x-map "2" 'split-window-vertically)
3129 (define-key ctl-x-map "3" 'split-window-horizontally)
3130 (define-key ctl-x-map "}" 'enlarge-window-horizontally)
3131 (define-key ctl-x-map "{" 'shrink-window-horizontally)
3132 (define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
3133 (define-key ctl-x-map "+" 'balance-windows)
3134 (define-key ctl-x-4-map "0" 'kill-buffer-and-window)
3135
3136 ;;; window.el ends here