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