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