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