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