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