Merge from trunk
[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-1994, 2000-2011
4 ;; Free Software Foundation, Inc.
5
6 ;; Maintainer: FSF
7 ;; Keywords: internal
8 ;; Package: emacs
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 (declare (indent 0) (debug t))
58 `(let ((save-selected-window-window (selected-window))
59 ;; It is necessary to save all of these, because calling
60 ;; select-window changes frame-selected-window for whatever
61 ;; frame that window is in.
62 (save-selected-window-alist
63 (mapcar (lambda (frame) (cons frame (frame-selected-window frame)))
64 (frame-list))))
65 (save-current-buffer
66 (unwind-protect
67 (progn ,@body)
68 (dolist (elt save-selected-window-alist)
69 (and (frame-live-p (car elt))
70 (window-live-p (cdr elt))
71 (set-frame-selected-window (car elt) (cdr elt) 'norecord)))
72 (when (window-live-p save-selected-window-window)
73 (select-window save-selected-window-window 'norecord))))))
74
75 (defun window-body-height (&optional window)
76 "Return number of lines in WINDOW available for actual buffer text.
77 WINDOW defaults to the selected window.
78
79 The return value does not include the mode line or the header
80 line, if any. If a line at the bottom of the window is only
81 partially visible, that line is included in the return value.
82 If you do not want to include a partially visible bottom line
83 in the return value, use `window-text-height' instead."
84 (or window (setq window (selected-window)))
85 (if (window-minibuffer-p window)
86 (window-height window)
87 (with-current-buffer (window-buffer window)
88 (max 1 (- (window-height window)
89 (if mode-line-format 1 0)
90 (if header-line-format 1 0))))))
91
92 ;; See discussion in bug#4543.
93 (defun window-full-height-p (&optional window)
94 "Return non-nil if WINDOW is not the result of a vertical split.
95 WINDOW defaults to the selected window. (This function is not
96 appropriate for minibuffers.)"
97 (unless window
98 (setq window (selected-window)))
99 (= (window-height window)
100 (window-height (frame-root-window (window-frame window)))))
101
102 (defun one-window-p (&optional nomini all-frames)
103 "Return non-nil if the selected window is the only window.
104 Optional arg NOMINI non-nil means don't count the minibuffer
105 even if it is active. Otherwise, the minibuffer is counted
106 when it is active.
107
108 The optional arg ALL-FRAMES t means count windows on all frames.
109 If it is `visible', count windows on all visible frames on the
110 current terminal. ALL-FRAMES nil or omitted means count only the
111 selected frame, plus the minibuffer it uses (which may be on
112 another frame). ALL-FRAMES 0 means count all windows in all
113 visible or iconified frames on the current terminal. If
114 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 on the current terminal.
174 ALL-FRAMES 0 means cycle through all windows on all visible and
175 iconified frames on the current terminal.
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 on the current
1072 terminal.
1073
1074 0 - consider windows on all visible or iconified frames on the
1075 current terminal.
1076
1077 t - consider windows on all frames.
1078
1079 A specific frame - consider windows on that frame only.
1080
1081 nil - consider windows on the selected frame \(actually the
1082 last non-minibuffer frame\) only. If, however, either
1083 `display-buffer-reuse-frames' or `pop-up-frames' is non-nil
1084 \(non-nil and not graphic-only on a text-only terminal),
1085 consider all visible or iconified frames on the current terminal."
1086 (interactive "BDisplay buffer:\nP")
1087 (let* ((can-use-selected-window
1088 ;; The selected window is usable unless either NOT-THIS-WINDOW
1089 ;; is non-nil, it is dedicated to its buffer, or it is the
1090 ;; `minibuffer-window'.
1091 (not (or not-this-window
1092 (window-dedicated-p (selected-window))
1093 (window-minibuffer-p))))
1094 (buffer (if (bufferp buffer-or-name)
1095 buffer-or-name
1096 (get-buffer buffer-or-name)))
1097 (name-of-buffer (buffer-name buffer))
1098 ;; On text-only terminals do not pop up a new frame when
1099 ;; `pop-up-frames' equals graphic-only.
1100 (use-pop-up-frames (if (eq pop-up-frames 'graphic-only)
1101 (display-graphic-p)
1102 pop-up-frames))
1103 ;; `frame-to-use' is the frame where to show `buffer' - either
1104 ;; the selected frame or the last nonminibuffer frame.
1105 (frame-to-use
1106 (or (window--frame-usable-p (selected-frame))
1107 (window--frame-usable-p (last-nonminibuffer-frame))))
1108 ;; `window-to-use' is the window we use for showing `buffer'.
1109 window-to-use)
1110 (cond
1111 ((not (buffer-live-p buffer))
1112 (error "No such buffer %s" buffer))
1113 (display-buffer-function
1114 ;; Let `display-buffer-function' do the job.
1115 (funcall display-buffer-function buffer not-this-window))
1116 ((and (not not-this-window)
1117 (eq (window-buffer (selected-window)) buffer))
1118 ;; The selected window already displays BUFFER and
1119 ;; `not-this-window' is nil, so use it.
1120 (window--display-buffer-1 (selected-window)))
1121 ((and can-use-selected-window (same-window-p name-of-buffer))
1122 ;; If the buffer's name tells us to use the selected window do so.
1123 (window--display-buffer-2 buffer (selected-window)))
1124 ((let ((frames (or frame
1125 (and (or use-pop-up-frames
1126 display-buffer-reuse-frames
1127 (not (last-nonminibuffer-frame)))
1128 0)
1129 (last-nonminibuffer-frame))))
1130 (setq window-to-use
1131 (catch 'found
1132 ;; Search frames for a window displaying BUFFER. Return
1133 ;; the selected window only if we are allowed to do so.
1134 (dolist (window (get-buffer-window-list buffer 'nomini frames))
1135 (when (or can-use-selected-window
1136 (not (eq (selected-window) window)))
1137 (throw 'found window))))))
1138 ;; The buffer is already displayed in some window; use that.
1139 (window--display-buffer-1 window-to-use))
1140 ((and special-display-function
1141 ;; `special-display-p' returns either t or a list of frame
1142 ;; parameters to pass to `special-display-function'.
1143 (let ((pars (special-display-p name-of-buffer)))
1144 (when pars
1145 (funcall special-display-function
1146 buffer (if (listp pars) pars))))))
1147 ((or use-pop-up-frames (not frame-to-use))
1148 ;; We want or need a new frame.
1149 (let ((win (frame-selected-window (funcall pop-up-frame-function))))
1150 (window--display-buffer-2 buffer win display-buffer-mark-dedicated)))
1151 ((and pop-up-windows
1152 ;; Make a new window.
1153 (or (not (frame-parameter frame-to-use 'unsplittable))
1154 ;; If the selected frame cannot be split look at
1155 ;; `last-nonminibuffer-frame'.
1156 (and (eq frame-to-use (selected-frame))
1157 (setq frame-to-use (last-nonminibuffer-frame))
1158 (window--frame-usable-p frame-to-use)
1159 (not (frame-parameter frame-to-use 'unsplittable))))
1160 ;; Attempt to split largest or least recently used window.
1161 (setq window-to-use
1162 (or (window--try-to-split-window
1163 (get-largest-window frame-to-use t))
1164 (window--try-to-split-window
1165 (get-lru-window frame-to-use t)))))
1166 (window--display-buffer-2 buffer window-to-use
1167 display-buffer-mark-dedicated))
1168 ((let ((window-to-undedicate
1169 ;; When NOT-THIS-WINDOW is non-nil, temporarily dedicate
1170 ;; the selected window to its buffer, to avoid that some of
1171 ;; the `get-' routines below choose it. (Bug#1415)
1172 (and not-this-window (not (window-dedicated-p))
1173 (set-window-dedicated-p (selected-window) t)
1174 (selected-window))))
1175 (unwind-protect
1176 (setq window-to-use
1177 ;; Reuse an existing window.
1178 (or (get-lru-window frame-to-use)
1179 (let ((window (get-buffer-window buffer 'visible)))
1180 (unless (and not-this-window
1181 (eq window (selected-window)))
1182 window))
1183 (get-largest-window 'visible)
1184 (let ((window (get-buffer-window buffer 0)))
1185 (unless (and not-this-window
1186 (eq window (selected-window)))
1187 window))
1188 (get-largest-window 0)
1189 (frame-selected-window (funcall pop-up-frame-function))))
1190 (when (window-live-p window-to-undedicate)
1191 ;; Restore dedicated status of selected window.
1192 (set-window-dedicated-p window-to-undedicate nil))))
1193 (window--even-window-heights window-to-use)
1194 (window--display-buffer-2 buffer window-to-use)))))
1195
1196 (defun pop-to-buffer (buffer-or-name &optional other-window norecord)
1197 "Select buffer BUFFER-OR-NAME in some window, preferably a different one.
1198 BUFFER-OR-NAME may be a buffer, a string \(a buffer name), or
1199 nil. If BUFFER-OR-NAME is a string not naming an existent
1200 buffer, create a buffer with that name. If BUFFER-OR-NAME is
1201 nil, choose some other buffer.
1202
1203 If `pop-up-windows' is non-nil, windows can be split to display
1204 the buffer. If optional second arg OTHER-WINDOW is non-nil,
1205 insist on finding another window even if the specified buffer is
1206 already visible in the selected window, and ignore
1207 `same-window-regexps' and `same-window-buffer-names'.
1208
1209 If the window to show BUFFER-OR-NAME is not on the selected
1210 frame, raise that window's frame and give it input focus.
1211
1212 This function returns the buffer it switched to. This uses the
1213 function `display-buffer' as a subroutine; see the documentation
1214 of `display-buffer' for additional customization information.
1215
1216 Optional third arg NORECORD non-nil means do not put this buffer
1217 at the front of the list of recently selected ones."
1218 (let ((buffer
1219 ;; FIXME: This behavior is carried over from the previous C version
1220 ;; of pop-to-buffer, but really we should use just
1221 ;; `get-buffer' here.
1222 (if (null buffer-or-name) (other-buffer (current-buffer))
1223 (or (get-buffer buffer-or-name)
1224 (let ((buf (get-buffer-create buffer-or-name)))
1225 (set-buffer-major-mode buf)
1226 buf))))
1227 (old-frame (selected-frame))
1228 new-window new-frame)
1229 (set-buffer buffer)
1230 (setq new-window (display-buffer buffer other-window))
1231 (select-window new-window norecord)
1232 (setq new-frame (window-frame new-window))
1233 (unless (eq new-frame old-frame)
1234 ;; `display-buffer' has chosen another frame, make sure it gets
1235 ;; input focus and is risen.
1236 (select-frame-set-input-focus new-frame))
1237 buffer))
1238
1239 ;; I think this should be the default; I think people will prefer it--rms.
1240 (defcustom split-window-keep-point t
1241 "If non-nil, \\[split-window-vertically] keeps the original point \
1242 in both children.
1243 This is often more convenient for editing.
1244 If nil, adjust point in each of the two windows to minimize redisplay.
1245 This is convenient on slow terminals, but point can move strangely.
1246
1247 This option applies only to `split-window-vertically' and
1248 functions that call it. `split-window' always keeps the original
1249 point in both children."
1250 :type 'boolean
1251 :group 'windows)
1252
1253 (defun split-window-vertically (&optional size)
1254 "Split selected window into two windows, one above the other.
1255 The upper window gets SIZE lines and the lower one gets the rest.
1256 SIZE negative means the lower window gets -SIZE lines and the
1257 upper one the rest. With no argument, split windows equally or
1258 close to it. Both windows display the same buffer, now current.
1259
1260 If the variable `split-window-keep-point' is non-nil, both new
1261 windows will get the same value of point as the selected window.
1262 This is often more convenient for editing. The upper window is
1263 the selected window.
1264
1265 Otherwise, we choose window starts so as to minimize the amount of
1266 redisplay; this is convenient on slow terminals. The new selected
1267 window is the one that the current value of point appears in. The
1268 value of point can change if the text around point is hidden by the
1269 new mode line.
1270
1271 Regardless of the value of `split-window-keep-point', the upper
1272 window is the original one and the return value is the new, lower
1273 window."
1274 (interactive "P")
1275 (let ((old-window (selected-window))
1276 (old-point (point))
1277 (size (and size (prefix-numeric-value size)))
1278 moved-by-window-height moved new-window bottom)
1279 (and size (< size 0)
1280 ;; Handle negative SIZE value.
1281 (setq size (+ (window-height) size)))
1282 (setq new-window (split-window nil size))
1283 (unless split-window-keep-point
1284 (with-current-buffer (window-buffer)
1285 (goto-char (window-start))
1286 (setq moved (vertical-motion (window-height)))
1287 (set-window-start new-window (point))
1288 (when (> (point) (window-point new-window))
1289 (set-window-point new-window (point)))
1290 (when (= moved (window-height))
1291 (setq moved-by-window-height t)
1292 (vertical-motion -1))
1293 (setq bottom (point)))
1294 (and moved-by-window-height
1295 (<= bottom (point))
1296 (set-window-point old-window (1- bottom)))
1297 (and moved-by-window-height
1298 (<= (window-start new-window) old-point)
1299 (set-window-point new-window old-point)
1300 (select-window new-window)))
1301 (split-window-save-restore-data new-window old-window)))
1302
1303 ;; This is to avoid compiler warnings.
1304 (defvar view-return-to-alist)
1305
1306 (defun split-window-save-restore-data (new-window old-window)
1307 (with-current-buffer (window-buffer)
1308 (when view-mode
1309 (let ((old-info (assq old-window view-return-to-alist)))
1310 (when old-info
1311 (push (cons new-window (cons (car (cdr old-info)) t))
1312 view-return-to-alist))))
1313 new-window))
1314
1315 (defun split-window-horizontally (&optional size)
1316 "Split selected window into two windows side by side.
1317 The selected window becomes the left one and gets SIZE columns.
1318 SIZE negative means the right window gets -SIZE lines.
1319
1320 SIZE includes the width of the window's scroll bar; if there are
1321 no scroll bars, it includes the width of the divider column to
1322 the window's right, if any. SIZE omitted or nil means split
1323 window equally.
1324
1325 The selected window remains selected. Return the new window."
1326 (interactive "P")
1327 (let ((old-window (selected-window))
1328 (size (and size (prefix-numeric-value size))))
1329 (and size (< size 0)
1330 ;; Handle negative SIZE value.
1331 (setq size (+ (window-width) size)))
1332 (split-window-save-restore-data (split-window nil size t) old-window)))
1333
1334 \f
1335 (defun set-window-text-height (window height)
1336 "Set the height in lines of the text display area of WINDOW to HEIGHT.
1337 HEIGHT doesn't include the mode line or header line, if any, or
1338 any partial-height lines in the text display area.
1339
1340 Note that the current implementation of this function cannot
1341 always set the height exactly, but attempts to be conservative,
1342 by allocating more lines than are actually needed in the case
1343 where some error may be present."
1344 (let ((delta (- height (window-text-height window))))
1345 (unless (zerop delta)
1346 ;; Setting window-min-height to a value like 1 can lead to very
1347 ;; bizarre displays because it also allows Emacs to make *other*
1348 ;; windows 1-line tall, which means that there's no more space for
1349 ;; the modeline.
1350 (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
1351 (if (and window (not (eq window (selected-window))))
1352 (save-selected-window
1353 (select-window window 'norecord)
1354 (enlarge-window delta))
1355 (enlarge-window delta))))))
1356
1357 \f
1358 (defun enlarge-window-horizontally (columns)
1359 "Make selected window COLUMNS wider.
1360 Interactively, if no argument is given, make selected window one
1361 column wider."
1362 (interactive "p")
1363 (enlarge-window columns t))
1364
1365 (defun shrink-window-horizontally (columns)
1366 "Make selected window COLUMNS narrower.
1367 Interactively, if no argument is given, make selected window one
1368 column narrower."
1369 (interactive "p")
1370 (shrink-window columns t))
1371
1372 (defun window-buffer-height (window)
1373 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
1374 (with-current-buffer (window-buffer window)
1375 (max 1
1376 (count-screen-lines (point-min) (point-max)
1377 ;; If buffer ends with a newline, ignore it when
1378 ;; counting height unless point is after it.
1379 (eobp)
1380 window))))
1381
1382 (defun count-screen-lines (&optional beg end count-final-newline window)
1383 "Return the number of screen lines in the region.
1384 The number of screen lines may be different from the number of actual lines,
1385 due to line breaking, display table, etc.
1386
1387 Optional arguments BEG and END default to `point-min' and `point-max'
1388 respectively.
1389
1390 If region ends with a newline, ignore it unless optional third argument
1391 COUNT-FINAL-NEWLINE is non-nil.
1392
1393 The optional fourth argument WINDOW specifies the window used for obtaining
1394 parameters such as width, horizontal scrolling, and so on. The default is
1395 to use the selected window's parameters.
1396
1397 Like `vertical-motion', `count-screen-lines' always uses the current buffer,
1398 regardless of which buffer is displayed in WINDOW. This makes possible to use
1399 `count-screen-lines' in any buffer, whether or not it is currently displayed
1400 in some window."
1401 (unless beg
1402 (setq beg (point-min)))
1403 (unless end
1404 (setq end (point-max)))
1405 (if (= beg end)
1406 0
1407 (save-excursion
1408 (save-restriction
1409 (widen)
1410 (narrow-to-region (min beg end)
1411 (if (and (not count-final-newline)
1412 (= ?\n (char-before (max beg end))))
1413 (1- (max beg end))
1414 (max beg end)))
1415 (goto-char (point-min))
1416 (1+ (vertical-motion (buffer-size) window))))))
1417
1418 (defun fit-window-to-buffer (&optional window max-height min-height)
1419 "Adjust height of WINDOW to display its buffer's contents exactly.
1420 WINDOW defaults to the selected window.
1421 Optional argument MAX-HEIGHT specifies the maximum height of the
1422 window and defaults to the maximum permissible height of a window
1423 on WINDOW's frame.
1424 Optional argument MIN-HEIGHT specifies the minimum height of the
1425 window and defaults to `window-min-height'.
1426 Both, MAX-HEIGHT and MIN-HEIGHT are specified in lines and
1427 include the mode line and header line, if any.
1428
1429 Return non-nil if height was orderly adjusted, nil otherwise.
1430
1431 Caution: This function can delete WINDOW and/or other windows
1432 when their height shrinks to less than MIN-HEIGHT."
1433 (interactive)
1434 ;; Do all the work in WINDOW and its buffer and restore the selected
1435 ;; window and the current buffer when we're done.
1436 (let ((old-buffer (current-buffer))
1437 value)
1438 (with-selected-window (or window (setq window (selected-window)))
1439 (set-buffer (window-buffer))
1440 ;; Use `condition-case' to handle any fixed-size windows and other
1441 ;; pitfalls nearby.
1442 (condition-case nil
1443 (let* (;; MIN-HEIGHT must not be less than 1 and defaults to
1444 ;; `window-min-height'.
1445 (min-height (max (or min-height window-min-height) 1))
1446 (max-window-height
1447 ;; Maximum height of any window on this frame.
1448 (min (window-height (frame-root-window)) (frame-height)))
1449 ;; MAX-HEIGHT must not be larger than max-window-height and
1450 ;; defaults to max-window-height.
1451 (max-height
1452 (min (or max-height max-window-height) max-window-height))
1453 (desired-height
1454 ;; The height necessary to show all of WINDOW's buffer,
1455 ;; constrained by MIN-HEIGHT and MAX-HEIGHT.
1456 (max
1457 (min
1458 ;; For an empty buffer `count-screen-lines' returns zero.
1459 ;; Even in that case we need one line for the cursor.
1460 (+ (max (count-screen-lines) 1)
1461 ;; For non-minibuffers count the mode line, if any.
1462 (if (and (not (window-minibuffer-p)) mode-line-format)
1463 1 0)
1464 ;; Count the header line, if any.
1465 (if header-line-format 1 0))
1466 max-height)
1467 min-height))
1468 (delta
1469 ;; How much the window height has to change.
1470 (if (= (window-height) (window-height (frame-root-window)))
1471 ;; Don't try to resize a full-height window.
1472 0
1473 (- desired-height (window-height))))
1474 ;; Do something reasonable so `enlarge-window' can make
1475 ;; windows as small as MIN-HEIGHT.
1476 (window-min-height (min min-height window-min-height)))
1477 ;; Don't try to redisplay with the cursor at the end on its
1478 ;; own line--that would force a scroll and spoil things.
1479 (when (and (eobp) (bolp) (not (bobp)))
1480 (set-window-point window (1- (window-point))))
1481 ;; Adjust WINDOW's height to the nominally correct one
1482 ;; (which may actually be slightly off because of variable
1483 ;; height text, etc).
1484 (unless (zerop delta)
1485 (enlarge-window delta))
1486 ;; `enlarge-window' might have deleted WINDOW, so make sure
1487 ;; WINDOW's still alive for the remainder of this.
1488 ;; Note: Deleting WINDOW is clearly counter-intuitive in
1489 ;; this context, but we can't do much about it given the
1490 ;; current semantics of `enlarge-window'.
1491 (when (window-live-p window)
1492 ;; Check if the last line is surely fully visible. If
1493 ;; not, enlarge the window.
1494 (let ((end (save-excursion
1495 (goto-char (point-max))
1496 (when (and (bolp) (not (bobp)))
1497 ;; Don't include final newline.
1498 (backward-char 1))
1499 (when truncate-lines
1500 ;; If line-wrapping is turned off, test the
1501 ;; beginning of the last line for
1502 ;; visibility instead of the end, as the
1503 ;; end of the line could be invisible by
1504 ;; virtue of extending past the edge of the
1505 ;; window.
1506 (forward-line 0))
1507 (point))))
1508 (set-window-vscroll window 0)
1509 (while (and (< desired-height max-height)
1510 (= desired-height (window-height))
1511 (not (pos-visible-in-window-p end)))
1512 (enlarge-window 1)
1513 (setq desired-height (1+ desired-height))))
1514 ;; Return non-nil only if nothing "bad" happened.
1515 (setq value t)))
1516 (error nil)))
1517 (when (buffer-live-p old-buffer)
1518 (set-buffer old-buffer))
1519 value))
1520
1521 (defun window-safely-shrinkable-p (&optional window)
1522 "Return t if WINDOW can be shrunk without shrinking other windows.
1523 WINDOW defaults to the selected window."
1524 (with-selected-window (or window (selected-window))
1525 (let ((edges (window-edges)))
1526 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
1527 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
1528
1529 (defun shrink-window-if-larger-than-buffer (&optional window)
1530 "Shrink height of WINDOW if its buffer doesn't need so many lines.
1531 More precisely, shrink WINDOW vertically to be as small as
1532 possible, while still showing the full contents of its buffer.
1533 WINDOW defaults to the selected window.
1534
1535 Do not shrink to less than `window-min-height' lines. Do nothing
1536 if the buffer contains more lines than the present window height,
1537 or if some of the window's contents are scrolled out of view, or
1538 if shrinking this window would also shrink another window, or if
1539 the window is the only window of its frame.
1540
1541 Return non-nil if the window was shrunk, nil otherwise."
1542 (interactive)
1543 (when (null window)
1544 (setq window (selected-window)))
1545 (let* ((frame (window-frame window))
1546 (mini (frame-parameter frame 'minibuffer))
1547 (edges (window-edges window)))
1548 (if (and (not (eq window (frame-root-window frame)))
1549 (window-safely-shrinkable-p window)
1550 (pos-visible-in-window-p (point-min) window)
1551 (not (eq mini 'only))
1552 (or (not mini)
1553 (let ((mini-window (minibuffer-window frame)))
1554 (or (null mini-window)
1555 (not (eq frame (window-frame mini-window)))
1556 (< (nth 3 edges)
1557 (nth 1 (window-edges mini-window)))
1558 (> (nth 1 edges)
1559 (frame-parameter frame 'menu-bar-lines))))))
1560 (fit-window-to-buffer window (window-height window)))))
1561
1562 (defun kill-buffer-and-window ()
1563 "Kill the current buffer and delete the selected window."
1564 (interactive)
1565 (let ((window-to-delete (selected-window))
1566 (buffer-to-kill (current-buffer))
1567 (delete-window-hook (lambda ()
1568 (condition-case nil
1569 (delete-window)
1570 (error nil)))))
1571 (unwind-protect
1572 (progn
1573 (add-hook 'kill-buffer-hook delete-window-hook t t)
1574 (if (kill-buffer (current-buffer))
1575 ;; If `delete-window' failed before, we rerun it to regenerate
1576 ;; the error so it can be seen in the echo area.
1577 (when (eq (selected-window) window-to-delete)
1578 (delete-window))))
1579 ;; If the buffer is not dead for some reason (probably because
1580 ;; of a `quit' signal), remove the hook again.
1581 (condition-case nil
1582 (with-current-buffer buffer-to-kill
1583 (remove-hook 'kill-buffer-hook delete-window-hook t))
1584 (error nil)))))
1585
1586 (defun quit-window (&optional kill window)
1587 "Quit WINDOW and bury its buffer.
1588 With a prefix argument, kill the buffer instead. WINDOW defaults
1589 to the selected window.
1590
1591 If WINDOW is non-nil, dedicated, or a minibuffer window, delete
1592 it and, if it's alone on its frame, its frame too. Otherwise, or
1593 if deleting WINDOW fails in any of the preceding cases, display
1594 another buffer in WINDOW using `switch-to-buffer'.
1595
1596 Optional argument KILL non-nil means kill WINDOW's buffer.
1597 Otherwise, bury WINDOW's buffer, see `bury-buffer'."
1598 (interactive "P")
1599 (let ((buffer (window-buffer window)))
1600 (if (or window
1601 (window-minibuffer-p window)
1602 (window-dedicated-p window))
1603 ;; WINDOW is either non-nil, a minibuffer window, or dedicated;
1604 ;; try to delete it.
1605 (let* ((window (or window (selected-window)))
1606 (frame (window-frame window)))
1607 (if (eq window (frame-root-window frame))
1608 ;; WINDOW is alone on its frame. `delete-windows-on'
1609 ;; knows how to handle that case.
1610 (delete-windows-on buffer frame)
1611 ;; There are other windows on its frame, delete WINDOW.
1612 (delete-window window)))
1613 ;; Otherwise, switch to another buffer in the selected window.
1614 (switch-to-buffer nil))
1615
1616 ;; Deal with the buffer.
1617 (if kill
1618 (kill-buffer buffer)
1619 (bury-buffer buffer))))
1620
1621 \f
1622 (defvar recenter-last-op nil
1623 "Indicates the last recenter operation performed.
1624 Possible values: `top', `middle', `bottom', integer or float numbers.")
1625
1626 (defcustom recenter-positions '(middle top bottom)
1627 "Cycling order for `recenter-top-bottom'.
1628 A list of elements with possible values `top', `middle', `bottom',
1629 integer or float numbers that define the cycling order for
1630 the command `recenter-top-bottom'.
1631
1632 Top and bottom destinations are `scroll-margin' lines the from true
1633 window top and bottom. Middle redraws the frame and centers point
1634 vertically within the window. Integer number moves current line to
1635 the specified absolute window-line. Float number between 0.0 and 1.0
1636 means the percentage of the screen space from the top. The default
1637 cycling order is middle -> top -> bottom."
1638 :type '(repeat (choice
1639 (const :tag "Top" top)
1640 (const :tag "Middle" middle)
1641 (const :tag "Bottom" bottom)
1642 (integer :tag "Line number")
1643 (float :tag "Percentage")))
1644 :version "23.2"
1645 :group 'windows)
1646
1647 (defun recenter-top-bottom (&optional arg)
1648 "Move current buffer line to the specified window line.
1649 With no prefix argument, successive calls place point according
1650 to the cycling order defined by `recenter-positions'.
1651
1652 A prefix argument is handled like `recenter':
1653 With numeric prefix ARG, move current line to window-line ARG.
1654 With plain `C-u', move current line to window center."
1655 (interactive "P")
1656 (cond
1657 (arg (recenter arg)) ; Always respect ARG.
1658 (t
1659 (setq recenter-last-op
1660 (if (eq this-command last-command)
1661 (car (or (cdr (member recenter-last-op recenter-positions))
1662 recenter-positions))
1663 (car recenter-positions)))
1664 (let ((this-scroll-margin
1665 (min (max 0 scroll-margin)
1666 (truncate (/ (window-body-height) 4.0)))))
1667 (cond ((eq recenter-last-op 'middle)
1668 (recenter))
1669 ((eq recenter-last-op 'top)
1670 (recenter this-scroll-margin))
1671 ((eq recenter-last-op 'bottom)
1672 (recenter (- -1 this-scroll-margin)))
1673 ((integerp recenter-last-op)
1674 (recenter recenter-last-op))
1675 ((floatp recenter-last-op)
1676 (recenter (round (* recenter-last-op (window-height))))))))))
1677
1678 (define-key global-map [?\C-l] 'recenter-top-bottom)
1679
1680 (defun move-to-window-line-top-bottom (&optional arg)
1681 "Position point relative to window.
1682
1683 With a prefix argument ARG, acts like `move-to-window-line'.
1684
1685 With no argument, positions point at center of window.
1686 Successive calls position point at positions defined
1687 by `recenter-positions'."
1688 (interactive "P")
1689 (cond
1690 (arg (move-to-window-line arg)) ; Always respect ARG.
1691 (t
1692 (setq recenter-last-op
1693 (if (eq this-command last-command)
1694 (car (or (cdr (member recenter-last-op recenter-positions))
1695 recenter-positions))
1696 (car recenter-positions)))
1697 (let ((this-scroll-margin
1698 (min (max 0 scroll-margin)
1699 (truncate (/ (window-body-height) 4.0)))))
1700 (cond ((eq recenter-last-op 'middle)
1701 (call-interactively 'move-to-window-line))
1702 ((eq recenter-last-op 'top)
1703 (move-to-window-line this-scroll-margin))
1704 ((eq recenter-last-op 'bottom)
1705 (move-to-window-line (- -1 this-scroll-margin)))
1706 ((integerp recenter-last-op)
1707 (move-to-window-line recenter-last-op))
1708 ((floatp recenter-last-op)
1709 (move-to-window-line (round (* recenter-last-op (window-height))))))))))
1710
1711 (define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
1712
1713 \f
1714 ;;; Scrolling commands.
1715
1716 ;;; Scrolling commands which does not signal errors at top/bottom
1717 ;;; of buffer at first key-press (instead moves to top/bottom
1718 ;;; of buffer).
1719
1720 (defcustom scroll-error-top-bottom nil
1721 "Move point to top/bottom of buffer before signalling a scrolling error.
1722 A value of nil means just signal an error if no more scrolling possible.
1723 A value of t means point moves to the beginning or the end of the buffer
1724 \(depending on scrolling direction) when no more scrolling possible.
1725 When point is already on that position, then signal an error."
1726 :type 'boolean
1727 :group 'scrolling
1728 :version "24.1")
1729
1730 (defun scroll-up-command (&optional arg)
1731 "Scroll text of selected window upward ARG lines; or near full screen if no ARG.
1732 If `scroll-error-top-bottom' is non-nil and `scroll-up' cannot
1733 scroll window further, move cursor to the bottom line.
1734 When point is already on that position, then signal an error.
1735 A near full screen is `next-screen-context-lines' less than a full screen.
1736 Negative ARG means scroll downward.
1737 If ARG is the atom `-', scroll downward by nearly full screen."
1738 (interactive "^P")
1739 (cond
1740 ((null scroll-error-top-bottom)
1741 (scroll-up arg))
1742 ((eq arg '-)
1743 (scroll-down-command nil))
1744 ((< (prefix-numeric-value arg) 0)
1745 (scroll-down-command (- (prefix-numeric-value arg))))
1746 ((eobp)
1747 (scroll-up arg)) ; signal error
1748 (t
1749 (condition-case nil
1750 (scroll-up arg)
1751 (end-of-buffer
1752 (if arg
1753 ;; When scrolling by ARG lines can't be done,
1754 ;; move by ARG lines instead.
1755 (forward-line arg)
1756 ;; When ARG is nil for full-screen scrolling,
1757 ;; move to the bottom of the buffer.
1758 (goto-char (point-max))))))))
1759
1760 (put 'scroll-up-command 'scroll-command t)
1761
1762 (defun scroll-down-command (&optional arg)
1763 "Scroll text of selected window down ARG lines; or near full screen if no ARG.
1764 If `scroll-error-top-bottom' is non-nil and `scroll-down' cannot
1765 scroll window further, move cursor to the top line.
1766 When point is already on that position, then signal an error.
1767 A near full screen is `next-screen-context-lines' less than a full screen.
1768 Negative ARG means scroll upward.
1769 If ARG is the atom `-', scroll upward by nearly full screen."
1770 (interactive "^P")
1771 (cond
1772 ((null scroll-error-top-bottom)
1773 (scroll-down arg))
1774 ((eq arg '-)
1775 (scroll-up-command nil))
1776 ((< (prefix-numeric-value arg) 0)
1777 (scroll-up-command (- (prefix-numeric-value arg))))
1778 ((bobp)
1779 (scroll-down arg)) ; signal error
1780 (t
1781 (condition-case nil
1782 (scroll-down arg)
1783 (beginning-of-buffer
1784 (if arg
1785 ;; When scrolling by ARG lines can't be done,
1786 ;; move by ARG lines instead.
1787 (forward-line (- arg))
1788 ;; When ARG is nil for full-screen scrolling,
1789 ;; move to the top of the buffer.
1790 (goto-char (point-min))))))))
1791
1792 (put 'scroll-down-command 'scroll-command t)
1793
1794 ;;; Scrolling commands which scroll a line instead of full screen.
1795
1796 (defun scroll-up-line (&optional arg)
1797 "Scroll text of selected window upward ARG lines; or one line if no ARG.
1798 If ARG is omitted or nil, scroll upward by one line.
1799 This is different from `scroll-up-command' that scrolls a full screen."
1800 (interactive "p")
1801 (scroll-up (or arg 1)))
1802
1803 (put 'scroll-up-line 'scroll-command t)
1804
1805 (defun scroll-down-line (&optional arg)
1806 "Scroll text of selected window down ARG lines; or one line if no ARG.
1807 If ARG is omitted or nil, scroll down by one line.
1808 This is different from `scroll-down-command' that scrolls a full screen."
1809 (interactive "p")
1810 (scroll-down (or arg 1)))
1811
1812 (put 'scroll-down-line 'scroll-command t)
1813
1814 \f
1815 (defun scroll-other-window-down (lines)
1816 "Scroll the \"other window\" down.
1817 For more details, see the documentation for `scroll-other-window'."
1818 (interactive "P")
1819 (scroll-other-window
1820 ;; Just invert the argument's meaning.
1821 ;; We can do that without knowing which window it will be.
1822 (if (eq lines '-) nil
1823 (if (null lines) '-
1824 (- (prefix-numeric-value lines))))))
1825
1826 (defun beginning-of-buffer-other-window (arg)
1827 "Move point to the beginning of the buffer in the other window.
1828 Leave mark at previous position.
1829 With arg N, put point N/10 of the way from the true beginning."
1830 (interactive "P")
1831 (let ((orig-window (selected-window))
1832 (window (other-window-for-scrolling)))
1833 ;; We use unwind-protect rather than save-window-excursion
1834 ;; because the latter would preserve the things we want to change.
1835 (unwind-protect
1836 (progn
1837 (select-window window)
1838 ;; Set point and mark in that window's buffer.
1839 (with-no-warnings
1840 (beginning-of-buffer arg))
1841 ;; Set point accordingly.
1842 (recenter '(t)))
1843 (select-window orig-window))))
1844
1845 (defun end-of-buffer-other-window (arg)
1846 "Move point to the end of the buffer in the other window.
1847 Leave mark at previous position.
1848 With arg N, put point N/10 of the way from the true end."
1849 (interactive "P")
1850 ;; See beginning-of-buffer-other-window for comments.
1851 (let ((orig-window (selected-window))
1852 (window (other-window-for-scrolling)))
1853 (unwind-protect
1854 (progn
1855 (select-window window)
1856 (with-no-warnings
1857 (end-of-buffer arg))
1858 (recenter '(t)))
1859 (select-window orig-window))))
1860
1861 \f
1862 (defvar mouse-autoselect-window-timer nil
1863 "Timer used by delayed window autoselection.")
1864
1865 (defvar mouse-autoselect-window-position nil
1866 "Last mouse position recorded by delayed window autoselection.")
1867
1868 (defvar mouse-autoselect-window-window nil
1869 "Last window recorded by delayed window autoselection.")
1870
1871 (defvar mouse-autoselect-window-state nil
1872 "When non-nil, special state of delayed window autoselection.
1873 Possible values are `suspend' \(suspend autoselection after a menu or
1874 scrollbar interaction\) and `select' \(the next invocation of
1875 'handle-select-window' shall select the window immediately\).")
1876
1877 (defun mouse-autoselect-window-cancel (&optional force)
1878 "Cancel delayed window autoselection.
1879 Optional argument FORCE means cancel unconditionally."
1880 (unless (and (not force)
1881 ;; Don't cancel for select-window or select-frame events
1882 ;; or when the user drags a scroll bar.
1883 (or (memq this-command
1884 '(handle-select-window handle-switch-frame))
1885 (and (eq this-command 'scroll-bar-toolkit-scroll)
1886 (memq (nth 4 (event-end last-input-event))
1887 '(handle end-scroll)))))
1888 (setq mouse-autoselect-window-state nil)
1889 (when (timerp mouse-autoselect-window-timer)
1890 (cancel-timer mouse-autoselect-window-timer))
1891 (remove-hook 'pre-command-hook 'mouse-autoselect-window-cancel)))
1892
1893 (defun mouse-autoselect-window-start (mouse-position &optional window suspend)
1894 "Start delayed window autoselection.
1895 MOUSE-POSITION is the last position where the mouse was seen as returned
1896 by `mouse-position'. Optional argument WINDOW non-nil denotes the
1897 window where the mouse was seen. Optional argument SUSPEND non-nil
1898 means suspend autoselection."
1899 ;; Record values for MOUSE-POSITION, WINDOW, and SUSPEND.
1900 (setq mouse-autoselect-window-position mouse-position)
1901 (when window (setq mouse-autoselect-window-window window))
1902 (setq mouse-autoselect-window-state (when suspend 'suspend))
1903 ;; Install timer which runs `mouse-autoselect-window-select' after
1904 ;; `mouse-autoselect-window' seconds.
1905 (setq mouse-autoselect-window-timer
1906 (run-at-time
1907 (abs mouse-autoselect-window) nil 'mouse-autoselect-window-select)))
1908
1909 (defun mouse-autoselect-window-select ()
1910 "Select window with delayed window autoselection.
1911 If the mouse position has stabilized in a non-selected window, select
1912 that window. The minibuffer window is selected only if the minibuffer is
1913 active. This function is run by `mouse-autoselect-window-timer'."
1914 (condition-case nil
1915 (let* ((mouse-position (mouse-position))
1916 (window
1917 (condition-case nil
1918 (window-at (cadr mouse-position) (cddr mouse-position)
1919 (car mouse-position))
1920 (error nil))))
1921 (cond
1922 ((or (menu-or-popup-active-p)
1923 (and window
1924 (not (coordinates-in-window-p (cdr mouse-position) window))))
1925 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
1926 ;; of WINDOW, temporarily suspend delayed autoselection.
1927 (mouse-autoselect-window-start mouse-position nil t))
1928 ((eq mouse-autoselect-window-state 'suspend)
1929 ;; Delayed autoselection was temporarily suspended, reenable it.
1930 (mouse-autoselect-window-start mouse-position))
1931 ((and window (not (eq window (selected-window)))
1932 (or (not (numberp mouse-autoselect-window))
1933 (and (> mouse-autoselect-window 0)
1934 ;; If `mouse-autoselect-window' is positive, select
1935 ;; window if the window is the same as before.
1936 (eq window mouse-autoselect-window-window))
1937 ;; Otherwise select window if the mouse is at the same
1938 ;; position as before. Observe that the first test after
1939 ;; starting autoselection usually fails since the value of
1940 ;; `mouse-autoselect-window-position' recorded there is the
1941 ;; position where the mouse has entered the new window and
1942 ;; not necessarily where the mouse has stopped moving.
1943 (equal mouse-position mouse-autoselect-window-position))
1944 ;; The minibuffer is a candidate window if it's active.
1945 (or (not (window-minibuffer-p window))
1946 (eq window (active-minibuffer-window))))
1947 ;; Mouse position has stabilized in non-selected window: Cancel
1948 ;; delayed autoselection and try to select that window.
1949 (mouse-autoselect-window-cancel t)
1950 ;; Select window where mouse appears unless the selected window is the
1951 ;; minibuffer. Use `unread-command-events' in order to execute pre-
1952 ;; and post-command hooks and trigger idle timers. To avoid delaying
1953 ;; autoselection again, set `mouse-autoselect-window-state'."
1954 (unless (window-minibuffer-p (selected-window))
1955 (setq mouse-autoselect-window-state 'select)
1956 (setq unread-command-events
1957 (cons (list 'select-window (list window))
1958 unread-command-events))))
1959 ((or (and window (eq window (selected-window)))
1960 (not (numberp mouse-autoselect-window))
1961 (equal mouse-position mouse-autoselect-window-position))
1962 ;; Mouse position has either stabilized in the selected window or at
1963 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
1964 (mouse-autoselect-window-cancel t))
1965 (t
1966 ;; Mouse position has not stabilized yet, resume delayed
1967 ;; autoselection.
1968 (mouse-autoselect-window-start mouse-position window))))
1969 (error nil)))
1970
1971 (defun handle-select-window (event)
1972 "Handle select-window events."
1973 (interactive "e")
1974 (let ((window (posn-window (event-start event))))
1975 (unless (or (not (window-live-p window))
1976 ;; Don't switch if we're currently in the minibuffer.
1977 ;; This tries to work around problems where the
1978 ;; minibuffer gets unselected unexpectedly, and where
1979 ;; you then have to move your mouse all the way down to
1980 ;; the minibuffer to select it.
1981 (window-minibuffer-p (selected-window))
1982 ;; Don't switch to minibuffer window unless it's active.
1983 (and (window-minibuffer-p window)
1984 (not (minibuffer-window-active-p window)))
1985 ;; Don't switch when autoselection shall be delayed.
1986 (and (numberp mouse-autoselect-window)
1987 (not (zerop mouse-autoselect-window))
1988 (not (eq mouse-autoselect-window-state 'select))
1989 (progn
1990 ;; Cancel any delayed autoselection.
1991 (mouse-autoselect-window-cancel t)
1992 ;; Start delayed autoselection from current mouse
1993 ;; position and window.
1994 (mouse-autoselect-window-start (mouse-position) window)
1995 ;; Executing a command cancels delayed autoselection.
1996 (add-hook
1997 'pre-command-hook 'mouse-autoselect-window-cancel))))
1998 (when mouse-autoselect-window
1999 ;; Reset state of delayed autoselection.
2000 (setq mouse-autoselect-window-state nil)
2001 ;; Run `mouse-leave-buffer-hook' when autoselecting window.
2002 (run-hooks 'mouse-leave-buffer-hook))
2003 (select-window window))))
2004
2005 (defun delete-other-windows-vertically (&optional window)
2006 "Delete the windows in the same column with WINDOW, but not WINDOW itself.
2007 This may be a useful alternative binding for \\[delete-other-windows]
2008 if you often split windows horizontally."
2009 (interactive)
2010 (let* ((window (or window (selected-window)))
2011 (edges (window-edges window))
2012 (w window) delenda)
2013 (while (not (eq (setq w (next-window w 1)) window))
2014 (let ((e (window-edges w)))
2015 (when (and (= (car e) (car edges))
2016 (= (caddr e) (caddr edges)))
2017 (push w delenda))))
2018 (mapc 'delete-window delenda)))
2019
2020 (defun truncated-partial-width-window-p (&optional window)
2021 "Return non-nil if lines in WINDOW are specifically truncated due to its width.
2022 WINDOW defaults to the selected window.
2023 Return nil if WINDOW is not a partial-width window
2024 (regardless of the value of `truncate-lines').
2025 Otherwise, consult the value of `truncate-partial-width-windows'
2026 for the buffer shown in WINDOW."
2027 (unless window
2028 (setq window (selected-window)))
2029 (unless (window-full-width-p window)
2030 (let ((t-p-w-w (buffer-local-value 'truncate-partial-width-windows
2031 (window-buffer window))))
2032 (if (integerp t-p-w-w)
2033 (< (window-width window) t-p-w-w)
2034 t-p-w-w))))
2035
2036 (define-key ctl-x-map "2" 'split-window-vertically)
2037 (define-key ctl-x-map "3" 'split-window-horizontally)
2038 (define-key ctl-x-map "}" 'enlarge-window-horizontally)
2039 (define-key ctl-x-map "{" 'shrink-window-horizontally)
2040 (define-key ctl-x-map "-" 'shrink-window-if-larger-than-buffer)
2041 (define-key ctl-x-map "+" 'balance-windows)
2042 (define-key ctl-x-4-map "0" 'kill-buffer-and-window)
2043
2044 ;;; window.el ends here