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