Fix typo in error message.
[bpt/emacs.git] / lisp / window.el
CommitLineData
3c448ab6
MR
1;;; window.el --- GNU Emacs window commands aside from those written in C
2
3;; Copyright (C) 1985, 1989, 1992, 1993, 1994, 2000, 2001, 2002,
114f9c96 4;; 2003, 2004, 2005, 2006, 2007, 2008, 2009, 2010
3689984f 5;; Free Software Foundation, Inc.
3c448ab6
MR
6
7;; Maintainer: FSF
8;; Keywords: internal
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(defvar window-size-fixed nil
34 "*Non-nil in a buffer means windows displaying the buffer are fixed-size.
35If the value is `height', then only the window's height is fixed.
36If the value is `width', then only the window's width is fixed.
37Any other non-nil value fixes both the width and the height.
38Emacs won't change the size of any window displaying that buffer,
39unless you explicitly change the size, or Emacs has no other choice.")
40(make-variable-buffer-local 'window-size-fixed)
41
42(defmacro save-selected-window (&rest body)
43 "Execute BODY, then select the previously selected window.
44The value returned is the value of the last form in BODY.
45
46This macro saves and restores the selected window, as well as the
47selected window in each frame. If the previously selected window
48is no longer live, then whatever window is selected at the end of
49BODY remains selected. If the previously selected window of some
50frame is no longer live at the end of BODY, that frame's selected
51window is left alone.
52
53This macro saves and restores the current buffer, since otherwise
54its normal operation could make a different buffer current. The
55order of recently selected windows and the buffer list ordering
56are not altered by this macro (unless they are altered in BODY)."
57 `(let ((save-selected-window-window (selected-window))
58 ;; It is necessary to save all of these, because calling
59 ;; select-window changes frame-selected-window for whatever
60 ;; frame that window is in.
61 (save-selected-window-alist
62 (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
63 (frame-list))))
64 (save-current-buffer
65 (unwind-protect
66 (progn ,@body)
67 (dolist (elt save-selected-window-alist)
68 (and (frame-live-p (car elt))
69 (window-live-p (cdr elt))
70 (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
71 (when (window-live-p save-selected-window-window)
72 (select-window save-selected-window-window 'norecord))))))
73
74(defun window-body-height (&optional window)
75 "Return number of lines in WINDOW available for actual buffer text.
76WINDOW defaults to the selected window.
77
78The return value does not include the mode line or the header
79line, if any. If a line at the bottom of the window is only
80partially visible, that line is included in the return value. If
81you do not want to include a partially visible bottom line in the
82return value, use `window-text-height' instead."
83 (or window (setq window (selected-window)))
84 (if (window-minibuffer-p window)
85 (window-height window)
86 (with-current-buffer (window-buffer window)
87 (max 1 (- (window-height window)
88 (if mode-line-format 1 0)
89 (if header-line-format 1 0))))))
90
ccafbf06 91;; See discussion in bug#4543.
02c6f098 92(defun window-full-height-p (&optional window)
ccafbf06
GM
93 "Return non-nil if WINDOW is not the result of a vertical split.
94WINDOW defaults to the selected window. (This function is not
95appropriate for minibuffers.)"
02c6f098
GM
96 (unless window
97 (setq window (selected-window)))
98 (= (window-height window)
99 (window-height (frame-root-window (window-frame window)))))
100
3c448ab6
MR
101(defun one-window-p (&optional nomini all-frames)
102 "Return non-nil if the selected window is the only window.
103Optional arg NOMINI non-nil means don't count the minibuffer
104even if it is active. Otherwise, the minibuffer is counted
105when it is active.
106
107The optional arg ALL-FRAMES t means count windows on all frames.
108If it is `visible', count windows on all visible frames.
109ALL-FRAMES nil or omitted means count only the selected frame,
110plus the minibuffer it uses (which may be on another frame).
111ALL-FRAMES 0 means count all windows in all visible or iconified frames.
112If ALL-FRAMES is anything else, count only the selected frame."
113 (let ((base-window (selected-window)))
114 (if (and nomini (eq base-window (minibuffer-window)))
115 (setq base-window (next-window base-window)))
116 (eq base-window
117 (next-window base-window (if nomini 'arg) all-frames))))
118
119(defun window-current-scroll-bars (&optional window)
120 "Return the current scroll bar settings for WINDOW.
121WINDOW defaults to the selected window.
122
123The return value is a cons cell (VERTICAL . HORIZONTAL) where
124VERTICAL specifies the current location of the vertical scroll
125bars (`left', `right', or nil), and HORIZONTAL specifies the
126current location of the horizontal scroll bars (`top', `bottom',
127or nil).
128
129Unlike `window-scroll-bars', this function reports the scroll bar
130type actually used, once frame defaults and `scroll-bar-mode' are
131taken into account."
132 (let ((vert (nth 2 (window-scroll-bars window)))
133 (hor nil))
134 (when (or (eq vert t) (eq hor t))
135 (let ((fcsb (frame-current-scroll-bars
136 (window-frame (or window (selected-window))))))
137 (if (eq vert t)
138 (setq vert (car fcsb)))
139 (if (eq hor t)
140 (setq hor (cdr fcsb)))))
141 (cons vert hor)))
142
143(defun walk-windows (proc &optional minibuf all-frames)
144 "Cycle through all windows, calling PROC for each one.
145PROC must specify a function with a window as its sole argument.
146The optional arguments MINIBUF and ALL-FRAMES specify the set of
147windows to include in the walk, see also `next-window'.
148
149MINIBUF t means include the minibuffer window even if the
150minibuffer is not active. MINIBUF nil or omitted means include
151the minibuffer window only if the minibuffer is active. Any
152other value means do not include the minibuffer window even if
153the minibuffer is active.
154
155Several frames may share a single minibuffer; if the minibuffer
156is active, all windows on all frames that share that minibuffer
157are included too. Therefore, if you are using a separate
158minibuffer frame and the minibuffer is active and MINIBUF says it
159counts, `walk-windows' includes the windows in the frame from
160which you entered the minibuffer, as well as the minibuffer
161window.
162
163ALL-FRAMES nil or omitted means cycle through all windows on
164 WINDOW's frame, plus the minibuffer window if specified by the
165 MINIBUF argument, see above. If the minibuffer counts, cycle
166 through all windows on all frames that share that minibuffer
167 too.
168ALL-FRAMES t means cycle through all windows on all existing
169 frames.
170ALL-FRAMES `visible' means cycle through all windows on all
171 visible frames.
172ALL-FRAMES 0 means cycle through all windows on all visible and
173 iconified frames.
174ALL-FRAMES a frame means cycle through all windows on that frame
175 only.
176Anything else means cycle through all windows on WINDOW's frame
177 and no others.
178
179This function changes neither the order of recently selected
180windows nor the buffer list."
181 ;; If we start from the minibuffer window, don't fail to come
182 ;; back to it.
183 (when (window-minibuffer-p (selected-window))
184 (setq minibuf t))
185 ;; Make sure to not mess up the order of recently selected
186 ;; windows. Use `save-selected-window' and `select-window'
187 ;; with second argument non-nil for this purpose.
188 (save-selected-window
189 (when (framep all-frames)
190 (select-window (frame-first-window all-frames) 'norecord))
191 (let* (walk-windows-already-seen
192 (walk-windows-current (selected-window)))
193 (while (progn
194 (setq walk-windows-current
195 (next-window walk-windows-current minibuf all-frames))
196 (not (memq walk-windows-current walk-windows-already-seen)))
197 (setq walk-windows-already-seen
198 (cons walk-windows-current walk-windows-already-seen))
199 (funcall proc walk-windows-current)))))
200
201(defun get-window-with-predicate (predicate &optional minibuf
202 all-frames default)
203 "Return a window satisfying PREDICATE.
204More precisely, cycle through all windows using `walk-windows',
205calling the function PREDICATE on each one of them with the
206window as its sole argument. Return the first window for which
207PREDICATE returns non-nil. If no window satisfies PREDICATE,
208return DEFAULT.
209
210The optional arguments MINIBUF and ALL-FRAMES specify the set of
211windows to include. See `walk-windows' for the meaning of these
212arguments."
213 (catch 'found
214 (walk-windows #'(lambda (window)
215 (when (funcall predicate window)
216 (throw 'found window)))
217 minibuf all-frames)
218 default))
219
220(defalias 'some-window 'get-window-with-predicate)
221
222;; This should probably be written in C (i.e., without using `walk-windows').
223(defun get-buffer-window-list (&optional buffer-or-name minibuf all-frames)
224 "Return list of all windows displaying BUFFER-OR-NAME, or nil if none.
225BUFFER-OR-NAME may be a buffer or the name of an existing buffer
226and defaults to the current buffer.
227
228The optional arguments MINIBUF and ALL-FRAMES specify the set of
229windows to consider. See `walk-windows' for the precise meaning
230of these arguments."
231 (let ((buffer (cond
232 ((not buffer-or-name) (current-buffer))
233 ((bufferp buffer-or-name) buffer-or-name)
234 (t (get-buffer buffer-or-name))))
235 windows)
236 (walk-windows (function (lambda (window)
237 (if (eq (window-buffer window) buffer)
238 (setq windows (cons window windows)))))
239 minibuf all-frames)
240 windows))
241
242(defun minibuffer-window-active-p (window)
243 "Return t if WINDOW is the currently active minibuffer window."
244 (eq window (active-minibuffer-window)))
245\f
246(defun count-windows (&optional minibuf)
247 "Return the number of visible windows.
248The optional argument MINIBUF specifies whether the minibuffer
249window shall be counted. See `walk-windows' for the precise
250meaning of this argument."
251 (let ((count 0))
252 (walk-windows (lambda (w) (setq count (+ count 1)))
253 minibuf)
254 count))
255\f
256;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
257;;; `balance-windows' subroutines using `window-tree'
258
259;;; Translate from internal window tree format
260
261(defun bw-get-tree (&optional window-or-frame)
262 "Get a window split tree in our format.
263
264WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil,
265then the whole window split tree for `selected-frame' is returned.
266If it is a frame, then this is used instead. If it is a window,
267then the smallest tree containing that window is returned."
268 (when window-or-frame
269 (unless (or (framep window-or-frame)
270 (windowp window-or-frame))
271 (error "Not a frame or window: %s" window-or-frame)))
272 (let ((subtree (bw-find-tree-sub window-or-frame)))
273 (when subtree
274 (if (integerp subtree)
275 nil
276 (bw-get-tree-1 subtree)))))
277
278(defun bw-get-tree-1 (split)
279 (if (windowp split)
280 split
281 (let ((dir (car split))
282 (edges (car (cdr split)))
283 (childs (cdr (cdr split))))
284 (list
285 (cons 'dir (if dir 'ver 'hor))
286 (cons 'b (nth 3 edges))
287 (cons 'r (nth 2 edges))
288 (cons 't (nth 1 edges))
289 (cons 'l (nth 0 edges))
290 (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
291
292(defun bw-find-tree-sub (window-or-frame &optional get-parent)
293 (let* ((window (when (windowp window-or-frame) window-or-frame))
294 (frame (when (windowp window) (window-frame window)))
295 (wt (car (window-tree frame))))
296 (when (< 1 (length (window-list frame 0)))
297 (if window
298 (bw-find-tree-sub-1 wt window get-parent)
299 wt))))
300
301(defun bw-find-tree-sub-1 (tree win &optional get-parent)
302 (unless (windowp win) (error "Not a window: %s" win))
303 (if (memq win tree)
304 (if get-parent
305 get-parent
306 tree)
307 (let ((childs (cdr (cdr tree)))
308 child
309 subtree)
310 (while (and childs (not subtree))
311 (setq child (car childs))
312 (setq childs (cdr childs))
313 (when (and child (listp child))
314 (setq subtree (bw-find-tree-sub-1 child win get-parent))))
315 (if (integerp subtree)
316 (progn
317 (if (= 1 subtree)
318 tree
319 (1- subtree)))
320 subtree
321 ))))
322
323;;; Window or object edges
324
325(defun bw-l (obj)
326 "Left edge of OBJ."
327 (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
328(defun bw-t (obj)
329 "Top edge of OBJ."
330 (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
331(defun bw-r (obj)
332 "Right edge of OBJ."
333 (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
334(defun bw-b (obj)
335 "Bottom edge of OBJ."
336 (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
337
338;;; Split directions
339
340(defun bw-dir (obj)
341 "Return window split tree direction if OBJ.
342If OBJ is a window return 'both. If it is a window split tree
343then return its direction."
344 (if (symbolp obj)
345 obj
346 (if (windowp obj)
347 'both
348 (let ((dir (cdr (assq 'dir obj))))
349 (unless (memq dir '(hor ver both))
350 (error "Can't find dir in %s" obj))
351 dir))))
352
353(defun bw-eqdir (obj1 obj2)
354 "Return t if window split tree directions are equal.
355OBJ1 and OBJ2 should be either windows or window split trees in
356our format. The directions returned by `bw-dir' are compared and
357t is returned if they are `eq' or one of them is 'both."
358 (let ((dir1 (bw-dir obj1))
359 (dir2 (bw-dir obj2)))
360 (or (eq dir1 dir2)
361 (eq dir1 'both)
362 (eq dir2 'both))))
363
364;;; Building split tree
365
366(defun bw-refresh-edges (obj)
367 "Refresh the edge information of OBJ and return OBJ."
368 (unless (windowp obj)
369 (let ((childs (cdr (assq 'childs obj)))
370 (ol 1000)
371 (ot 1000)
372 (or -1)
373 (ob -1))
374 (dolist (o childs)
375 (when (> ol (bw-l o)) (setq ol (bw-l o)))
376 (when (> ot (bw-t o)) (setq ot (bw-t o)))
377 (when (< or (bw-r o)) (setq or (bw-r o)))
378 (when (< ob (bw-b o)) (setq ob (bw-b o))))
379 (setq obj (delq 'l obj))
380 (setq obj (delq 't obj))
381 (setq obj (delq 'r obj))
382 (setq obj (delq 'b obj))
383 (add-to-list 'obj (cons 'l ol))
384 (add-to-list 'obj (cons 't ot))
385 (add-to-list 'obj (cons 'r or))
386 (add-to-list 'obj (cons 'b ob))
387 ))
388 obj)
389
390;;; Balance windows
391
392(defun balance-windows (&optional window-or-frame)
393 "Make windows the same heights or widths in window split subtrees.
394
395When called non-interactively WINDOW-OR-FRAME may be either a
396window or a frame. It then balances the windows on the implied
397frame. If the parameter is a window only the corresponding window
398subtree is balanced."
399 (interactive)
400 (let (
401 (wt (bw-get-tree window-or-frame))
402 (w)
403 (h)
404 (tried-sizes)
405 (last-sizes)
406 (windows (window-list nil 0)))
407 (when wt
408 (while (not (member last-sizes tried-sizes))
409 (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes)))
410 (setq last-sizes (mapcar (lambda (w)
411 (window-edges w))
412 windows))
413 (when (eq 'hor (bw-dir wt))
414 (setq w (- (bw-r wt) (bw-l wt))))
415 (when (eq 'ver (bw-dir wt))
416 (setq h (- (bw-b wt) (bw-t wt))))
417 (bw-balance-sub wt w h)))))
418
419(defun bw-adjust-window (window delta horizontal)
420 "Wrapper around `adjust-window-trailing-edge' with error checking.
421Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
422 ;; `adjust-window-trailing-edge' may fail if delta is too large.
423 (while (>= (abs delta) 1)
424 (condition-case err
425 (progn
426 (adjust-window-trailing-edge window delta horizontal)
427 (setq delta 0))
428 (error
429 ;;(message "adjust: %s" (error-message-string err))
430 (setq delta (/ delta 2))))))
431
432(defun bw-balance-sub (wt w h)
433 (setq wt (bw-refresh-edges wt))
434 (unless w (setq w (- (bw-r wt) (bw-l wt))))
435 (unless h (setq h (- (bw-b wt) (bw-t wt))))
436 (if (windowp wt)
437 (progn
438 (when w
439 (let ((dw (- w (- (bw-r wt) (bw-l wt)))))
440 (when (/= 0 dw)
441 (bw-adjust-window wt dw t))))
442 (when h
443 (let ((dh (- h (- (bw-b wt) (bw-t wt)))))
444 (when (/= 0 dh)
445 (bw-adjust-window wt dh nil)))))
446 (let* ((childs (cdr (assq 'childs wt)))
447 (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1))))
448 (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1)))))
449 (dolist (c childs)
450 (bw-balance-sub c cw ch)))))
451
452(defun window-fixed-size-p (&optional window direction)
453 "Return t if WINDOW cannot be resized in DIRECTION.
454WINDOW defaults to the selected window. DIRECTION can be
455nil (i.e. any), `height' or `width'."
456 (with-current-buffer (window-buffer window)
457 (when (and (boundp 'window-size-fixed) window-size-fixed)
458 (not (and direction
459 (member (cons direction window-size-fixed)
460 '((height . width) (width . height))))))))
461
462;;; A different solution to balance-windows.
463
464(defvar window-area-factor 1
465 "Factor by which the window area should be over-estimated.
466This is used by `balance-windows-area'.
467Changing this globally has no effect.")
468(make-variable-buffer-local 'window-area-factor)
469
470(defun balance-windows-area ()
471 "Make all visible windows the same area (approximately).
472See also `window-area-factor' to change the relative size of
473specific buffers."
474 (interactive)
475 (let* ((unchanged 0) (carry 0) (round 0)
476 ;; Remove fixed-size windows.
477 (wins (delq nil (mapcar (lambda (win)
478 (if (not (window-fixed-size-p win)) win))
479 (window-list nil 'nomini))))
480 (changelog nil)
481 next)
482 ;; Resizing a window changes the size of surrounding windows in complex
483 ;; ways, so it's difficult to balance them all. The introduction of
484 ;; `adjust-window-trailing-edge' made it a bit easier, but it is still
485 ;; very difficult to do. `balance-window' above takes an off-line
486 ;; approach: get the whole window tree, then balance it, then try to
487 ;; adjust the windows so they fit the result.
488 ;; Here, instead, we take a "local optimization" approach, where we just
489 ;; go through all the windows several times until nothing needs to be
490 ;; changed. The main problem with this approach is that it's difficult
491 ;; to make sure it terminates, so we use some heuristic to try and break
492 ;; off infinite loops.
493 ;; After a round without any change, we allow a second, to give a chance
494 ;; to the carry to propagate a minor imbalance from the end back to
495 ;; the beginning.
496 (while (< unchanged 2)
497 ;; (message "New round")
498 (setq unchanged (1+ unchanged) round (1+ round))
499 (dolist (win wins)
500 (setq next win)
501 (while (progn (setq next (next-window next))
502 (window-fixed-size-p next)))
503 ;; (assert (eq next (or (cadr (member win wins)) (car wins))))
504 (let* ((horiz
505 (< (car (window-edges win)) (car (window-edges next))))
506 (areadiff (/ (- (* (window-height next) (window-width next)
507 (buffer-local-value 'window-area-factor
508 (window-buffer next)))
509 (* (window-height win) (window-width win)
510 (buffer-local-value 'window-area-factor
511 (window-buffer win))))
512 (max (buffer-local-value 'window-area-factor
513 (window-buffer win))
514 (buffer-local-value 'window-area-factor
515 (window-buffer next)))))
516 (edgesize (if horiz
517 (+ (window-height win) (window-height next))
518 (+ (window-width win) (window-width next))))
519 (diff (/ areadiff edgesize)))
520 (when (zerop diff)
521 ;; Maybe diff is actually closer to 1 than to 0.
522 (setq diff (/ (* 3 areadiff) (* 2 edgesize))))
523 (when (and (zerop diff) (not (zerop areadiff)))
524 (setq diff (/ (+ areadiff carry) edgesize))
525 ;; Change things smoothly.
526 (if (or (> diff 1) (< diff -1)) (setq diff (/ diff 2))))
527 (if (zerop diff)
528 ;; Make sure negligible differences don't accumulate to
529 ;; become significant.
530 (setq carry (+ carry areadiff))
531 (bw-adjust-window win diff horiz)
532 ;; (sit-for 0.5)
533 (let ((change (cons win (window-edges win))))
534 ;; If the same change has been seen already for this window,
535 ;; we're most likely in an endless loop, so don't count it as
536 ;; a change.
537 (unless (member change changelog)
538 (push change changelog)
539 (setq unchanged 0 carry 0)))))))
540 ;; We've now basically balanced all the windows.
541 ;; But there may be some minor off-by-one imbalance left over,
542 ;; so let's do some fine tuning.
543 ;; (bw-finetune wins)
544 ;; (message "Done in %d rounds" round)
545 ))
546
547\f
548(defcustom display-buffer-function nil
549 "If non-nil, function to call to handle `display-buffer'.
550It will receive two args, the buffer and a flag which if non-nil
551means that the currently selected window is not acceptable. It
552should choose or create a window, display the specified buffer in
553it, and return the window.
554
555Commands such as `switch-to-buffer-other-window' and
556`find-file-other-window' work using this function."
557 :type '(choice
558 (const nil)
559 (function :tag "function"))
560 :group 'windows)
561
56f31926
MR
562(defcustom special-display-buffer-names nil
563 "List of names of buffers that should be displayed specially.
564Displaying a buffer with `display-buffer' or `pop-to-buffer', if
565its name is in this list, displays the buffer in a way specified
566by `special-display-function'. `special-display-popup-frame'
567\(the default for `special-display-function') usually displays
568the buffer in a separate frame made with the parameters specified
569by `special-display-frame-alist'. If `special-display-function'
570has been set to some other function, that function is called with
571the buffer as first, and nil as second argument.
572
573Alternatively, an element of this list can be specified as
574\(BUFFER-NAME FRAME-PARAMETERS), where BUFFER-NAME is a buffer
575name and FRAME-PARAMETERS an alist of \(PARAMETER . VALUE) pairs.
576`special-display-popup-frame' will interpret such pairs as frame
577parameters when it creates a special frame, overriding the
578corresponding values from `special-display-frame-alist'.
579
580As a special case, if FRAME-PARAMETERS contains (same-window . t)
581`special-display-popup-frame' displays that buffer in the
582selected window. If FRAME-PARAMETERS contains (same-frame . t),
583it displays that buffer in a window on the selected frame.
584
585If `special-display-function' specifies some other function than
586`special-display-popup-frame', that function is called with the
587buffer named BUFFER-NAME as first, and FRAME-PARAMETERS as second
588argument.
589
590Finally, an element of this list can be also specified as
591\(BUFFER-NAME FUNCTION OTHER-ARGS). In that case,
592`special-display-popup-frame' will call FUNCTION with the buffer
593named BUFFER-NAME as first argument, and OTHER-ARGS as the
594second. If `special-display-function' specifies some other
595function, that function is called with the buffer named
596BUFFER-NAME as first, and the element's cdr as second argument.
597
598If this variable appears \"not to work\", because you added a
599name to it but the corresponding buffer is displayed in the
600selected window, look at the values of `same-window-buffer-names'
601and `same-window-regexps'. Those variables take precedence over
602this one.
603
604See also `special-display-regexps'."
605 :type '(repeat
606 (choice :tag "Buffer"
607 :value ""
608 (string :format "%v")
609 (cons :tag "With parameters"
610 :format "%v"
611 :value ("" . nil)
612 (string :format "%v")
613 (repeat :tag "Parameters"
614 (cons :format "%v"
615 (symbol :tag "Parameter")
616 (sexp :tag "Value"))))
617 (list :tag "With function"
618 :format "%v"
619 :value ("" . nil)
620 (string :format "%v")
621 (function :tag "Function")
622 (repeat :tag "Arguments" (sexp)))))
623 :group 'windows
624 :group 'frames)
625
ac549fa5
GM
626;;;###autoload
627(put 'special-display-buffer-names 'risky-local-variable t)
628
56f31926
MR
629(defcustom special-display-regexps nil
630 "List of regexps saying which buffers should be displayed specially.
631Displaying a buffer with `display-buffer' or `pop-to-buffer', if
632any regexp in this list matches its name, displays it specially
633using `special-display-function'. `special-display-popup-frame'
634\(the default for `special-display-function') usually displays
635the buffer in a separate frame made with the parameters specified
636by `special-display-frame-alist'. If `special-display-function'
637has been set to some other function, that function is called with
638the buffer as first, and nil as second argument.
639
640Alternatively, an element of this list can be specified as
641\(REGEXP FRAME-PARAMETERS), where REGEXP is a regexp as above and
642FRAME-PARAMETERS an alist of (PARAMETER . VALUE) pairs.
643`special-display-popup-frame' will then interpret these pairs as
644frame parameters when creating a special frame for a buffer whose
645name matches REGEXP, overriding the corresponding values from
646`special-display-frame-alist'.
647
648As a special case, if FRAME-PARAMETERS contains (same-window . t)
649`special-display-popup-frame' displays buffers matching REGEXP in
650the selected window. \(same-frame . t) in FRAME-PARAMETERS means
651to display such buffers in a window on the selected frame.
652
653If `special-display-function' specifies some other function than
654`special-display-popup-frame', that function is called with the
655buffer whose name matched REGEXP as first, and FRAME-PARAMETERS
656as second argument.
657
658Finally, an element of this list can be also specified as
659\(REGEXP FUNCTION OTHER-ARGS). `special-display-popup-frame'
660will then call FUNCTION with the buffer whose name matched
661REGEXP as first, and OTHER-ARGS as second argument. If
662`special-display-function' specifies some other function, that
663function is called with the buffer whose name matched REGEXP
664as first, and the element's cdr as second argument.
665
666If this variable appears \"not to work\", because you added a
667name to it but the corresponding buffer is displayed in the
668selected window, look at the values of `same-window-buffer-names'
669and `same-window-regexps'. Those variables take precedence over
670this one.
671
672See also `special-display-buffer-names'."
673 :type '(repeat
674 (choice :tag "Buffer"
675 :value ""
676 (regexp :format "%v")
677 (cons :tag "With parameters"
678 :format "%v"
679 :value ("" . nil)
680 (regexp :format "%v")
681 (repeat :tag "Parameters"
682 (cons :format "%v"
683 (symbol :tag "Parameter")
684 (sexp :tag "Value"))))
685 (list :tag "With function"
686 :format "%v"
687 :value ("" . nil)
688 (regexp :format "%v")
689 (function :tag "Function")
690 (repeat :tag "Arguments" (sexp)))))
691 :group 'windows
692 :group 'frames)
693
3c448ab6
MR
694(defun special-display-p (buffer-name)
695 "Return non-nil if a buffer named BUFFER-NAME gets a special frame.
56f31926
MR
696More precisely, return t if `special-display-buffer-names' or
697`special-display-regexps' contain a string entry equaling or
698matching BUFFER-NAME. If `special-display-buffer-names' or
699`special-display-regexps' contain a list entry whose car equals
700or matches BUFFER-NAME, the return value is the cdr of that
701entry."
98722073
MR
702 (let (tmp)
703 (cond
704 ((not (stringp buffer-name)))
705 ((member buffer-name special-display-buffer-names)
706 t)
707 ((setq tmp (assoc buffer-name special-display-buffer-names))
708 (cdr tmp))
709 ((catch 'found
710 (dolist (regexp special-display-regexps)
711 (cond
712 ((stringp regexp)
713 (when (string-match-p regexp buffer-name)
714 (throw 'found t)))
715 ((and (consp regexp) (stringp (car regexp))
716 (string-match-p (car regexp) buffer-name))
717 (throw 'found (cdr regexp))))))))))
3c448ab6
MR
718
719(defcustom special-display-function 'special-display-popup-frame
56f31926
MR
720 "Function to call for displaying special buffers.
721This function is called with two arguments - the buffer and,
722optionally, a list - and should return a window displaying that
723buffer. The default value usually makes a separate frame for the
724buffer using `special-display-frame-alist' to specify the frame
725parameters. See the definition of `special-display-popup-frame'
726for how to specify such a function.
727
728A buffer is special when its name is either listed in
3c448ab6
MR
729`special-display-buffer-names' or matches a regexp in
730`special-display-regexps'."
731 :type 'function
732 :group 'frames)
733
3c448ab6
MR
734(defcustom same-window-buffer-names nil
735 "List of names of buffers that should appear in the \"same\" window.
736`display-buffer' and `pop-to-buffer' show a buffer whose name is
737on this list in the selected rather than some other window.
738
739An element of this list can be a cons cell instead of just a
56f31926
MR
740string. In that case, the cell's car must be a string specifying
741the buffer name. This is for compatibility with
3c448ab6
MR
742`special-display-buffer-names'; the cdr of the cons cell is
743ignored.
744
745See also `same-window-regexps'."
746 :type '(repeat (string :format "%v"))
747 :group 'windows)
748
749(defcustom same-window-regexps nil
750 "List of regexps saying which buffers should appear in the \"same\" window.
751`display-buffer' and `pop-to-buffer' show a buffer whose name
752matches a regexp on this list in the selected rather than some
753other window.
754
755An element of this list can be a cons cell instead of just a
56f31926 756string. In that case, the cell's car must be a regexp matching
3c448ab6 757the buffer name. This is for compatibility with
56f31926 758`special-display-regexps'; the cdr of the cons cell is ignored.
3c448ab6
MR
759
760See also `same-window-buffer-names'."
761 :type '(repeat (regexp :format "%v"))
762 :group 'windows)
763
56f31926
MR
764(defun same-window-p (buffer-name)
765 "Return non-nil if a buffer named BUFFER-NAME would be shown in the \"same\" window.
766This function returns non-nil if `display-buffer' or
767`pop-to-buffer' would show a buffer named BUFFER-NAME in the
768selected rather than \(as usual\) some other window. See
769`same-window-buffer-names' and `same-window-regexps'."
770 (cond
771 ((not (stringp buffer-name)))
772 ;; The elements of `same-window-buffer-names' can be buffer
773 ;; names or cons cells whose cars are buffer names.
774 ((member buffer-name same-window-buffer-names))
775 ((assoc buffer-name same-window-buffer-names))
776 ((catch 'found
777 (dolist (regexp same-window-regexps)
778 ;; The elements of `same-window-regexps' can be regexps
779 ;; or cons cells whose cars are regexps.
780 (when (or (and (stringp regexp)
781 (string-match regexp buffer-name))
782 (and (consp regexp) (stringp (car regexp))
783 (string-match-p (car regexp) buffer-name)))
784 (throw 'found t)))))))
785
3c448ab6
MR
786(defcustom pop-up-frames nil
787 "Whether `display-buffer' should make a separate frame.
788If nil, never make a seperate frame.
789If the value is `graphic-only', make a separate frame
790on graphic displays only.
791Any other non-nil value means always make a separate frame."
792 :type '(choice
793 (const :tag "Never" nil)
794 (const :tag "On graphic displays only" graphic-only)
795 (const :tag "Always" t))
796 :group 'windows)
797
798(defcustom display-buffer-reuse-frames nil
799 "Non-nil means `display-buffer' should reuse frames.
800If the buffer in question is already displayed in a frame, raise
801that frame."
802 :type 'boolean
803 :version "21.1"
804 :group 'windows)
805
806(defcustom pop-up-windows t
807 "Non-nil means `display-buffer' should make a new window."
808 :type 'boolean
809 :group 'windows)
810
8b10a2d1
MR
811(defcustom split-window-preferred-function 'split-window-sensibly
812 "Function called by `display-buffer' routines to split a window.
813This function is called with a window as single argument and is
814supposed to split that window and return the new window. If the
815window can (or shall) not be split, it is supposed to return nil.
816The default is to call the function `split-window-sensibly' which
817tries to split the window in a way which seems most suitable.
818You can customize the options `split-height-threshold' and/or
819`split-width-threshold' in order to have `split-window-sensibly'
820prefer either vertical or horizontal splitting.
821
822If you set this to any other function, bear in mind that the
823`display-buffer' routines may call this function two times. The
824argument of the first call is the largest window on its frame.
825If that call fails to return a live window, the function is
826called again with the least recently used window as argument. If
827that call fails too, `display-buffer' will use an existing window
828to display its buffer.
829
830The window selected at the time `display-buffer' was invoked is
831still selected when this function is called. Hence you can
832compare the window argument with the value of `selected-window'
833if you intend to split the selected window instead or if you do
834not want to split the selected window."
835 :type 'function
3c448ab6
MR
836 :version "23.1"
837 :group 'windows)
838
8b10a2d1
MR
839(defcustom split-height-threshold 80
840 "Minimum height for splitting windows sensibly.
841If this is an integer, `split-window-sensibly' may split a window
842vertically only if it has at least this many lines. If this is
843nil, `split-window-sensibly' is not allowed to split a window
844vertically. If, however, a window is the only window on its
845frame, `split-window-sensibly' may split it vertically
846disregarding the value of this variable."
847 :type '(choice (const nil) (integer :tag "lines"))
3c448ab6
MR
848 :version "23.1"
849 :group 'windows)
850
8b10a2d1
MR
851(defcustom split-width-threshold 160
852 "Minimum width for splitting windows sensibly.
853If this is an integer, `split-window-sensibly' may split a window
854horizontally only if it has at least this many columns. If this
855is nil, `split-window-sensibly' is not allowed to split a window
856horizontally."
857 :type '(choice (const nil) (integer :tag "columns"))
3c448ab6
MR
858 :version "23.1"
859 :group 'windows)
860
8b10a2d1
MR
861(defun window-splittable-p (window &optional horizontal)
862 "Return non-nil if `split-window-sensibly' may split WINDOW.
863Optional argument HORIZONTAL nil or omitted means check whether
864`split-window-sensibly' may split WINDOW vertically. HORIZONTAL
865non-nil means check whether WINDOW may be split horizontally.
3c448ab6 866
8b10a2d1 867WINDOW may be split vertically when the following conditions
3c448ab6 868hold:
3c448ab6
MR
869- `window-size-fixed' is either nil or equals `width' for the
870 buffer of WINDOW.
8b10a2d1 871- `split-height-threshold' is an integer and WINDOW is at least as
3c448ab6 872 high as `split-height-threshold'.
3c448ab6
MR
873- When WINDOW is split evenly, the emanating windows are at least
874 `window-min-height' lines tall and can accommodate at least one
875 line plus - if WINDOW has one - a mode line.
876
8b10a2d1 877WINDOW may be split horizontally when the following conditions
3c448ab6 878hold:
3c448ab6
MR
879- `window-size-fixed' is either nil or equals `height' for the
880 buffer of WINDOW.
8b10a2d1 881- `split-width-threshold' is an integer and WINDOW is at least as
3c448ab6 882 wide as `split-width-threshold'.
3c448ab6
MR
883- When WINDOW is split evenly, the emanating windows are at least
884 `window-min-width' or two (whichever is larger) columns wide."
885 (when (window-live-p window)
886 (with-current-buffer (window-buffer window)
887 (if horizontal
888 ;; A window can be split horizontally when its width is not
889 ;; fixed, it is at least `split-width-threshold' columns wide
890 ;; and at least twice as wide as `window-min-width' and 2 (the
891 ;; latter value is hardcoded).
892 (and (memq window-size-fixed '(nil height))
893 ;; Testing `window-full-width-p' here hardly makes any
894 ;; sense nowadays. This can be done more intuitively by
895 ;; setting up `split-width-threshold' appropriately.
896 (numberp split-width-threshold)
897 (>= (window-width window)
898 (max split-width-threshold
899 (* 2 (max window-min-width 2)))))
900 ;; A window can be split vertically when its height is not
901 ;; fixed, it is at least `split-height-threshold' lines high,
902 ;; and it is at least twice as high as `window-min-height' and 2
903 ;; if it has a modeline or 1.
904 (and (memq window-size-fixed '(nil width))
905 (numberp split-height-threshold)
906 (>= (window-height window)
907 (max split-height-threshold
908 (* 2 (max window-min-height
909 (if mode-line-format 2 1))))))))))
910
8b10a2d1
MR
911(defun split-window-sensibly (window)
912 "Split WINDOW in a way suitable for `display-buffer'.
913If `split-height-threshold' specifies an integer, WINDOW is at
914least `split-height-threshold' lines tall and can be split
915vertically, split WINDOW into two windows one above the other and
916return the lower window. Otherwise, if `split-width-threshold'
917specifies an integer, WINDOW is at least `split-width-threshold'
918columns wide and can be split horizontally, split WINDOW into two
919windows side by side and return the window on the right. If this
920can't be done either and WINDOW is the only window on its frame,
921try to split WINDOW vertically disregarding any value specified
922by `split-height-threshold'. If that succeeds, return the lower
923window. Return nil otherwise.
924
925By default `display-buffer' routines call this function to split
926the largest or least recently used window. To change the default
927customize the option `split-window-preferred-function'.
928
929You can enforce this function to not split WINDOW horizontally,
930by setting \(or binding) the variable `split-width-threshold' to
931nil. If, in addition, you set `split-height-threshold' to zero,
932chances increase that this function does split WINDOW vertically.
933
934In order to not split WINDOW vertically, set \(or bind) the
935variable `split-height-threshold' to nil. Additionally, you can
936set `split-width-threshold' to zero to make a horizontal split
937more likely to occur.
938
939Have a look at the function `window-splittable-p' if you want to
940know how `split-window-sensibly' determines whether WINDOW can be
941split."
942 (or (and (window-splittable-p window)
943 ;; Split window vertically.
944 (with-selected-window window
945 (split-window-vertically)))
946 (and (window-splittable-p window t)
947 ;; Split window horizontally.
948 (with-selected-window window
949 (split-window-horizontally)))
950 (and (eq window (frame-root-window (window-frame window)))
951 (not (window-minibuffer-p window))
952 ;; If WINDOW is the only window on its frame and is not the
953 ;; minibuffer window, try to split it vertically disregarding
954 ;; the value of `split-height-threshold'.
955 (let ((split-height-threshold 0))
956 (when (window-splittable-p window)
957 (with-selected-window window
958 (split-window-vertically)))))))
959
3c448ab6 960(defun window--try-to-split-window (window)
8b10a2d1
MR
961 "Try to split WINDOW.
962Return value returned by `split-window-preferred-function' if it
963represents a live window, nil otherwise."
964 (and (window-live-p window)
965 (not (frame-parameter (window-frame window) 'unsplittable))
966 (let ((new-window
967 ;; Since `split-window-preferred-function' might
968 ;; throw an error use `condition-case'.
969 (condition-case nil
970 (funcall split-window-preferred-function window)
971 (error nil))))
972 (and (window-live-p new-window) new-window))))
3c448ab6
MR
973
974(defun window--frame-usable-p (frame)
975 "Return FRAME if it can be used to display a buffer."
976 (when (frame-live-p frame)
977 (let ((window (frame-root-window frame)))
978 ;; `frame-root-window' may be an internal window which is considered
979 ;; "dead" by `window-live-p'. Hence if `window' is not live we
980 ;; implicitly know that `frame' has a visible window we can use.
4afba819
SM
981 (unless (and (window-live-p window)
982 (or (window-minibuffer-p window)
983 ;; If the window is soft-dedicated, the frame is usable.
064e57de
SM
984 ;; Actually, even if the window is really dedicated,
985 ;; the frame is still usable by splitting it.
986 ;; At least Emacs-22 allowed it, and it is desirable
987 ;; when displaying same-frame windows.
988 nil ; (eq t (window-dedicated-p window))
989 ))
3c448ab6
MR
990 frame))))
991
992(defcustom even-window-heights t
993 "If non-nil `display-buffer' will try to even window heights.
994Otherwise `display-buffer' will leave the window configuration
995alone. Heights are evened only when `display-buffer' chooses a
996window that appears above or below the selected window."
997 :type 'boolean
998 :group 'windows)
999
1000(defun window--even-window-heights (window)
1001 "Even heights of WINDOW and selected window.
1002Do this only if these windows are vertically adjacent to each
1003other, `even-window-heights' is non-nil, and the selected window
1004is higher than WINDOW."
1005 (when (and even-window-heights
1006 (not (eq window (selected-window)))
1007 ;; Don't resize minibuffer windows.
1008 (not (window-minibuffer-p (selected-window)))
1009 (> (window-height (selected-window)) (window-height window))
1010 (eq (window-frame window) (window-frame (selected-window)))
1011 (let ((sel-edges (window-edges (selected-window)))
1012 (win-edges (window-edges window)))
1013 (and (= (nth 0 sel-edges) (nth 0 win-edges))
1014 (= (nth 2 sel-edges) (nth 2 win-edges))
1015 (or (= (nth 1 sel-edges) (nth 3 win-edges))
1016 (= (nth 3 sel-edges) (nth 1 win-edges))))))
1017 (let ((window-min-height 1))
1018 ;; Don't throw an error if we can't even window heights for
1019 ;; whatever reason.
1020 (condition-case nil
1021 (enlarge-window (/ (- (window-height window) (window-height)) 2))
1022 (error nil)))))
1023
1024(defun window--display-buffer-1 (window)
1025 "Raise the frame containing WINDOW.
1026Do not raise the selected frame. Return WINDOW."
1027 (let* ((frame (window-frame window))
1028 (visible (frame-visible-p frame)))
1029 (unless (or (not visible)
1030 ;; Assume the selected frame is already visible enough.
1031 (eq frame (selected-frame))
1032 ;; Assume the frame from which we invoked the minibuffer
1033 ;; is visible.
1034 (and (minibuffer-window-active-p (selected-window))
1035 (eq frame (window-frame (minibuffer-selected-window)))))
1036 (raise-frame frame))
1037 window))
1038
04ae543a 1039(defun window--display-buffer-2 (buffer window &optional dedicated)
3c448ab6 1040 "Display BUFFER in WINDOW and make its frame visible.
04ae543a 1041Set `window-dedicated-p' to DEDICATED if non-nil.
3c448ab6
MR
1042Return WINDOW."
1043 (when (and (buffer-live-p buffer) (window-live-p window))
1044 (set-window-buffer window buffer)
04ae543a 1045 (when dedicated
782d6e30 1046 (set-window-dedicated-p window dedicated))
3c448ab6
MR
1047 (window--display-buffer-1 window)))
1048
d2c9fc42
SM
1049(defvar display-buffer-mark-dedicated nil
1050 "If non-nil, `display-buffer' marks the windows it creates as dedicated.
1051The actual non-nil value of this variable will be copied to the
1052`window-dedicated-p' flag.")
1053
3c448ab6
MR
1054(defun display-buffer (buffer-or-name &optional not-this-window frame)
1055 "Make buffer BUFFER-OR-NAME appear in some window but don't select it.
1056BUFFER-OR-NAME must be a buffer or the name of an existing
1057buffer. Return the window chosen to display BUFFER-OR-NAME or
1058nil if no such window is found.
1059
1060Optional argument NOT-THIS-WINDOW non-nil means display the
1061buffer in a window other than the selected one, even if it is
1062already displayed in the selected window.
1063
1064Optional argument FRAME specifies which frames to investigate
1065when the specified buffer is already displayed. If the buffer is
1066already displayed in some window on one of these frames simply
1067return that window. Possible values of FRAME are:
1068
1069`visible' - consider windows on all visible frames.
1070
10710 - consider windows on all visible or iconified frames.
1072
1073t - consider windows on all frames.
1074
1075A specific frame - consider windows on that frame only.
1076
1077nil - consider windows on the selected frame \(actually the
1078last non-minibuffer frame\) only. If, however, either
1079`display-buffer-reuse-frames' or `pop-up-frames' is non-nil
1080\(non-nil and not graphic-only on a text-only terminal),
1081consider all visible or iconified frames."
1082 (interactive "BDisplay buffer:\nP")
1083 (let* ((can-use-selected-window
1084 ;; The selected window is usable unless either NOT-THIS-WINDOW
1085 ;; is non-nil, it is dedicated to its buffer, or it is the
1086 ;; `minibuffer-window'.
1087 (not (or not-this-window
1088 (window-dedicated-p (selected-window))
1089 (window-minibuffer-p))))
1090 (buffer (if (bufferp buffer-or-name)
1091 buffer-or-name
1092 (get-buffer buffer-or-name)))
1093 (name-of-buffer (buffer-name buffer))
1094 ;; On text-only terminals do not pop up a new frame when
1095 ;; `pop-up-frames' equals graphic-only.
1096 (use-pop-up-frames (if (eq pop-up-frames 'graphic-only)
1097 (display-graphic-p)
1098 pop-up-frames))
1099 ;; `frame-to-use' is the frame where to show `buffer' - either
1100 ;; the selected frame or the last nonminibuffer frame.
1101 (frame-to-use
1102 (or (window--frame-usable-p (selected-frame))
1103 (window--frame-usable-p (last-nonminibuffer-frame))))
1104 ;; `window-to-use' is the window we use for showing `buffer'.
1105 window-to-use)
1106 (cond
1107 ((not (buffer-live-p buffer))
1108 (error "No such buffer %s" buffer))
1109 (display-buffer-function
1110 ;; Let `display-buffer-function' do the job.
1111 (funcall display-buffer-function buffer not-this-window))
1112 ((and (not not-this-window)
1113 (eq (window-buffer (selected-window)) buffer))
1114 ;; The selected window already displays BUFFER and
1115 ;; `not-this-window' is nil, so use it.
1116 (window--display-buffer-1 (selected-window)))
1117 ((and can-use-selected-window (same-window-p name-of-buffer))
1118 ;; If the buffer's name tells us to use the selected window do so.
1119 (window--display-buffer-2 buffer (selected-window)))
1120 ((let ((frames (or frame
1121 (and (or use-pop-up-frames
1122 display-buffer-reuse-frames
1123 (not (last-nonminibuffer-frame)))
1124 0)
1125 (last-nonminibuffer-frame))))
e331bbf3
MR
1126 (setq window-to-use
1127 (catch 'found
29c45500
MR
1128 ;; Search frames for a window displaying BUFFER. Return
1129 ;; the selected window only if we are allowed to do so.
1130 (dolist (window (get-buffer-window-list buffer 'nomini frames))
e331bbf3
MR
1131 (when (or can-use-selected-window
1132 (not (eq (selected-window) window)))
1133 (throw 'found window))))))
1134 ;; The buffer is already displayed in some window; use that.
3c448ab6
MR
1135 (window--display-buffer-1 window-to-use))
1136 ((and special-display-function
1137 ;; `special-display-p' returns either t or a list of frame
1138 ;; parameters to pass to `special-display-function'.
1139 (let ((pars (special-display-p name-of-buffer)))
1140 (when pars
1141 (funcall special-display-function
1142 buffer (if (listp pars) pars))))))
1143 ((or use-pop-up-frames (not frame-to-use))
1144 ;; We want or need a new frame.
d2c9fc42 1145 (let ((win (frame-selected-window (funcall pop-up-frame-function))))
04ae543a 1146 (window--display-buffer-2 buffer win display-buffer-mark-dedicated)))
3c448ab6
MR
1147 ((and pop-up-windows
1148 ;; Make a new window.
1149 (or (not (frame-parameter frame-to-use 'unsplittable))
1150 ;; If the selected frame cannot be split look at
1151 ;; `last-nonminibuffer-frame'.
1152 (and (eq frame-to-use (selected-frame))
1153 (setq frame-to-use (last-nonminibuffer-frame))
1154 (window--frame-usable-p frame-to-use)
1155 (not (frame-parameter frame-to-use 'unsplittable))))
1156 ;; Attempt to split largest or least recently used window.
1157 (setq window-to-use
1158 (or (window--try-to-split-window
1159 (get-largest-window frame-to-use t))
1160 (window--try-to-split-window
d2c9fc42 1161 (get-lru-window frame-to-use t)))))
04ae543a
SM
1162 (window--display-buffer-2 buffer window-to-use
1163 display-buffer-mark-dedicated))
a9d451f0
MR
1164 ((let ((window-to-undedicate
1165 ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate
1166 ;; the selected window to its buffer, to avoid that some of
1167 ;; the `get-' routines below choose it. (Bug#1415)
1168 (and not-this-window (not (window-dedicated-p))
1169 (set-window-dedicated-p (selected-window) t)
1170 (selected-window))))
1171 (unwind-protect
1172 (setq window-to-use
1173 ;; Reuse an existing window.
1174 (or (get-lru-window frame-to-use)
1175 (let ((window (get-buffer-window buffer 'visible)))
1176 (unless (and not-this-window
1177 (eq window (selected-window)))
1178 window))
1179 (get-largest-window 'visible)
1180 (let ((window (get-buffer-window buffer 0)))
1181 (unless (and not-this-window
1182 (eq window (selected-window)))
1183 window))
1184 (get-largest-window 0)
1185 (frame-selected-window (funcall pop-up-frame-function))))
1186 (when (window-live-p window-to-undedicate)
1187 ;; Restore dedicated status of selected window.
1188 (set-window-dedicated-p window-to-undedicate nil))))
3c448ab6
MR
1189 (window--even-window-heights window-to-use)
1190 (window--display-buffer-2 buffer window-to-use)))))
1191
1192(defun pop-to-buffer (buffer-or-name &optional other-window norecord)
1193 "Select buffer BUFFER-OR-NAME in some window, preferably a different one.
1194BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
1195nil. If BUFFER-OR-NAME is a string not naming an existent
1196buffer, create a buffer with that name. If BUFFER-OR-NAME is
1197nil, choose some other buffer.
1198
1199If `pop-up-windows' is non-nil, windows can be split to display
1200the buffer. If optional second arg OTHER-WINDOW is non-nil,
1201insist on finding another window even if the specified buffer is
1202already visible in the selected window, and ignore
1203`same-window-regexps' and `same-window-buffer-names'.
1204
1205If the window to show BUFFER-OR-NAME is not on the selected
1206frame, raise that window's frame and give it input focus.
1207
1208This function returns the buffer it switched to. This uses the
1209function `display-buffer' as a subroutine; see the documentation
1210of `display-buffer' for additional customization information.
1211
1212Optional third arg NORECORD non-nil means do not put this buffer
1213at the front of the list of recently selected ones."
1214 (let ((buffer
1215 ;; FIXME: This behavior is carried over from the previous C version
1216 ;; of pop-to-buffer, but really we should use just
1217 ;; `get-buffer' here.
1218 (if (null buffer-or-name) (other-buffer (current-buffer))
1219 (or (get-buffer buffer-or-name)
1220 (let ((buf (get-buffer-create buffer-or-name)))
1221 (set-buffer-major-mode buf)
1222 buf))))
1223 (old-window (selected-window))
1224 (old-frame (selected-frame))
1225 new-window new-frame)
1226 (set-buffer buffer)
1227 (setq new-window (display-buffer buffer other-window))
1228 (unless (eq new-window old-window)
1229 ;; `display-buffer' has chosen another window, select it.
1230 (select-window new-window norecord)
1231 (setq new-frame (window-frame new-window))
1232 (unless (eq new-frame old-frame)
1233 ;; `display-buffer' has chosen another frame, make sure it gets
1234 ;; input focus and is risen.
1235 (select-frame-set-input-focus new-frame)))
1236 buffer))
1237
1238;; I think this should be the default; I think people will prefer it--rms.
1239(defcustom split-window-keep-point t
1240 "If non-nil, \\[split-window-vertically] keeps the original point \
1241in both children.
1242This is often more convenient for editing.
1243If nil, adjust point in each of the two windows to minimize redisplay.
1244This is convenient on slow terminals, but point can move strangely.
1245
1246This option applies only to `split-window-vertically' and
1247functions that call it. `split-window' always keeps the original
1248point in both children."
1249 :type 'boolean
1250 :group 'windows)
1251
1252(defun split-window-vertically (&optional size)
1253 "Split selected window into two windows, one above the other.
1254The upper window gets SIZE lines and the lower one gets the rest.
1255SIZE negative means the lower window gets -SIZE lines and the
1256upper one the rest. With no argument, split windows equally or
1257close to it. Both windows display the same buffer, now current.
1258
1259If the variable `split-window-keep-point' is non-nil, both new
1260windows will get the same value of point as the selected window.
1261This is often more convenient for editing. The upper window is
1262the selected window.
1263
1264Otherwise, we choose window starts so as to minimize the amount of
1265redisplay; this is convenient on slow terminals. The new selected
1266window is the one that the current value of point appears in. The
1267value of point can change if the text around point is hidden by the
1268new mode line.
1269
1270Regardless of the value of `split-window-keep-point', the upper
1271window is the original one and the return value is the new, lower
1272window."
1273 (interactive "P")
1274 (let ((old-window (selected-window))
1275 (old-point (point))
1276 (size (and size (prefix-numeric-value size)))
1277 moved-by-window-height moved new-window bottom)
1278 (and size (< size 0)
1279 ;; Handle negative SIZE value.
1280 (setq size (+ (window-height) size)))
1281 (setq new-window (split-window nil size))
1282 (unless split-window-keep-point
7fdbcd83 1283 (with-current-buffer (window-buffer)
3c448ab6
MR
1284 (goto-char (window-start))
1285 (setq moved (vertical-motion (window-height)))
1286 (set-window-start new-window (point))
1287 (when (> (point) (window-point new-window))
1288 (set-window-point new-window (point)))
1289 (when (= moved (window-height))
1290 (setq moved-by-window-height t)
1291 (vertical-motion -1))
1292 (setq bottom (point)))
1293 (and moved-by-window-height
1294 (<= bottom (point))
1295 (set-window-point old-window (1- bottom)))
1296 (and moved-by-window-height
1297 (<= (window-start new-window) old-point)
1298 (set-window-point new-window old-point)
1299 (select-window new-window)))
1300 (split-window-save-restore-data new-window old-window)))
1301
1302;; This is to avoid compiler warnings.
1303(defvar view-return-to-alist)
1304
1305(defun split-window-save-restore-data (new-window old-window)
1306 (with-current-buffer (window-buffer)
1307 (when view-mode
1308 (let ((old-info (assq old-window view-return-to-alist)))
1309 (when old-info
1310 (push (cons new-window (cons (car (cdr old-info)) t))
1311 view-return-to-alist))))
1312 new-window))
1313
1314(defun split-window-horizontally (&optional size)
1315 "Split selected window into two windows side by side.
1316The selected window becomes the left one and gets SIZE columns.
1317SIZE negative means the right window gets -SIZE lines.
1318
1319SIZE includes the width of the window's scroll bar; if there are
1320no scroll bars, it includes the width of the divider column to
1321the window's right, if any. SIZE omitted or nil means split
1322window equally.
1323
1324The selected window remains selected. Return the new window."
1325 (interactive "P")
1326 (let ((old-window (selected-window))
1327 (size (and size (prefix-numeric-value size))))
1328 (and size (< size 0)
1329 ;; Handle negative SIZE value.
1330 (setq size (+ (window-width) size)))
1331 (split-window-save-restore-data (split-window nil size t) old-window)))
1332
1333\f
1334(defun set-window-text-height (window height)
9992ea0c 1335 "Set the height in lines of the text display area of WINDOW to HEIGHT.
3c448ab6
MR
1336HEIGHT doesn't include the mode line or header line, if any, or
1337any partial-height lines in the text display area.
1338
1339Note that the current implementation of this function cannot
1340always set the height exactly, but attempts to be conservative,
1341by allocating more lines than are actually needed in the case
1342where some error may be present."
1343 (let ((delta (- height (window-text-height window))))
1344 (unless (zerop delta)
1345 ;; Setting window-min-height to a value like 1 can lead to very
1346 ;; bizarre displays because it also allows Emacs to make *other*
1347 ;; windows 1-line tall, which means that there's no more space for
1348 ;; the modeline.
1349 (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
1350 (if (and window (not (eq window (selected-window))))
1351 (save-selected-window
1352 (select-window window 'norecord)
1353 (enlarge-window delta))
1354 (enlarge-window delta))))))
1355
1356\f
1357(defun enlarge-window-horizontally (columns)
1358 "Make selected window COLUMNS wider.
1359Interactively, if no argument is given, make selected window one
1360column wider."
1361 (interactive "p")
1362 (enlarge-window columns t))
1363
1364(defun shrink-window-horizontally (columns)
1365 "Make selected window COLUMNS narrower.
1366Interactively, if no argument is given, make selected window one
1367column narrower."
1368 (interactive "p")
1369 (shrink-window columns t))
1370
1371(defun window-buffer-height (window)
1372 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
1373 (with-current-buffer (window-buffer window)
1374 (max 1
1375 (count-screen-lines (point-min) (point-max)
1376 ;; If buffer ends with a newline, ignore it when
1377 ;; counting height unless point is after it.
1378 (eobp)
1379 window))))
1380
1381(defun count-screen-lines (&optional beg end count-final-newline window)
1382 "Return the number of screen lines in the region.
1383The number of screen lines may be different from the number of actual lines,
1384due to line breaking, display table, etc.
1385
1386Optional arguments BEG and END default to `point-min' and `point-max'
1387respectively.
1388
1389If region ends with a newline, ignore it unless optional third argument
1390COUNT-FINAL-NEWLINE is non-nil.
1391
1392The optional fourth argument WINDOW specifies the window used for obtaining
1393parameters such as width, horizontal scrolling, and so on. The default is
1394to use the selected window's parameters.
1395
1396Like `vertical-motion', `count-screen-lines' always uses the current buffer,
1397regardless of which buffer is displayed in WINDOW. This makes possible to use
1398`count-screen-lines' in any buffer, whether or not it is currently displayed
1399in some window."
1400 (unless beg
1401 (setq beg (point-min)))
1402 (unless end
1403 (setq end (point-max)))
1404 (if (= beg end)
1405 0
1406 (save-excursion
1407 (save-restriction
1408 (widen)
1409 (narrow-to-region (min beg end)
1410 (if (and (not count-final-newline)
1411 (= ?\n (char-before (max beg end))))
1412 (1- (max beg end))
1413 (max beg end)))
1414 (goto-char (point-min))
1415 (1+ (vertical-motion (buffer-size) window))))))
1416
1417(defun fit-window-to-buffer (&optional window max-height min-height)
1418 "Adjust height of WINDOW to display its buffer's contents exactly.
9adf1f06 1419WINDOW defaults to the selected window.
3c448ab6 1420Optional argument MAX-HEIGHT specifies the maximum height of the
f7baca20
MR
1421window and defaults to the maximum permissible height of a window
1422on WINDOW's frame.
3c448ab6
MR
1423Optional argument MIN-HEIGHT specifies the minimum height of the
1424window and defaults to `window-min-height'.
1425Both, MAX-HEIGHT and MIN-HEIGHT are specified in lines and
1426include the mode line and header line, if any.
3c448ab6 1427
9adf1f06
MR
1428Return non-nil if height was orderly adjusted, nil otherwise.
1429
f7baca20
MR
1430Caution: This function can delete WINDOW and/or other windows
1431when their height shrinks to less than MIN-HEIGHT."
1432 (interactive)
1433 ;; Do all the work in WINDOW and its buffer and restore the selected
1434 ;; window and the current buffer when we're done.
9adf1f06
MR
1435 (let ((old-buffer (current-buffer))
1436 value)
f7baca20
MR
1437 (with-selected-window (or window (setq window (selected-window)))
1438 (set-buffer (window-buffer))
1439 ;; Use `condition-case' to handle any fixed-size windows and other
1440 ;; pitfalls nearby.
1441 (condition-case nil
1442 (let* (;; MIN-HEIGHT must not be less than 1 and defaults to
1443 ;; `window-min-height'.
1444 (min-height (max (or min-height window-min-height) 1))
1445 (max-window-height
1446 ;; Maximum height of any window on this frame.
1447 (min (window-height (frame-root-window)) (frame-height)))
1448 ;; MAX-HEIGHT must not be larger than max-window-height and
1449 ;; defaults to max-window-height.
1450 (max-height
1451 (min (or max-height max-window-height) max-window-height))
1452 (desired-height
1453 ;; The height necessary to show all of WINDOW's buffer,
1454 ;; constrained by MIN-HEIGHT and MAX-HEIGHT.
1455 (max
1456 (min
1457 ;; For an empty buffer `count-screen-lines' returns zero.
1458 ;; Even in that case we need one line for the cursor.
1459 (+ (max (count-screen-lines) 1)
1460 ;; For non-minibuffers count the mode line, if any.
1461 (if (and (not (window-minibuffer-p)) mode-line-format)
1462 1 0)
1463 ;; Count the header line, if any.
1464 (if header-line-format 1 0))
1465 max-height)
1466 min-height))
1467 (delta
1468 ;; How much the window height has to change.
1469 (if (= (window-height) (window-height (frame-root-window)))
1470 ;; Don't try to resize a full-height window.
1471 0
1472 (- desired-height (window-height))))
1473 ;; Do something reasonable so `enlarge-window' can make
1474 ;; windows as small as MIN-HEIGHT.
1475 (window-min-height (min min-height window-min-height)))
1476 ;; Don't try to redisplay with the cursor at the end on its
1477 ;; own line--that would force a scroll and spoil things.
1478 (when (and (eobp) (bolp) (not (bobp)))
1479 (set-window-point window (1- (window-point))))
1480 ;; Adjust WINDOW's height to the nominally correct one
1481 ;; (which may actually be slightly off because of variable
1482 ;; height text, etc).
1483 (unless (zerop delta)
1484 (enlarge-window delta))
1485 ;; `enlarge-window' might have deleted WINDOW, so make sure
1486 ;; WINDOW's still alive for the remainder of this.
1487 ;; Note: Deleting WINDOW is clearly counter-intuitive in
1488 ;; this context, but we can't do much about it given the
1489 ;; current semantics of `enlarge-window'.
1490 (when (window-live-p window)
1491 ;; Check if the last line is surely fully visible. If
1492 ;; not, enlarge the window.
1493 (let ((end (save-excursion
1494 (goto-char (point-max))
1495 (when (and (bolp) (not (bobp)))
1496 ;; Don't include final newline.
1497 (backward-char 1))
1498 (when truncate-lines
1499 ;; If line-wrapping is turned off, test the
1500 ;; beginning of the last line for
1501 ;; visibility instead of the end, as the
1502 ;; end of the line could be invisible by
1503 ;; virtue of extending past the edge of the
1504 ;; window.
1505 (forward-line 0))
1506 (point))))
1507 (set-window-vscroll window 0)
1508 (while (and (< desired-height max-height)
1509 (= desired-height (window-height))
1510 (not (pos-visible-in-window-p end)))
1511 (enlarge-window 1)
9adf1f06
MR
1512 (setq desired-height (1+ desired-height))))
1513 ;; Return non-nil only if nothing "bad" happened.
1514 (setq value t)))
f7baca20
MR
1515 (error nil)))
1516 (when (buffer-live-p old-buffer)
9adf1f06
MR
1517 (set-buffer old-buffer))
1518 value))
3c448ab6
MR
1519
1520(defun window-safely-shrinkable-p (&optional window)
1521 "Return t if WINDOW can be shrunk without shrinking other windows.
1522WINDOW defaults to the selected window."
1523 (with-selected-window (or window (selected-window))
1524 (let ((edges (window-edges)))
1525 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
1526 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
1527
1528(defun shrink-window-if-larger-than-buffer (&optional window)
1529 "Shrink height of WINDOW if its buffer doesn't need so many lines.
1530More precisely, shrink WINDOW vertically to be as small as
1531possible, while still showing the full contents of its buffer.
1532WINDOW defaults to the selected window.
1533
1534Do not shrink to less than `window-min-height' lines. Do nothing
1535if the buffer contains more lines than the present window height,
1536or if some of the window's contents are scrolled out of view, or
1537if shrinking this window would also shrink another window, or if
1538the window is the only window of its frame.
1539
1540Return non-nil if the window was shrunk, nil otherwise."
1541 (interactive)
1542 (when (null window)
1543 (setq window (selected-window)))
1544 (let* ((frame (window-frame window))
1545 (mini (frame-parameter frame 'minibuffer))
1546 (edges (window-edges window)))
1547 (if (and (not (eq window (frame-root-window frame)))
1548 (window-safely-shrinkable-p window)
1549 (pos-visible-in-window-p (point-min) window)
1550 (not (eq mini 'only))
1551 (or (not mini)
1552 (let ((mini-window (minibuffer-window frame)))
1553 (or (null mini-window)
1554 (not (eq frame (window-frame mini-window)))
1555 (< (nth 3 edges)
1556 (nth 1 (window-edges mini-window)))
1557 (> (nth 1 edges)
1558 (frame-parameter frame 'menu-bar-lines))))))
1559 (fit-window-to-buffer window (window-height window)))))
1560
1561(defun kill-buffer-and-window ()
1562 "Kill the current buffer and delete the selected window."
1563 (interactive)
1564 (let ((window-to-delete (selected-window))
1565 (buffer-to-kill (current-buffer))
1566 (delete-window-hook (lambda ()
1567 (condition-case nil
1568 (delete-window)
1569 (error nil)))))
1570 (unwind-protect
1571 (progn
1572 (add-hook 'kill-buffer-hook delete-window-hook t t)
1573 (if (kill-buffer (current-buffer))
1574 ;; If `delete-window' failed before, we rerun it to regenerate
1575 ;; the error so it can be seen in the echo area.
1576 (when (eq (selected-window) window-to-delete)
1577 (delete-window))))
1578 ;; If the buffer is not dead for some reason (probably because
1579 ;; of a `quit' signal), remove the hook again.
1580 (condition-case nil
1581 (with-current-buffer buffer-to-kill
1582 (remove-hook 'kill-buffer-hook delete-window-hook t))
1583 (error nil)))))
1584
1585(defun quit-window (&optional kill window)
1586 "Quit WINDOW and bury its buffer.
1587With a prefix argument, kill the buffer instead. WINDOW defaults
1588to the selected window.
1589
1590If WINDOW is non-nil, dedicated, or a minibuffer window, delete
1591it and, if it's alone on its frame, its frame too. Otherwise, or
1592if deleting WINDOW fails in any of the preceding cases, display
1593another buffer in WINDOW using `switch-to-buffer'.
1594
1595Optional argument KILL non-nil means kill WINDOW's buffer.
1596Otherwise, bury WINDOW's buffer, see `bury-buffer'."
1597 (interactive "P")
1598 (let ((buffer (window-buffer window)))
1599 (if (or window
1600 (window-minibuffer-p window)
1601 (window-dedicated-p window))
1602 ;; WINDOW is either non-nil, a minibuffer window, or dedicated;
1603 ;; try to delete it.
a0c859f0
MR
1604 (let* ((window (or window (selected-window)))
1605 (frame (window-frame window)))
3c448ab6
MR
1606 (if (eq window (frame-root-window frame))
1607 ;; WINDOW is alone on its frame. `delete-windows-on'
1608 ;; knows how to handle that case.
1609 (delete-windows-on buffer frame)
1610 ;; There are other windows on its frame, delete WINDOW.
1611 (delete-window window)))
1612 ;; Otherwise, switch to another buffer in the selected window.
1613 (switch-to-buffer nil))
1614
1615 ;; Deal with the buffer.
1616 (if kill
1617 (kill-buffer buffer)
1618 (bury-buffer buffer))))
1619
1620(defvar recenter-last-op nil
1621 "Indicates the last recenter operation performed.
0116abbd
JL
1622Possible values: `top', `middle', `bottom', integer or float numbers.")
1623
1624(defcustom recenter-positions '(middle top bottom)
1625 "Cycling order for `recenter-top-bottom'.
1626A list of elements with possible values `top', `middle', `bottom',
1627integer or float numbers that define the cycling order for
1628the command `recenter-top-bottom'.
1629
1630Top and bottom destinations are `scroll-margin' lines the from true
1631window top and bottom. Middle redraws the frame and centers point
1632vertically within the window. Integer number moves current line to
1633the specified absolute window-line. Float number between 0.0 and 1.0
1634means the percentage of the screen space from the top. The default
1635cycling order is middle -> top -> bottom."
1636 :type '(repeat (choice
1637 (const :tag "Top" top)
1638 (const :tag "Middle" middle)
1639 (const :tag "Bottom" bottom)
1640 (integer :tag "Line number")
1641 (float :tag "Percentage")))
1642 :version "23.2"
1643 :group 'windows)
3c448ab6
MR
1644
1645(defun recenter-top-bottom (&optional arg)
0116abbd
JL
1646 "Move current buffer line to the specified window line.
1647With no prefix argument, successive calls place point according
1648to the cycling order defined by `recenter-positions'.
3c448ab6
MR
1649
1650A prefix argument is handled like `recenter':
1651 With numeric prefix ARG, move current line to window-line ARG.
0116abbd 1652 With plain `C-u', move current line to window center."
3c448ab6
MR
1653 (interactive "P")
1654 (cond
0116abbd 1655 (arg (recenter arg)) ; Always respect ARG.
3c448ab6 1656 (t
0116abbd
JL
1657 (setq recenter-last-op
1658 (if (eq this-command last-command)
1659 (car (or (cdr (member recenter-last-op recenter-positions))
1660 recenter-positions))
1661 (car recenter-positions)))
3c448ab6
MR
1662 (let ((this-scroll-margin
1663 (min (max 0 scroll-margin)
1664 (truncate (/ (window-body-height) 4.0)))))
1665 (cond ((eq recenter-last-op 'middle)
0116abbd 1666 (recenter))
3c448ab6 1667 ((eq recenter-last-op 'top)
0116abbd
JL
1668 (recenter this-scroll-margin))
1669 ((eq recenter-last-op 'bottom)
1670 (recenter (- -1 this-scroll-margin)))
1671 ((integerp recenter-last-op)
1672 (recenter recenter-last-op))
1673 ((floatp recenter-last-op)
1674 (recenter (round (* recenter-last-op (window-height))))))))))
3c448ab6
MR
1675
1676(define-key global-map [?\C-l] 'recenter-top-bottom)
216349f8 1677
216349f8
SM
1678(defun move-to-window-line-top-bottom (&optional arg)
1679 "Position point relative to window.
1680
0f202d5d 1681With a prefix argument ARG, acts like `move-to-window-line'.
216349f8
SM
1682
1683With no argument, positions point at center of window.
0116abbd
JL
1684Successive calls position point at positions defined
1685by `recenter-positions'."
216349f8
SM
1686 (interactive "P")
1687 (cond
0116abbd 1688 (arg (move-to-window-line arg)) ; Always respect ARG.
216349f8 1689 (t
0116abbd
JL
1690 (setq recenter-last-op
1691 (if (eq this-command last-command)
1692 (car (or (cdr (member recenter-last-op recenter-positions))
1693 recenter-positions))
1694 (car recenter-positions)))
216349f8
SM
1695 (let ((this-scroll-margin
1696 (min (max 0 scroll-margin)
1697 (truncate (/ (window-body-height) 4.0)))))
0f202d5d 1698 (cond ((eq recenter-last-op 'middle)
0116abbd 1699 (call-interactively 'move-to-window-line))
0f202d5d 1700 ((eq recenter-last-op 'top)
0116abbd
JL
1701 (move-to-window-line this-scroll-margin))
1702 ((eq recenter-last-op 'bottom)
1703 (move-to-window-line (- -1 this-scroll-margin)))
1704 ((integerp recenter-last-op)
1705 (move-to-window-line recenter-last-op))
1706 ((floatp recenter-last-op)
1707 (move-to-window-line (round (* recenter-last-op (window-height))))))))))
216349f8
SM
1708
1709(define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
1710
3c448ab6
MR
1711\f
1712(defvar mouse-autoselect-window-timer nil
1713 "Timer used by delayed window autoselection.")
1714
1715(defvar mouse-autoselect-window-position nil
1716 "Last mouse position recorded by delayed window autoselection.")
1717
1718(defvar mouse-autoselect-window-window nil
1719 "Last window recorded by delayed window autoselection.")
1720
1721(defvar mouse-autoselect-window-state nil
1722 "When non-nil, special state of delayed window autoselection.
1723Possible values are `suspend' \(suspend autoselection after a menu or
1724scrollbar interaction\) and `select' \(the next invocation of
1725'handle-select-window' shall select the window immediately\).")
1726
1727(defun mouse-autoselect-window-cancel (&optional force)
1728 "Cancel delayed window autoselection.
1729Optional argument FORCE means cancel unconditionally."
1730 (unless (and (not force)
1731 ;; Don't cancel for select-window or select-frame events
1732 ;; or when the user drags a scroll bar.
1733 (or (memq this-command
1734 '(handle-select-window handle-switch-frame))
1735 (and (eq this-command 'scroll-bar-toolkit-scroll)
1736 (memq (nth 4 (event-end last-input-event))
1737 '(handle end-scroll)))))
1738 (setq mouse-autoselect-window-state nil)
1739 (when (timerp mouse-autoselect-window-timer)
1740 (cancel-timer mouse-autoselect-window-timer))
1741 (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
1742
1743(defun mouse-autoselect-window-start (mouse-position &optional window suspend)
1744 "Start delayed window autoselection.
1745MOUSE-POSITION is the last position where the mouse was seen as returned
1746by `mouse-position'. Optional argument WINDOW non-nil denotes the
1747window where the mouse was seen. Optional argument SUSPEND non-nil
1748means suspend autoselection."
1749 ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
1750 (setq mouse-autoselect-window-position mouse-position)
1751 (when window (setq mouse-autoselect-window-window window))
1752 (setq mouse-autoselect-window-state (when suspend 'suspend))
1753 ;; Install timer which runs `mouse-autoselect-window-select' after
1754 ;; `mouse-autoselect-window' seconds.
1755 (setq mouse-autoselect-window-timer
1756 (run-at-time
1757 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
1758
1759(defun mouse-autoselect-window-select ()
1760 "Select window with delayed window autoselection.
1761If the mouse position has stabilized in a non-selected window, select
1762that window. The minibuffer window is selected only if the minibuffer is
1763active. This function is run by `mouse-autoselect-window-timer'."
1764 (condition-case nil
1765 (let* ((mouse-position (mouse-position))
1766 (window
1767 (condition-case nil
1768 (window-at (cadr mouse-position) (cddr mouse-position)
1769 (car mouse-position))
1770 (error nil))))
1771 (cond
1772 ((or (menu-or-popup-active-p)
1773 (and window
1774 (not (coordinates-in-window-p (cdr mouse-position) window))))
1775 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
1776 ;; of WINDOW, temporarily suspend delayed autoselection.
1777 (mouse-autoselect-window-start mouse-position nil t))
1778 ((eq mouse-autoselect-window-state 'suspend)
1779 ;; Delayed autoselection was temporarily suspended, reenable it.
1780 (mouse-autoselect-window-start mouse-position))
1781 ((and window (not (eq window (selected-window)))
1782 (or (not (numberp mouse-autoselect-window))
1783 (and (> mouse-autoselect-window 0)
1784 ;; If `mouse-autoselect-window' is positive, select
1785 ;; window if the window is the same as before.
1786 (eq window mouse-autoselect-window-window))
1787 ;; Otherwise select window if the mouse is at the same
1788 ;; position as before. Observe that the first test after
1789 ;; starting autoselection usually fails since the value of
1790 ;; `mouse-autoselect-window-position' recorded there is the
1791 ;; position where the mouse has entered the new window and
1792 ;; not necessarily where the mouse has stopped moving.
1793 (equal mouse-position mouse-autoselect-window-position))
1794 ;; The minibuffer is a candidate window if it's active.
1795 (or (not (window-minibuffer-p window))
1796 (eq window (active-minibuffer-window))))
1797 ;; Mouse position has stabilized in non-selected window: Cancel
1798 ;; delayed autoselection and try to select that window.
1799 (mouse-autoselect-window-cancel t)
1800 ;; Select window where mouse appears unless the selected window is the
1801 ;; minibuffer. Use `unread-command-events' in order to execute pre-
1802 ;; and post-command hooks and trigger idle timers. To avoid delaying
1803 ;; autoselection again, set `mouse-autoselect-window-state'."
1804 (unless (window-minibuffer-p (selected-window))
1805 (setq mouse-autoselect-window-state 'select)
1806 (setq unread-command-events
1807 (cons (list 'select-window (list window))
1808 unread-command-events))))
1809 ((or (and window (eq window (selected-window)))
1810 (not (numberp mouse-autoselect-window))
1811 (equal mouse-position mouse-autoselect-window-position))
1812 ;; Mouse position has either stabilized in the selected window or at
1813 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
1814 (mouse-autoselect-window-cancel t))
1815 (t
1816 ;; Mouse position has not stabilized yet, resume delayed
1817 ;; autoselection.
1818 (mouse-autoselect-window-start mouse-position window))))
1819 (error nil)))
1820
1821(defun handle-select-window (event)
1822 "Handle select-window events."
1823 (interactive "e")
1824 (let ((window (posn-window (event-start event))))
1825 (unless (or (not (window-live-p window))
1826 ;; Don't switch if we're currently in the minibuffer.
1827 ;; This tries to work around problems where the
1828 ;; minibuffer gets unselected unexpectedly, and where
1829 ;; you then have to move your mouse all the way down to
1830 ;; the minibuffer to select it.
1831 (window-minibuffer-p (selected-window))
1832 ;; Don't switch to minibuffer window unless it's active.
1833 (and (window-minibuffer-p window)
1834 (not (minibuffer-window-active-p window)))
1835 ;; Don't switch when autoselection shall be delayed.
1836 (and (numberp mouse-autoselect-window)
1837 (not (zerop mouse-autoselect-window))
1838 (not (eq mouse-autoselect-window-state 'select))
1839 (progn
1840 ;; Cancel any delayed autoselection.
1841 (mouse-autoselect-window-cancel t)
1842 ;; Start delayed autoselection from current mouse
1843 ;; position and window.
1844 (mouse-autoselect-window-start (mouse-position) window)
1845 ;; Executing a command cancels delayed autoselection.
1846 (add-hook
1847 'pre-command-hook 'mouse-autoselect-window-cancel))))
1848 (when mouse-autoselect-window
1849 ;; Reset state of delayed autoselection.
1850 (setq mouse-autoselect-window-state nil)
1851 ;; Run `mouse-leave-buffer-hook' when autoselecting window.
1852 (run-hooks 'mouse-leave-buffer-hook))
1853 (select-window window))))
1854
1855(defun delete-other-windows-vertically (&optional window)
1856 "Delete the windows in the same column with WINDOW, but not WINDOW itself.
1857This may be a useful alternative binding for \\[delete-other-windows]
1858 if you often split windows horizontally."
1859 (interactive)
1860 (let* ((window (or window (selected-window)))
1861 (edges (window-edges window))
1862 (w window) delenda)
1863 (while (not (eq (setq w (next-window w 1)) window))
1864 (let ((e (window-edges w)))
1865 (when (and (= (car e) (car edges))
1866 (= (caddr e) (caddr edges)))
1867 (push w delenda))))
1868 (mapc 'delete-window delenda)))
1869
1870(defun truncated-partial-width-window-p (&optional window)
1871 "Return non-nil if lines in WINDOW are specifically truncated due to its width.
1872WINDOW defaults to the selected window.
1873Return nil if WINDOW is not a partial-width window
1874 (regardless of the value of `truncate-lines').
1875Otherwise, consult the value of `truncate-partial-width-windows'
1876 for the buffer shown in WINDOW."
1877 (unless window
1878 (setq window (selected-window)))
1879 (unless (window-full-width-p window)
1880 (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
1881 (window-buffer window))))
1882 (if (integerp t-p-w-w)
1883 (< (window-width window) t-p-w-w)
1884 t-p-w-w))))
1885
1886(define-key ctl-x-map "2" 'split-window-vertically)
1887(define-key ctl-x-map "3" 'split-window-horizontally)
1888(define-key ctl-x-map "}" 'enlarge-window-horizontally)
1889(define-key ctl-x-map "{" 'shrink-window-horizontally)
1890(define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
1891(define-key ctl-x-map "+" 'balance-windows)
1892(define-key ctl-x-4-map "0" 'kill-buffer-and-window)
1893
1894;; arch-tag: b508dfcc-c353-4c37-89fa-e773fe10cea9
1895;;; window.el ends here