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