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