aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorMartin Rudalics2011-06-11 16:06:16 +0200
committerMartin Rudalics2011-06-11 16:06:16 +0200
commit6198ccd0b2e8cebc14415e13765de6bb758ec786 (patch)
treefd3a913e20dc8e70f667d7ced7111bd27e64c8e7
parent1ab0dee5ca2b1368770aac0f796959c95f18ed89 (diff)
downloademacs-6198ccd0b2e8cebc14415e13765de6bb758ec786.tar.gz
emacs-6198ccd0b2e8cebc14415e13765de6bb758ec786.zip
Window configuration, balancing and fit-to-buffer rewrites.
* window.c (delete_deletable_window): Re-add. (Fset_window_configuration): Rewrite to handle dead buffers and consequently deletable windows. (window_tree, Fwindow_tree): Remove. Supply functionality in window.el. (compare_window_configurations): Simplify code. * window.el (window-tree-1, window-tree): New functions, moving the latter to window.el. (bw-get-tree, bw-get-tree-1, bw-find-tree-sub) (bw-find-tree-sub-1, bw-l, bw-t, bw-r, bw-b, bw-dir, bw-eqdir) (bw-refresh-edges): Remove. (balance-windows-1, balance-windows-2): New functions. (balance-windows): Rewrite in terms of window tree functions, balance-windows-1 and balance-windows-2. (bw-adjust-window): Remove. (balance-windows-area-adjust): New function with functionality of bw-adjust-window but using resize-window. (set-window-text-height): Rewrite doc-string. Use normalize-live-window and resize-window. (enlarge-window-horizontally, shrink-window-horizontally): Rename argument to DELTA. (window-buffer-height): New function. (fit-window-to-buffer, shrink-window-if-larger-than-buffer): Rewrite using new window resize routines. (kill-buffer-and-window, mouse-autoselect-window-select): Use ignore-errors instead of condition-case. (quit-window): Call delete-frame instead of delete-windows-on for the only buffer on frame.
-rw-r--r--lisp/ChangeLog25
-rw-r--r--lisp/window.el754
-rw-r--r--src/ChangeLog9
-rw-r--r--src/window.c371
4 files changed, 535 insertions, 624 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 611531330cc..7c258be6d9b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,28 @@
12011-06-11 Martin Rudalics <rudalics@gmx.at>
2
3 * window.el (window-tree-1, window-tree): New functions, moving
4 the latter to window.el.
5 (bw-get-tree, bw-get-tree-1, bw-find-tree-sub)
6 (bw-find-tree-sub-1, bw-l, bw-t, bw-r, bw-b, bw-dir, bw-eqdir)
7 (bw-refresh-edges): Remove.
8 (balance-windows-1, balance-windows-2): New functions.
9 (balance-windows): Rewrite in terms of window tree functions,
10 balance-windows-1 and balance-windows-2.
11 (bw-adjust-window): Remove.
12 (balance-windows-area-adjust): New function with functionality of
13 bw-adjust-window but using resize-window.
14 (set-window-text-height): Rewrite doc-string. Use
15 normalize-live-window and resize-window.
16 (enlarge-window-horizontally, shrink-window-horizontally): Rename
17 argument to DELTA.
18 (window-buffer-height): New function.
19 (fit-window-to-buffer, shrink-window-if-larger-than-buffer):
20 Rewrite using new window resize routines.
21 (kill-buffer-and-window, mouse-autoselect-window-select): Use
22 ignore-errors instead of condition-case.
23 (quit-window): Call delete-frame instead of delete-windows-on
24 for the only buffer on frame.
25
12011-06-10 Martin Rudalics <rudalics@gmx.at> 262011-06-10 Martin Rudalics <rudalics@gmx.at>
2 27
3 * loadup.el (top-level): Load window before files for the sake 28 * loadup.el (top-level): Load window before files for the sake
diff --git a/lisp/window.el b/lisp/window.el
index 2811baf706d..ace82826e67 100644
--- a/lisp/window.el
+++ b/lisp/window.el
@@ -2077,6 +2077,47 @@ WINDOW can be any window and defaults to the selected window."
2077(defsubst frame-root-window-p (window) 2077(defsubst frame-root-window-p (window)
2078 "Return non-nil if WINDOW is the root window of its frame." 2078 "Return non-nil if WINDOW is the root window of its frame."
2079 (eq window (frame-root-window window))) 2079 (eq window (frame-root-window window)))
2080
2081(defun window-tree-1 (window &optional next)
2082 "Return window tree rooted at WINDOW.
2083Optional argument NEXT non-nil means include windows right
2084siblings in the return value.
2085
2086See the documentation of `window-tree' for a description of the
2087return value."
2088 (let (list)
2089 (while window
2090 (setq list
2091 (cons
2092 (cond
2093 ((window-vchild window)
2094 (cons t (cons (window-edges window)
2095 (window-tree-1 (window-vchild window) t))))
2096 ((window-hchild window)
2097 (cons nil (cons (window-edges window)
2098 (window-tree-1 (window-hchild window) t))))
2099 (t window))
2100 list))
2101 (setq window (when next (window-next window))))
2102 (nreverse list)))
2103
2104(defun window-tree (&optional frame)
2105 "Return the window tree of frame FRAME.
2106FRAME must be a live frame and defaults to the selected frame.
2107The return value is a list of the form (ROOT MINI), where ROOT
2108represents the window tree of the frame's root window, and MINI
2109is the frame's minibuffer window.
2110
2111If the root window is not split, ROOT is the root window itself.
2112Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil
2113for a horizontal split, and t for a vertical split. EDGES gives
2114the combined size and position of the subwindows in the split,
2115and the rest of the elements are the subwindows in the split.
2116Each of the subwindows may again be a window or a list
2117representing a window split, and so on. EDGES is a list \(LEFT
2118TOP RIGHT BOTTOM) as returned by `window-edges'."
2119 (setq frame (normalize-live-frame frame))
2120 (window-tree-1 (frame-root-window frame) t))
2080 2121
2081(defun other-window (count &optional all-frames) 2122(defun other-window (count &optional all-frames)
2082 "Select another window in cyclic ordering of windows. 2123 "Select another window in cyclic ordering of windows.
@@ -3184,201 +3225,125 @@ The selected window remains selected. Return the new window."
3184 3225
3185(defalias 'split-window-horizontally 'split-window-side-by-side) 3226(defalias 'split-window-horizontally 'split-window-side-by-side)
3186 3227
3187;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 3228;;; Balancing windows.
3188;;; `balance-windows' subroutines using `window-tree' 3229
3189 3230;; The following routine uses the recycled code from an old version of
3190;;; Translate from internal window tree format 3231;; `resize-subwindows'. It's not very pretty, but coding it the way the
3191 3232;; new `resize-subwindows' code does would hardly make it any shorter or
3192(defun bw-get-tree (&optional window-or-frame) 3233;; more readable (FWIW we'd need three loops - one to calculate the
3193 "Get a window split tree in our format. 3234;; minimum sizes per window, one to enlarge or shrink windows until the
3194 3235;; new parent-size matches, and one where we shrink the largest/enlarge
3195WINDOW-OR-FRAME must be nil, a frame, or a window. If it is nil, 3236;; the smallest window).
3196then the whole window split tree for `selected-frame' is returned. 3237(defun balance-windows-2 (window horizontal)
3197If it is a frame, then this is used instead. If it is a window, 3238 "Subroutine of `balance-windows-1'.
3198then the smallest tree containing that window is returned." 3239WINDOW must be an iso-combination."
3199 (when window-or-frame 3240 (let* ((first (window-child window))
3200 (unless (or (framep window-or-frame) 3241 (sub first)
3201 (windowp window-or-frame)) 3242 (number-of-children 0)
3202 (error "Not a frame or window: %s" window-or-frame))) 3243 (parent-size (window-new-total window))
3203 (let ((subtree (bw-find-tree-sub window-or-frame))) 3244 (total-sum parent-size)
3204 (when subtree 3245 found failed size sub-total sub-delta sub-amount rest)
3205 (if (integerp subtree) 3246 (while sub
3206 nil 3247 (setq number-of-children (1+ number-of-children))
3207 (bw-get-tree-1 subtree))))) 3248 (when (window-size-fixed-p sub horizontal)
3208 3249 (setq total-sum
3209(defun bw-get-tree-1 (split) 3250 (- total-sum (window-total-size sub horizontal)))
3210 (if (windowp split) 3251 (set-window-new-normal sub 'ignore))
3211 split 3252 (setq sub (window-right sub)))
3212 (let ((dir (car split))
3213 (edges (car (cdr split)))
3214 (childs (cdr (cdr split))))
3215 (list
3216 (cons 'dir (if dir 'ver 'hor))
3217 (cons 'b (nth 3 edges))
3218 (cons 'r (nth 2 edges))
3219 (cons 't (nth 1 edges))
3220 (cons 'l (nth 0 edges))
3221 (cons 'childs (mapcar #'bw-get-tree-1 childs))))))
3222
3223(defun bw-find-tree-sub (window-or-frame &optional get-parent)
3224 (let* ((window (when (windowp window-or-frame) window-or-frame))
3225 (frame (when (windowp window) (window-frame window)))
3226 (wt (car (window-tree frame))))
3227 (when (< 1 (length (window-list frame 0)))
3228 (if window
3229 (bw-find-tree-sub-1 wt window get-parent)
3230 wt))))
3231
3232(defun bw-find-tree-sub-1 (tree win &optional get-parent)
3233 (unless (windowp win) (error "Not a window: %s" win))
3234 (if (memq win tree)
3235 (if get-parent
3236 get-parent
3237 tree)
3238 (let ((childs (cdr (cdr tree)))
3239 child
3240 subtree)
3241 (while (and childs (not subtree))
3242 (setq child (car childs))
3243 (setq childs (cdr childs))
3244 (when (and child (listp child))
3245 (setq subtree (bw-find-tree-sub-1 child win get-parent))))
3246 (if (integerp subtree)
3247 (progn
3248 (if (= 1 subtree)
3249 tree
3250 (1- subtree)))
3251 subtree
3252 ))))
3253
3254;;; Window or object edges
3255
3256(defun bw-l (obj)
3257 "Left edge of OBJ."
3258 (if (windowp obj) (nth 0 (window-edges obj)) (cdr (assq 'l obj))))
3259(defun bw-t (obj)
3260 "Top edge of OBJ."
3261 (if (windowp obj) (nth 1 (window-edges obj)) (cdr (assq 't obj))))
3262(defun bw-r (obj)
3263 "Right edge of OBJ."
3264 (if (windowp obj) (nth 2 (window-edges obj)) (cdr (assq 'r obj))))
3265(defun bw-b (obj)
3266 "Bottom edge of OBJ."
3267 (if (windowp obj) (nth 3 (window-edges obj)) (cdr (assq 'b obj))))
3268
3269;;; Split directions
3270
3271(defun bw-dir (obj)
3272 "Return window split tree direction if OBJ.
3273If OBJ is a window return 'both. If it is a window split tree
3274then return its direction."
3275 (if (symbolp obj)
3276 obj
3277 (if (windowp obj)
3278 'both
3279 (let ((dir (cdr (assq 'dir obj))))
3280 (unless (memq dir '(hor ver both))
3281 (error "Can't find dir in %s" obj))
3282 dir))))
3283
3284(defun bw-eqdir (obj1 obj2)
3285 "Return t if window split tree directions are equal.
3286OBJ1 and OBJ2 should be either windows or window split trees in
3287our format. The directions returned by `bw-dir' are compared and
3288t is returned if they are `eq' or one of them is 'both."
3289 (let ((dir1 (bw-dir obj1))
3290 (dir2 (bw-dir obj2)))
3291 (or (eq dir1 dir2)
3292 (eq dir1 'both)
3293 (eq dir2 'both))))
3294
3295;;; Building split tree
3296
3297(defun bw-refresh-edges (obj)
3298 "Refresh the edge information of OBJ and return OBJ."
3299 (unless (windowp obj)
3300 (let ((childs (cdr (assq 'childs obj)))
3301 (ol 1000)
3302 (ot 1000)
3303 (or -1)
3304 (ob -1))
3305 (dolist (o childs)
3306 (when (> ol (bw-l o)) (setq ol (bw-l o)))
3307 (when (> ot (bw-t o)) (setq ot (bw-t o)))
3308 (when (< or (bw-r o)) (setq or (bw-r o)))
3309 (when (< ob (bw-b o)) (setq ob (bw-b o))))
3310 (setq obj (delq 'l obj))
3311 (setq obj (delq 't obj))
3312 (setq obj (delq 'r obj))
3313 (setq obj (delq 'b obj))
3314 (add-to-list 'obj (cons 'l ol))
3315 (add-to-list 'obj (cons 't ot))
3316 (add-to-list 'obj (cons 'r or))
3317 (add-to-list 'obj (cons 'b ob))
3318 ))
3319 obj)
3320
3321;;; Balance windows
3322 3253
3323(defun balance-windows (&optional window-or-frame) 3254 (setq failed t)
3324 "Make windows the same heights or widths in window split subtrees. 3255 (while (and failed (> number-of-children 0))
3256 (setq size (/ total-sum number-of-children))
3257 (setq failed nil)
3258 (setq sub first)
3259 (while (and sub (not failed))
3260 ;; Ignore subwindows that should be ignored or are stuck.
3261 (unless (resize-subwindows-skip-p sub)
3262 (setq found t)
3263 (setq sub-total (window-total-size sub horizontal))
3264 (setq sub-delta (- size sub-total))
3265 (setq sub-amount
3266 (window-sizable sub sub-delta horizontal))
3267 ;; Register the new total size for this subwindow.
3268 (set-window-new-total sub (+ sub-total sub-amount))
3269 (unless (= sub-amount sub-delta)
3270 (setq total-sum (- total-sum sub-total sub-amount))
3271 (setq number-of-children (1- number-of-children))
3272 ;; We failed and need a new round.
3273 (setq failed t)
3274 (set-window-new-normal sub 'skip)))
3275 (setq sub (window-right sub))))
3325 3276
3326When called non-interactively WINDOW-OR-FRAME may be either a 3277 (setq rest (% total-sum number-of-children))
3327window or a frame. It then balances the windows on the implied 3278 ;; Fix rounding by trying to enlarge non-stuck windows by one line
3328frame. If the parameter is a window only the corresponding window 3279 ;; (column) until `rest' is zero.
3329subtree is balanced." 3280 (setq sub first)
3330 (interactive) 3281 (while (and sub (> rest 0))
3331 (let ( 3282 (unless (resize-subwindows-skip-p window)
3332 (wt (bw-get-tree window-or-frame)) 3283 (set-window-new-total sub 1 t)
3333 (w) 3284 (setq rest (1- rest)))
3334 (h) 3285 (setq sub (window-right sub)))
3335 (tried-sizes) 3286
3336 (last-sizes) 3287 ;; Fix rounding by trying to enlarge stuck windows by one line
3337 (windows (window-list nil 0))) 3288 ;; (column) until `rest' equals zero.
3338 (when wt 3289 (setq sub first)
3339 (while (not (member last-sizes tried-sizes)) 3290 (while (and sub (> rest 0))
3340 (when last-sizes (setq tried-sizes (cons last-sizes tried-sizes))) 3291 (unless (eq (window-new-normal sub) 'ignore)
3341 (setq last-sizes (mapcar (lambda (w) 3292 (set-window-new-total sub 1 t)
3342 (window-edges w)) 3293 (setq rest (1- rest)))
3343 windows)) 3294 (setq sub (window-right sub)))
3344 (when (eq 'hor (bw-dir wt))
3345 (setq w (- (bw-r wt) (bw-l wt))))
3346 (when (eq 'ver (bw-dir wt))
3347 (setq h (- (bw-b wt) (bw-t wt))))
3348 (bw-balance-sub wt w h)))))
3349
3350(defun bw-adjust-window (window delta horizontal)
3351 "Wrapper around `adjust-window-trailing-edge' with error checking.
3352Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
3353 ;; `adjust-window-trailing-edge' may fail if delta is too large.
3354 (while (>= (abs delta) 1)
3355 (condition-case nil
3356 (progn
3357 (adjust-window-trailing-edge window delta horizontal)
3358 (setq delta 0))
3359 (error
3360 ;;(message "adjust: %s" (error-message-string err))
3361 (setq delta (/ delta 2))))))
3362 3295
3363(defun bw-balance-sub (wt w h) 3296 (setq sub first)
3364 (setq wt (bw-refresh-edges wt)) 3297 (while sub
3365 (unless w (setq w (- (bw-r wt) (bw-l wt)))) 3298 ;; Record new normal sizes.
3366 (unless h (setq h (- (bw-b wt) (bw-t wt)))) 3299 (set-window-new-normal
3367 (if (windowp wt) 3300 sub (/ (if (eq (window-new-normal sub) 'ignore)
3368 (progn 3301 (window-total-size sub horizontal)
3369 (when w 3302 (window-new-total sub))
3370 (let ((dw (- w (- (bw-r wt) (bw-l wt))))) 3303 (float parent-size)))
3371 (when (/= 0 dw) 3304 ;; Recursively balance each subwindow's subwindows.
3372 (bw-adjust-window wt dw t)))) 3305 (balance-windows-1 sub horizontal)
3373 (when h 3306 (setq sub (window-right sub)))))
3374 (let ((dh (- h (- (bw-b wt) (bw-t wt))))) 3307
3375 (when (/= 0 dh) 3308(defun balance-windows-1 (window &optional horizontal)
3376 (bw-adjust-window wt dh nil))))) 3309 "Subroutine of `balance-windows'."
3377 (let* ((childs (cdr (assq 'childs wt))) 3310 (if (window-child window)
3378 (cw (when w (/ w (if (bw-eqdir 'hor wt) (length childs) 1)))) 3311 (let ((sub (window-child window)))
3379 (ch (when h (/ h (if (bw-eqdir 'ver wt) (length childs) 1))))) 3312 (if (window-iso-combined-p sub horizontal)
3380 (dolist (c childs) 3313 (balance-windows-2 window horizontal)
3381 (bw-balance-sub c cw ch))))) 3314 (let ((size (window-new-total window)))
3315 (while sub
3316 (set-window-new-total sub size)
3317 (balance-windows-1 sub horizontal)
3318 (setq sub (window-right sub))))))))
3319
3320(defun balance-windows (&optional window-or-frame)
3321 "Balance the sizes of subwindows of WINDOW-OR-FRAME.
3322WINDOW-OR-FRAME is optional and defaults to the selected frame.
3323If WINDOW-OR-FRAME denotes a frame, balance the sizes of all
3324subwindows of that frame's root window. If WINDOW-OR-FRAME
3325denots a window, balance the sizes of all subwindows of that
3326window."
3327 (interactive)
3328 (let* ((window
3329 (cond
3330 ((or (not window-or-frame)
3331 (frame-live-p window-or-frame))
3332 (frame-root-window window-or-frame))
3333 ((or (window-live-p window-or-frame)
3334 (window-child window-or-frame))
3335 window-or-frame)
3336 (t
3337 (error "Not a window or frame %s" window-or-frame))))
3338 (frame (window-frame window)))
3339 ;; Balance vertically.
3340 (resize-window-reset (window-frame window))
3341 (balance-windows-1 window)
3342 (resize-window-apply frame)
3343 ;; Balance horizontally.
3344 (resize-window-reset (window-frame window) t)
3345 (balance-windows-1 window t)
3346 (resize-window-apply frame t)))
3382 3347
3383(defun window-fixed-size-p (&optional window direction) 3348(defun window-fixed-size-p (&optional window direction)
3384 "Return t if WINDOW cannot be resized in DIRECTION. 3349 "Return t if WINDOW cannot be resized in DIRECTION.
@@ -3391,13 +3356,25 @@ nil (i.e. any), `height' or `width'."
3391 '((height . width) (width . height)))))))) 3356 '((height . width) (width . height))))))))
3392 3357
3393;;; A different solution to balance-windows. 3358;;; A different solution to balance-windows.
3394
3395(defvar window-area-factor 1 3359(defvar window-area-factor 1
3396 "Factor by which the window area should be over-estimated. 3360 "Factor by which the window area should be over-estimated.
3397This is used by `balance-windows-area'. 3361This is used by `balance-windows-area'.
3398Changing this globally has no effect.") 3362Changing this globally has no effect.")
3399(make-variable-buffer-local 'window-area-factor) 3363(make-variable-buffer-local 'window-area-factor)
3400 3364
3365(defun balance-windows-area-adjust (window delta horizontal)
3366 "Wrapper around `resize-window' with error checking.
3367Arguments WINDOW, DELTA and HORIZONTAL are passed on to that function."
3368 ;; `resize-window' may fail if delta is too large.
3369 (while (>= (abs delta) 1)
3370 (condition-case nil
3371 (progn
3372 (resize-window window delta horizontal)
3373 (setq delta 0))
3374 (error
3375 ;;(message "adjust: %s" (error-message-string err))
3376 (setq delta (/ delta 2))))))
3377
3401(defun balance-windows-area () 3378(defun balance-windows-area ()
3402 "Make all visible windows the same area (approximately). 3379 "Make all visible windows the same area (approximately).
3403See also `window-area-factor' to change the relative size of 3380See also `window-area-factor' to change the relative size of
@@ -3459,7 +3436,9 @@ specific buffers."
3459 ;; Make sure negligible differences don't accumulate to 3436 ;; Make sure negligible differences don't accumulate to
3460 ;; become significant. 3437 ;; become significant.
3461 (setq carry (+ carry areadiff)) 3438 (setq carry (+ carry areadiff))
3462 (bw-adjust-window win diff horiz) 3439 ;; This used `adjust-window-trailing-edge' before and uses
3440 ;; `resize-window' now. Error wrapping is still needed.
3441 (balance-windows-area-adjust win diff horiz)
3463 ;; (sit-for 0.5) 3442 ;; (sit-for 0.5)
3464 (let ((change (cons win (window-edges win)))) 3443 (let ((change (cons win (window-edges win))))
3465 ;; If the same change has been seen already for this window, 3444 ;; If the same change has been seen already for this window,
@@ -4314,13 +4293,15 @@ documentation for additional customization information."
4314 4293
4315(defun set-window-text-height (window height) 4294(defun set-window-text-height (window height)
4316 "Set the height in lines of the text display area of WINDOW to HEIGHT. 4295 "Set the height in lines of the text display area of WINDOW to HEIGHT.
4317HEIGHT doesn't include the mode line or header line, if any, or 4296WINDOW must be a live window. HEIGHT doesn't include the mode
4318any partial-height lines in the text display area. 4297line or header line, if any, or any partial-height lines in the
4298text display area.
4319 4299
4320Note that the current implementation of this function cannot 4300Note that the current implementation of this function cannot
4321always set the height exactly, but attempts to be conservative, 4301always set the height exactly, but attempts to be conservative,
4322by allocating more lines than are actually needed in the case 4302by allocating more lines than are actually needed in the case
4323where some error may be present." 4303where some error may be present."
4304 (setq window (normalize-live-window window))
4324 (let ((delta (- height (window-text-height window)))) 4305 (let ((delta (- height (window-text-height window))))
4325 (unless (zerop delta) 4306 (unless (zerop delta)
4326 ;; Setting window-min-height to a value like 1 can lead to very 4307 ;; Setting window-min-height to a value like 1 can lead to very
@@ -4328,36 +4309,21 @@ where some error may be present."
4328 ;; windows 1-line tall, which means that there's no more space for 4309 ;; windows 1-line tall, which means that there's no more space for
4329 ;; the modeline. 4310 ;; the modeline.
4330 (let ((window-min-height (min 2 height))) ; One text line plus a modeline. 4311 (let ((window-min-height (min 2 height))) ; One text line plus a modeline.
4331 (if (and window (not (eq window (selected-window)))) 4312 (resize-window window delta)))))
4332 (save-selected-window
4333 (select-window window 'norecord)
4334 (enlarge-window delta))
4335 (enlarge-window delta))))))
4336 4313
4337 4314(defun enlarge-window-horizontally (delta)
4338(defun enlarge-window-horizontally (columns) 4315 "Make selected window DELTA columns wider.
4339 "Make selected window COLUMNS wider.
4340Interactively, if no argument is given, make selected window one 4316Interactively, if no argument is given, make selected window one
4341column wider." 4317column wider."
4342 (interactive "p") 4318 (interactive "p")
4343 (enlarge-window columns t)) 4319 (enlarge-window delta t))
4344 4320
4345(defun shrink-window-horizontally (columns) 4321(defun shrink-window-horizontally (delta)
4346 "Make selected window COLUMNS narrower. 4322 "Make selected window DELTA columns narrower.
4347Interactively, if no argument is given, make selected window one 4323Interactively, if no argument is given, make selected window one
4348column narrower." 4324column narrower."
4349 (interactive "p") 4325 (interactive "p")
4350 (shrink-window columns t)) 4326 (shrink-window delta t))
4351
4352(defun window-buffer-height (window)
4353 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
4354 (with-current-buffer (window-buffer window)
4355 (max 1
4356 (count-screen-lines (point-min) (point-max)
4357 ;; If buffer ends with a newline, ignore it when
4358 ;; counting height unless point is after it.
4359 (eobp)
4360 window))))
4361 4327
4362(defun count-screen-lines (&optional beg end count-final-newline window) 4328(defun count-screen-lines (&optional beg end count-final-newline window)
4363 "Return the number of screen lines in the region. 4329 "Return the number of screen lines in the region.
@@ -4395,80 +4361,99 @@ in some window."
4395 (goto-char (point-min)) 4361 (goto-char (point-min))
4396 (1+ (vertical-motion (buffer-size) window)))))) 4362 (1+ (vertical-motion (buffer-size) window))))))
4397 4363
4398(defun fit-window-to-buffer (&optional window max-height min-height) 4364(defun window-buffer-height (window)
4365 "Return the height (in screen lines) of the buffer that WINDOW is displaying."
4366 (with-current-buffer (window-buffer window)
4367 (max 1
4368 (count-screen-lines (point-min) (point-max)
4369 ;; If buffer ends with a newline, ignore it when
4370 ;; counting height unless point is after it.
4371 (eobp)
4372 window))))
4373
4374;;; Resizing buffers to fit their contents exactly.
4375(defun fit-window-to-buffer (&optional window max-height min-height override)
4399 "Adjust height of WINDOW to display its buffer's contents exactly. 4376 "Adjust height of WINDOW to display its buffer's contents exactly.
4400WINDOW defaults to the selected window. 4377WINDOW can be any live window and defaults to the selected one.
4401Optional argument MAX-HEIGHT specifies the maximum height of the 4378
4402window and defaults to the maximum permissible height of a window 4379Optional argument MAX-HEIGHT specifies the maximum height of
4403on WINDOW's frame. 4380WINDOW and defaults to the height of WINDOW's frame. Optional
4404Optional argument MIN-HEIGHT specifies the minimum height of the 4381argument MIN-HEIGHT specifies the minimum height of WINDOW and
4405window and defaults to `window-min-height'. 4382defaults to `window-min-height'. Both, MAX-HEIGHT and MIN-HEIGHT
4406Both, MAX-HEIGHT and MIN-HEIGHT are specified in lines and 4383are specified in lines and include the mode line and header line,
4407include the mode line and header line, if any. 4384if any.
4408 4385
4409Return non-nil if height was orderly adjusted, nil otherwise. 4386Optional argument OVERRIDE non-nil means override restrictions
4410 4387imposed by `window-min-height' and `window-min-width' on the size
4411Caution: This function can delete WINDOW and/or other windows 4388of WINDOW.
4412when their height shrinks to less than MIN-HEIGHT." 4389
4390Return the number of lines by which WINDOW was enlarged or
4391shrunk. If an error occurs during resizing, return nil but don't
4392signal an error.
4393
4394Note that even if this function makes WINDOW large enough to show
4395_all_ lines of its buffer you might not see the first lines when
4396WINDOW was scrolled."
4413 (interactive) 4397 (interactive)
4414 ;; Do all the work in WINDOW and its buffer and restore the selected 4398 ;; Do all the work in WINDOW and its buffer and restore the selected
4415 ;; window and the current buffer when we're done. 4399 ;; window and the current buffer when we're done.
4416 (let ((old-buffer (current-buffer)) 4400 (setq window (normalize-live-window window))
4417 value) 4401 ;; Can't resize a full height or fixed-size window.
4418 (with-selected-window (or window (setq window (selected-window))) 4402 (unless (or (window-size-fixed-p window)
4419 (set-buffer (window-buffer)) 4403 (window-full-height-p window))
4420 ;; Use `condition-case' to handle any fixed-size windows and other 4404 ;; `with-selected-window' should orderly restore the current buffer.
4421 ;; pitfalls nearby. 4405 (with-selected-window window
4422 (condition-case nil 4406 ;; We are in WINDOW's buffer now.
4423 (let* (;; MIN-HEIGHT must not be less than 1 and defaults to 4407 (let* ( ;; Adjust MIN-HEIGHT.
4424 ;; `window-min-height'. 4408 (min-height
4425 (min-height (max (or min-height window-min-height) 1)) 4409 (if override
4426 (max-window-height 4410 (window-min-size window nil window)
4427 ;; Maximum height of any window on this frame. 4411 (max (or min-height window-min-height)
4428 (min (window-height (frame-root-window)) (frame-height))) 4412 window-safe-min-height)))
4429 ;; MAX-HEIGHT must not be larger than max-window-height and 4413 (max-window-height
4430 ;; defaults to max-window-height. 4414 (window-total-size (frame-root-window window)))
4431 (max-height 4415 ;; Adjust MAX-HEIGHT.
4432 (min (or max-height max-window-height) max-window-height)) 4416 (max-height
4433 (desired-height 4417 (if (or override (not max-height))
4434 ;; The height necessary to show all of WINDOW's buffer, 4418 max-window-height
4435 ;; constrained by MIN-HEIGHT and MAX-HEIGHT. 4419 (min max-height max-window-height)))
4436 (max 4420 ;; Make `desired-height' the height necessary to show
4437 (min 4421 ;; all of WINDOW's buffer, constrained by MIN-HEIGHT
4438 ;; For an empty buffer `count-screen-lines' returns zero. 4422 ;; and MAX-HEIGHT.
4439 ;; Even in that case we need one line for the cursor. 4423 (desired-height
4440 (+ (max (count-screen-lines) 1) 4424 (max
4441 ;; For non-minibuffers count the mode line, if any. 4425 (min
4442 (if (and (not (window-minibuffer-p)) mode-line-format) 4426 (+ (count-screen-lines)
4443 1 0) 4427 ;; For non-minibuffers count the mode line, if any.
4444 ;; Count the header line, if any. 4428 (if (and (not (window-minibuffer-p window))
4445 (if header-line-format 1 0)) 4429 mode-line-format)
4446 max-height) 4430 1
4447 min-height)) 4431 0)
4448 (delta 4432 ;; Count the header line, if any.
4449 ;; How much the window height has to change. 4433 (if header-line-format 1 0))
4450 (if (= (window-height) (window-height (frame-root-window))) 4434 max-height)
4451 ;; Don't try to resize a full-height window. 4435 min-height))
4452 0 4436 (desired-delta
4453 (- desired-height (window-height)))) 4437 (- desired-height (window-total-size window)))
4454 ;; Do something reasonable so `enlarge-window' can make 4438 (delta
4455 ;; windows as small as MIN-HEIGHT. 4439 (if (> desired-delta 0)
4456 (window-min-height (min min-height window-min-height))) 4440 (min desired-delta
4457 ;; Don't try to redisplay with the cursor at the end on its 4441 (window-max-delta window nil window))
4458 ;; own line--that would force a scroll and spoil things. 4442 (max desired-delta
4459 (when (and (eobp) (bolp) (not (bobp))) 4443 (- (window-min-delta window nil window))))))
4460 (set-window-point window (1- (window-point)))) 4444 ;; This `condition-case' shouldn't be necessary, but who knows?
4461 ;; Adjust WINDOW's height to the nominally correct one 4445 (condition-case nil
4462 ;; (which may actually be slightly off because of variable 4446 (if (zerop delta)
4463 ;; height text, etc). 4447 ;; Return zero if DELTA became zero in the proces.
4464 (unless (zerop delta) 4448 0
4465 (enlarge-window delta)) 4449 ;; Don't try to redisplay with the cursor at the end on its
4466 ;; `enlarge-window' might have deleted WINDOW, so make sure 4450 ;; own line--that would force a scroll and spoil things.
4467 ;; WINDOW's still alive for the remainder of this. 4451 (when (and (eobp) (bolp) (not (bobp)))
4468 ;; Note: Deleting WINDOW is clearly counter-intuitive in 4452 ;; It's silly to put `point' at the end of the previous
4469 ;; this context, but we can't do much about it given the 4453 ;; line and so maybe force horizontal scrolling.
4470 ;; current semantics of `enlarge-window'. 4454 (set-window-point window (line-beginning-position 0)))
4471 (when (window-live-p window) 4455 ;; Call `resize-window' with OVERRIDE argument equal WINDOW.
4456 (resize-window window delta nil window)
4472 ;; Check if the last line is surely fully visible. If 4457 ;; Check if the last line is surely fully visible. If
4473 ;; not, enlarge the window. 4458 ;; not, enlarge the window.
4474 (let ((end (save-excursion 4459 (let ((end (save-excursion
@@ -4486,25 +4471,15 @@ when their height shrinks to less than MIN-HEIGHT."
4486 (forward-line 0)) 4471 (forward-line 0))
4487 (point)))) 4472 (point))))
4488 (set-window-vscroll window 0) 4473 (set-window-vscroll window 0)
4474 ;; This loop might in some rare pathological cases raise
4475 ;; an error - another reason for the `condition-case'.
4489 (while (and (< desired-height max-height) 4476 (while (and (< desired-height max-height)
4490 (= desired-height (window-height)) 4477 (= desired-height (window-total-size))
4491 (not (pos-visible-in-window-p end))) 4478 (not (pos-visible-in-window-p end)))
4492 (enlarge-window 1) 4479 (resize-window window 1 nil window)
4493 (setq desired-height (1+ desired-height)))) 4480 (setq desired-height (1+ desired-height)))))
4494 ;; Return non-nil only if nothing "bad" happened. 4481 (error (setq delta nil)))
4495 (setq value t))) 4482 delta))))
4496 (error nil)))
4497 (when (buffer-live-p old-buffer)
4498 (set-buffer old-buffer))
4499 value))
4500
4501(defun window-safely-shrinkable-p (&optional window)
4502 "Return t if WINDOW can be shrunk without shrinking other windows.
4503WINDOW defaults to the selected window."
4504 (with-selected-window (or window (selected-window))
4505 (let ((edges (window-edges)))
4506 (or (= (nth 2 edges) (nth 2 (window-edges (previous-window))))
4507 (= (nth 0 edges) (nth 0 (window-edges (next-window))))))))
4508 4483
4509(defun shrink-window-if-larger-than-buffer (&optional window) 4484(defun shrink-window-if-larger-than-buffer (&optional window)
4510 "Shrink height of WINDOW if its buffer doesn't need so many lines. 4485 "Shrink height of WINDOW if its buffer doesn't need so many lines.
@@ -4512,42 +4487,28 @@ More precisely, shrink WINDOW vertically to be as small as
4512possible, while still showing the full contents of its buffer. 4487possible, while still showing the full contents of its buffer.
4513WINDOW defaults to the selected window. 4488WINDOW defaults to the selected window.
4514 4489
4515Do not shrink to less than `window-min-height' lines. Do nothing 4490Do not shrink WINDOW to less than `window-min-height' lines. Do
4516if the buffer contains more lines than the present window height, 4491nothing if the buffer contains more lines than the present window
4517or if some of the window's contents are scrolled out of view, or 4492height, or if some of the window's contents are scrolled out of
4518if shrinking this window would also shrink another window, or if 4493view, or if shrinking this window would also shrink another
4519the window is the only window of its frame. 4494window, or if the window is the only window of its frame.
4520 4495
4521Return non-nil if the window was shrunk, nil otherwise." 4496Return non-nil if the window was shrunk, nil otherwise."
4522 (interactive) 4497 (interactive)
4523 (when (null window) 4498 (setq window (normalize-live-window window))
4524 (setq window (selected-window))) 4499 ;; Make sure that WINDOW is vertically combined and `point-min' is
4525 (let* ((frame (window-frame window)) 4500 ;; visible (for whatever reason that's needed). The remaining issues
4526 (mini (frame-parameter frame 'minibuffer)) 4501 ;; should be taken care of by `fit-window-to-buffer'.
4527 (edges (window-edges window))) 4502 (when (and (window-iso-combined-p window)
4528 (if (and (not (eq window (frame-root-window frame))) 4503 (pos-visible-in-window-p (point-min) window))
4529 (window-safely-shrinkable-p window) 4504 (fit-window-to-buffer window (window-total-size window))))
4530 (pos-visible-in-window-p (point-min) window) 4505
4531 (not (eq mini 'only))
4532 (or (not mini)
4533 (let ((mini-window (minibuffer-window frame)))
4534 (or (null mini-window)
4535 (not (eq frame (window-frame mini-window)))
4536 (< (nth 3 edges)
4537 (nth 1 (window-edges mini-window)))
4538 (> (nth 1 edges)
4539 (frame-parameter frame 'menu-bar-lines))))))
4540 (fit-window-to-buffer window (window-height window)))))
4541
4542(defun kill-buffer-and-window () 4506(defun kill-buffer-and-window ()
4543 "Kill the current buffer and delete the selected window." 4507 "Kill the current buffer and delete the selected window."
4544 (interactive) 4508 (interactive)
4545 (let ((window-to-delete (selected-window)) 4509 (let ((window-to-delete (selected-window))
4546 (buffer-to-kill (current-buffer)) 4510 (buffer-to-kill (current-buffer))
4547 (delete-window-hook (lambda () 4511 (delete-window-hook (lambda () (ignore-errors (delete-window)))))
4548 (condition-case nil
4549 (delete-window)
4550 (error nil)))))
4551 (unwind-protect 4512 (unwind-protect
4552 (progn 4513 (progn
4553 (add-hook 'kill-buffer-hook delete-window-hook t t) 4514 (add-hook 'kill-buffer-hook delete-window-hook t t)
@@ -4558,10 +4519,9 @@ Return non-nil if the window was shrunk, nil otherwise."
4558 (delete-window)))) 4519 (delete-window))))
4559 ;; If the buffer is not dead for some reason (probably because 4520 ;; If the buffer is not dead for some reason (probably because
4560 ;; of a `quit' signal), remove the hook again. 4521 ;; of a `quit' signal), remove the hook again.
4561 (condition-case nil 4522 (ignore-errors
4562 (with-current-buffer buffer-to-kill 4523 (with-current-buffer buffer-to-kill
4563 (remove-hook 'kill-buffer-hook delete-window-hook t)) 4524 (remove-hook 'kill-buffer-hook delete-window-hook t))))))
4564 (error nil)))))
4565 4525
4566(defun quit-window (&optional kill window) 4526(defun quit-window (&optional kill window)
4567 "Quit WINDOW and bury its buffer. 4527 "Quit WINDOW and bury its buffer.
@@ -4584,10 +4544,9 @@ Otherwise, bury WINDOW's buffer, see `bury-buffer'."
4584 ;; try to delete it. 4544 ;; try to delete it.
4585 (let* ((window (or window (selected-window))) 4545 (let* ((window (or window (selected-window)))
4586 (frame (window-frame window))) 4546 (frame (window-frame window)))
4587 (if (eq window (frame-root-window frame)) 4547 (if (frame-root-window-p window)
4588 ;; WINDOW is alone on its frame. `delete-windows-on' 4548 ;; WINDOW is alone on its frame.
4589 ;; knows how to handle that case. 4549 (delete-frame frame)
4590 (delete-windows-on buffer frame)
4591 ;; There are other windows on its frame, delete WINDOW. 4550 ;; There are other windows on its frame, delete WINDOW.
4592 (delete-window window))) 4551 (delete-window window)))
4593 ;; Otherwise, switch to another buffer in the selected window. 4552 ;; Otherwise, switch to another buffer in the selected window.
@@ -4597,7 +4556,6 @@ Otherwise, bury WINDOW's buffer, see `bury-buffer'."
4597 (if kill 4556 (if kill
4598 (kill-buffer buffer) 4557 (kill-buffer buffer)
4599 (bury-buffer buffer)))) 4558 (bury-buffer buffer))))
4600
4601 4559
4602(defvar recenter-last-op nil 4560(defvar recenter-last-op nil
4603 "Indicates the last recenter operation performed. 4561 "Indicates the last recenter operation performed.
@@ -4689,7 +4647,6 @@ by `recenter-positions'."
4689 (move-to-window-line (round (* recenter-last-op (window-height)))))))))) 4647 (move-to-window-line (round (* recenter-last-op (window-height))))))))))
4690 4648
4691(define-key global-map [?\M-r] 'move-to-window-line-top-bottom) 4649(define-key global-map [?\M-r] 'move-to-window-line-top-bottom)
4692
4693 4650
4694;;; Scrolling commands. 4651;;; Scrolling commands.
4695 4652
@@ -4837,7 +4794,6 @@ With arg N, put point N/10 of the way from the true end."
4837 (end-of-buffer arg)) 4794 (end-of-buffer arg))
4838 (recenter '(t))) 4795 (recenter '(t)))
4839 (select-window orig-window)))) 4796 (select-window orig-window))))
4840
4841 4797
4842(defvar mouse-autoselect-window-timer nil 4798(defvar mouse-autoselect-window-timer nil
4843 "Timer used by delayed window autoselection.") 4799 "Timer used by delayed window autoselection.")
@@ -4891,62 +4847,60 @@ means suspend autoselection."
4891If the mouse position has stabilized in a non-selected window, select 4847If the mouse position has stabilized in a non-selected window, select
4892that window. The minibuffer window is selected only if the minibuffer is 4848that window. The minibuffer window is selected only if the minibuffer is
4893active. This function is run by `mouse-autoselect-window-timer'." 4849active. This function is run by `mouse-autoselect-window-timer'."
4894 (condition-case nil 4850 (ignore-errors
4895 (let* ((mouse-position (mouse-position)) 4851 (let* ((mouse-position (mouse-position))
4896 (window 4852 (window
4897 (condition-case nil 4853 (ignore-errors
4898 (window-at (cadr mouse-position) (cddr mouse-position) 4854 (window-at (cadr mouse-position) (cddr mouse-position)
4899 (car mouse-position)) 4855 (car mouse-position)))))
4900 (error nil)))) 4856 (cond
4901 (cond 4857 ((or (menu-or-popup-active-p)
4902 ((or (menu-or-popup-active-p) 4858 (and window
4903 (and window 4859 (not (coordinates-in-window-p (cdr mouse-position) window))))
4904 (not (coordinates-in-window-p (cdr mouse-position) window)))) 4860 ;; A menu / popup dialog is active or the mouse is on the scroll-bar
4905 ;; A menu / popup dialog is active or the mouse is on the scroll-bar 4861 ;; of WINDOW, temporarily suspend delayed autoselection.
4906 ;; of WINDOW, temporarily suspend delayed autoselection. 4862 (mouse-autoselect-window-start mouse-position nil t))
4907 (mouse-autoselect-window-start mouse-position nil t)) 4863 ((eq mouse-autoselect-window-state 'suspend)
4908 ((eq mouse-autoselect-window-state 'suspend) 4864 ;; Delayed autoselection was temporarily suspended, reenable it.
4909 ;; Delayed autoselection was temporarily suspended, reenable it. 4865 (mouse-autoselect-window-start mouse-position))
4910 (mouse-autoselect-window-start mouse-position)) 4866 ((and window (not (eq window (selected-window)))
4911 ((and window (not (eq window (selected-window))) 4867 (or (not (numberp mouse-autoselect-window))
4912 (or (not (numberp mouse-autoselect-window)) 4868 (and (> mouse-autoselect-window 0)
4913 (and (> mouse-autoselect-window 0) 4869 ;; If `mouse-autoselect-window' is positive, select
4914 ;; If `mouse-autoselect-window' is positive, select 4870 ;; window if the window is the same as before.
4915 ;; window if the window is the same as before. 4871 (eq window mouse-autoselect-window-window))
4916 (eq window mouse-autoselect-window-window)) 4872 ;; Otherwise select window if the mouse is at the same
4917 ;; Otherwise select window if the mouse is at the same 4873 ;; position as before. Observe that the first test after
4918 ;; position as before. Observe that the first test after 4874 ;; starting autoselection usually fails since the value of
4919 ;; starting autoselection usually fails since the value of 4875 ;; `mouse-autoselect-window-position' recorded there is the
4920 ;; `mouse-autoselect-window-position' recorded there is the 4876 ;; position where the mouse has entered the new window and
4921 ;; position where the mouse has entered the new window and 4877 ;; not necessarily where the mouse has stopped moving.
4922 ;; not necessarily where the mouse has stopped moving. 4878 (equal mouse-position mouse-autoselect-window-position))
4923 (equal mouse-position mouse-autoselect-window-position)) 4879 ;; The minibuffer is a candidate window if it's active.
4924 ;; The minibuffer is a candidate window if it's active. 4880 (or (not (window-minibuffer-p window))
4925 (or (not (window-minibuffer-p window)) 4881 (eq window (active-minibuffer-window))))
4926 (eq window (active-minibuffer-window)))) 4882 ;; Mouse position has stabilized in non-selected window: Cancel
4927 ;; Mouse position has stabilized in non-selected window: Cancel 4883 ;; delayed autoselection and try to select that window.
4928 ;; delayed autoselection and try to select that window. 4884 (mouse-autoselect-window-cancel t)
4929 (mouse-autoselect-window-cancel t) 4885 ;; Select window where mouse appears unless the selected window is the
4930 ;; Select window where mouse appears unless the selected window is the 4886 ;; minibuffer. Use `unread-command-events' in order to execute pre-
4931 ;; minibuffer. Use `unread-command-events' in order to execute pre- 4887 ;; and post-command hooks and trigger idle timers. To avoid delaying
4932 ;; and post-command hooks and trigger idle timers. To avoid delaying 4888 ;; autoselection again, set `mouse-autoselect-window-state'."
4933 ;; autoselection again, set `mouse-autoselect-window-state'." 4889 (unless (window-minibuffer-p (selected-window))
4934 (unless (window-minibuffer-p (selected-window)) 4890 (setq mouse-autoselect-window-state 'select)
4935 (setq mouse-autoselect-window-state 'select) 4891 (setq unread-command-events
4936 (setq unread-command-events 4892 (cons (list 'select-window (list window))
4937 (cons (list 'select-window (list window)) 4893 unread-command-events))))
4938 unread-command-events)))) 4894 ((or (and window (eq window (selected-window)))
4939 ((or (and window (eq window (selected-window))) 4895 (not (numberp mouse-autoselect-window))
4940 (not (numberp mouse-autoselect-window)) 4896 (equal mouse-position mouse-autoselect-window-position))
4941 (equal mouse-position mouse-autoselect-window-position)) 4897 ;; Mouse position has either stabilized in the selected window or at
4942 ;; Mouse position has either stabilized in the selected window or at 4898 ;; `mouse-autoselect-window-position': Cancel delayed autoselection.
4943 ;; `mouse-autoselect-window-position': Cancel delayed autoselection. 4899 (mouse-autoselect-window-cancel t))
4944 (mouse-autoselect-window-cancel t)) 4900 (t
4945 (t 4901 ;; Mouse position has not stabilized yet, resume delayed
4946 ;; Mouse position has not stabilized yet, resume delayed 4902 ;; autoselection.
4947 ;; autoselection. 4903 (mouse-autoselect-window-start mouse-position window))))))
4948 (mouse-autoselect-window-start mouse-position window))))
4949 (error nil)))
4950 4904
4951(defun handle-select-window (event) 4905(defun handle-select-window (event)
4952 "Handle select-window events." 4906 "Handle select-window events."
diff --git a/src/ChangeLog b/src/ChangeLog
index 46926778345..e638728a655 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,12 @@
12011-06-11 Martin Rudalics <rudalics@gmx.at>
2
3 * window.c (delete_deletable_window): Re-add.
4 (Fset_window_configuration): Rewrite to handle dead buffers and
5 consequently deletable windows.
6 (window_tree, Fwindow_tree): Remove. Supply functionality in
7 window.el.
8 (compare_window_configurations): Simplify code.
9
12011-06-11 Andreas Schwab <schwab@linux-m68k.org> 102011-06-11 Andreas Schwab <schwab@linux-m68k.org>
2 11
3 * image.c (imagemagick_load_image): Fix type mismatch. 12 * image.c (imagemagick_load_image): Fix type mismatch.
diff --git a/src/window.c b/src/window.c
index 959c1c31aa2..ae5798c7ebc 100644
--- a/src/window.c
+++ b/src/window.c
@@ -1974,6 +1974,14 @@ recombine_windows (Lisp_Object window)
1974 } 1974 }
1975 } 1975 }
1976} 1976}
1977
1978/* If WINDOW can be deleted, delete it. */
1979static Lisp_Object
1980delete_deletable_window (Lisp_Object window)
1981{
1982 if (!NILP (call1 (Qwindow_deletable_p, window)))
1983 call1 (Qdelete_window, window);
1984}
1977 1985
1978/*********************************************************************** 1986/***********************************************************************
1979 Window List 1987 Window List
@@ -5388,6 +5396,7 @@ the return value is nil. Otherwise the value is t. */)
5388 struct Lisp_Vector *saved_windows; 5396 struct Lisp_Vector *saved_windows;
5389 Lisp_Object new_current_buffer; 5397 Lisp_Object new_current_buffer;
5390 Lisp_Object frame; 5398 Lisp_Object frame;
5399 Lisp_Object auto_buffer_name;
5391 FRAME_PTR f; 5400 FRAME_PTR f;
5392 EMACS_INT old_point = -1; 5401 EMACS_INT old_point = -1;
5393 5402
@@ -5443,6 +5452,8 @@ the return value is nil. Otherwise the value is t. */)
5443 However, there is other stuff we should still try to do below. */ 5452 However, there is other stuff we should still try to do below. */
5444 if (FRAME_LIVE_P (f)) 5453 if (FRAME_LIVE_P (f))
5445 { 5454 {
5455 Lisp_Object window;
5456 Lisp_Object dead_windows = Qnil;
5446 register struct window *w; 5457 register struct window *w;
5447 register struct saved_window *p; 5458 register struct saved_window *p;
5448 struct window *root_window; 5459 struct window *root_window;
@@ -5519,7 +5530,8 @@ the return value is nil. Otherwise the value is t. */)
5519 for (k = 0; k < saved_windows->header.size; k++) 5530 for (k = 0; k < saved_windows->header.size; k++)
5520 { 5531 {
5521 p = SAVED_WINDOW_N (saved_windows, k); 5532 p = SAVED_WINDOW_N (saved_windows, k);
5522 w = XWINDOW (p->window); 5533 window = p->window;
5534 w = XWINDOW (window);
5523 w->next = Qnil; 5535 w->next = Qnil;
5524 5536
5525 if (!NILP (p->parent)) 5537 if (!NILP (p->parent))
@@ -5582,55 +5594,70 @@ the return value is nil. Otherwise the value is t. */)
5582 5594
5583 /* Reinstall the saved buffer and pointers into it. */ 5595 /* Reinstall the saved buffer and pointers into it. */
5584 if (NILP (p->buffer)) 5596 if (NILP (p->buffer))
5597 /* An internal window. */
5585 w->buffer = p->buffer; 5598 w->buffer = p->buffer;
5599 else if (!NILP (BVAR (XBUFFER (p->buffer), name)))
5600 /* If saved buffer is alive, install it. */
5601 {
5602 w->buffer = p->buffer;
5603 w->start_at_line_beg = p->start_at_line_beg;
5604 set_marker_restricted (w->start, p->start, w->buffer);
5605 set_marker_restricted (w->pointm, p->pointm, w->buffer);
5606 Fset_marker (BVAR (XBUFFER (w->buffer), mark),
5607 p->mark, w->buffer);
5608
5609 /* As documented in Fcurrent_window_configuration, don't
5610 restore the location of point in the buffer which was
5611 current when the window configuration was recorded. */
5612 if (!EQ (p->buffer, new_current_buffer)
5613 && XBUFFER (p->buffer) == current_buffer)
5614 Fgoto_char (w->pointm);
5615 }
5616 else if (!NILP (w->buffer) && !NILP (BVAR (XBUFFER (w->buffer), name)))
5617 /* Keep window's old buffer; make sure the markers are
5618 real. */
5619 {
5620 /* Set window markers at start of visible range. */
5621 if (XMARKER (w->start)->buffer == 0)
5622 set_marker_restricted (w->start, make_number (0),
5623 w->buffer);
5624 if (XMARKER (w->pointm)->buffer == 0)
5625 set_marker_restricted_both (w->pointm, w->buffer,
5626 BUF_PT (XBUFFER (w->buffer)),
5627 BUF_PT_BYTE (XBUFFER (w->buffer)));
5628 w->start_at_line_beg = Qt;
5629 }
5630 else if (STRINGP (auto_buffer_name =
5631 Fwindow_parameter (window, Qauto_buffer_name))
5632 && SCHARS (auto_buffer_name) != 0
5633 && !NILP (w->buffer = Fget_buffer_create (auto_buffer_name)))
5634 {
5635 set_marker_restricted (w->start, make_number (0), w->buffer);
5636 set_marker_restricted (w->pointm, make_number (0), w->buffer);
5637 w->start_at_line_beg = Qt;
5638 }
5586 else 5639 else
5640 /* Window has no live buffer, get one. */
5587 { 5641 {
5588 if (!NILP (BVAR (XBUFFER (p->buffer), name))) 5642 /* Get the buffer via other_buffer_safely in order to
5589 /* If saved buffer is alive, install it. */ 5643 avoid showing an unimportant buffer and, if necessary, to
5590 { 5644 recreate *scratch* in the course (part of Juanma's bs-show
5591 w->buffer = p->buffer; 5645 scenario from March 2011). */
5592 w->start_at_line_beg = p->start_at_line_beg; 5646 w->buffer = other_buffer_safely (Fcurrent_buffer ());
5593 set_marker_restricted (w->start, p->start, w->buffer); 5647 /* This will set the markers to beginning of visible
5594 set_marker_restricted (w->pointm, p->pointm, w->buffer); 5648 range. */
5595 Fset_marker (BVAR (XBUFFER (w->buffer), mark), 5649 set_marker_restricted (w->start, make_number (0), w->buffer);
5596 p->mark, w->buffer); 5650 set_marker_restricted (w->pointm, make_number (0), w->buffer);
5597 5651 w->start_at_line_beg = Qt;
5598 /* As documented in Fcurrent_window_configuration, don't 5652 if (!NILP (w->dedicated))
5599 restore the location of point in the buffer which was 5653 /* Record this window as dead. */
5600 current when the window configuration was recorded. */ 5654 dead_windows = Fcons (window, dead_windows);
5601 if (!EQ (p->buffer, new_current_buffer) 5655 /* Make sure window is no more dedicated. */
5602 && XBUFFER (p->buffer) == current_buffer) 5656 w->dedicated = Qnil;
5603 Fgoto_char (w->pointm);
5604 }
5605 else if (NILP (w->buffer) || NILP (BVAR (XBUFFER (w->buffer), name)))
5606 /* Else unless window has a live buffer, get one. */
5607 {
5608 w->buffer = Fcdr (Fcar (Vbuffer_alist));
5609 /* This will set the markers to beginning of visible
5610 range. */
5611 set_marker_restricted (w->start, make_number (0), w->buffer);
5612 set_marker_restricted (w->pointm, make_number (0),w->buffer);
5613 w->start_at_line_beg = Qt;
5614 }
5615 else
5616 /* Keeping window's old buffer; make sure the markers
5617 are real. */
5618 {
5619 /* Set window markers at start of visible range. */
5620 if (XMARKER (w->start)->buffer == 0)
5621 set_marker_restricted (w->start, make_number (0),
5622 w->buffer);
5623 if (XMARKER (w->pointm)->buffer == 0)
5624 set_marker_restricted_both (w->pointm, w->buffer,
5625 BUF_PT (XBUFFER (w->buffer)),
5626 BUF_PT_BYTE (XBUFFER (w->buffer)));
5627 w->start_at_line_beg = Qt;
5628 }
5629 } 5657 }
5630 } 5658 }
5631 5659
5632 FRAME_ROOT_WINDOW (f) = data->root_window; 5660 FRAME_ROOT_WINDOW (f) = data->root_window;
5633
5634 /* Arrange *not* to restore point in the buffer that was 5661 /* Arrange *not* to restore point in the buffer that was
5635 current when the window configuration was saved. */ 5662 current when the window configuration was saved. */
5636 if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer)) 5663 if (EQ (XWINDOW (data->current_window)->buffer, new_current_buffer))
@@ -5638,10 +5665,10 @@ the return value is nil. Otherwise the value is t. */)
5638 make_number (old_point), 5665 make_number (old_point),
5639 XWINDOW (data->current_window)->buffer); 5666 XWINDOW (data->current_window)->buffer);
5640 5667
5641 /* In the following call to `select-window, prevent "swapping 5668 /* In the following call to `select-window', prevent "swapping out
5642 out point" in the old selected window using the buffer that 5669 point" in the old selected window using the buffer that has
5643 has been restored into it. We already swapped out that point 5670 been restored into it. We already swapped out that point from
5644 from that window's old buffer. */ 5671 that window's old buffer. */
5645 select_window (data->current_window, Qnil, 1); 5672 select_window (data->current_window, Qnil, 1);
5646 BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window) 5673 BVAR (XBUFFER (XWINDOW (selected_window)->buffer), last_selected_window)
5647 = selected_window; 5674 = selected_window;
@@ -5682,9 +5709,16 @@ the return value is nil. Otherwise the value is t. */)
5682 } 5709 }
5683 5710
5684 adjust_glyphs (f); 5711 adjust_glyphs (f);
5685
5686 UNBLOCK_INPUT; 5712 UNBLOCK_INPUT;
5687 5713
5714 /* Scan dead buffer windows. */
5715 for (; CONSP (dead_windows); dead_windows = XCDR (dead_windows))
5716 {
5717 window = XCAR (dead_windows);
5718 if (WINDOW_LIVE_P (window) && !EQ (window, FRAME_ROOT_WINDOW (f)))
5719 delete_deletable_window (window);
5720 }
5721
5688 /* Fselect_window will have made f the selected frame, so we 5722 /* Fselect_window will have made f the selected frame, so we
5689 reselect the proper frame here. Fhandle_switch_frame will change the 5723 reselect the proper frame here. Fhandle_switch_frame will change the
5690 selected window too, but that doesn't make the call to 5724 selected window too, but that doesn't make the call to
@@ -5930,82 +5964,6 @@ redirection (see `redirect-frame-focus'). */)
5930 XSETWINDOW_CONFIGURATION (tem, data); 5964 XSETWINDOW_CONFIGURATION (tem, data);
5931 return (tem); 5965 return (tem);
5932} 5966}
5933
5934
5935/***********************************************************************
5936 Window Split Tree
5937 ***********************************************************************/
5938
5939static Lisp_Object
5940window_tree (struct window *w)
5941{
5942 Lisp_Object tail = Qnil;
5943 Lisp_Object result = Qnil;
5944
5945 while (w)
5946 {
5947 Lisp_Object wn;
5948
5949 XSETWINDOW (wn, w);
5950 if (!NILP (w->hchild))
5951 wn = Fcons (Qnil, Fcons (Fwindow_edges (wn),
5952 window_tree (XWINDOW (w->hchild))));
5953 else if (!NILP (w->vchild))
5954 wn = Fcons (Qt, Fcons (Fwindow_edges (wn),
5955 window_tree (XWINDOW (w->vchild))));
5956
5957 if (NILP (result))
5958 {
5959 result = tail = Fcons (wn, Qnil);
5960 }
5961 else
5962 {
5963 XSETCDR (tail, Fcons (wn, Qnil));
5964 tail = XCDR (tail);
5965 }
5966
5967 w = NILP (w->next) ? 0 : XWINDOW (w->next);
5968 }
5969
5970 return result;
5971}
5972
5973
5974
5975DEFUN ("window-tree", Fwindow_tree, Swindow_tree,
5976 0, 1, 0,
5977 doc: /* Return the window tree for frame FRAME.
5978
5979The return value is a list of the form (ROOT MINI), where ROOT
5980represents the window tree of the frame's root window, and MINI
5981is the frame's minibuffer window.
5982
5983If the root window is not split, ROOT is the root window itself.
5984Otherwise, ROOT is a list (DIR EDGES W1 W2 ...) where DIR is nil for a
5985horizontal split, and t for a vertical split, EDGES gives the combined
5986size and position of the subwindows in the split, and the rest of the
5987elements are the subwindows in the split. Each of the subwindows may
5988again be a window or a list representing a window split, and so on.
5989EDGES is a list \(LEFT TOP RIGHT BOTTOM) as returned by `window-edges'.
5990
5991If FRAME is nil or omitted, return information on the currently
5992selected frame. */)
5993 (Lisp_Object frame)
5994{
5995 FRAME_PTR f;
5996
5997 if (NILP (frame))
5998 frame = selected_frame;
5999
6000 CHECK_FRAME (frame);
6001 f = XFRAME (frame);
6002
6003 if (!FRAME_LIVE_P (f))
6004 return Qnil;
6005
6006 return window_tree (XWINDOW (FRAME_ROOT_WINDOW (f)));
6007}
6008
6009 5967
6010/*********************************************************************** 5968/***********************************************************************
6011 Marginal Areas 5969 Marginal Areas
@@ -6365,116 +6323,82 @@ freeze_window_starts (struct frame *f, int freeze_p)
6365 Initialization 6323 Initialization
6366 ***********************************************************************/ 6324 ***********************************************************************/
6367 6325
6368/* Return 1 if window configurations C1 and C2 6326/* Return 1 if window configurations CONFIGURATION1 and CONFIGURATION2
6369 describe the same state of affairs. This is used by Fequal. */ 6327 describe the same state of affairs. This is used by Fequal.
6328
6329 ignore_positions non-zero means ignore non-matching scroll positions
6330 and the like.
6331
6332 This ignores a couple of things like the dedicatedness status of
6333 window, splits, nest and the like. This might have to be fixed. */
6370 6334
6371int 6335int
6372compare_window_configurations (Lisp_Object c1, Lisp_Object c2, int ignore_positions) 6336compare_window_configurations (Lisp_Object configuration1, Lisp_Object configuration2, int ignore_positions)
6373{ 6337{
6374 register struct save_window_data *d1, *d2; 6338 register struct save_window_data *d1, *d2;
6375 struct Lisp_Vector *sw1, *sw2; 6339 struct Lisp_Vector *sws1, *sws2;
6376 int i; 6340 int i;
6377 6341
6378 CHECK_WINDOW_CONFIGURATION (c1); 6342 CHECK_WINDOW_CONFIGURATION (configuration1);
6379 CHECK_WINDOW_CONFIGURATION (c2); 6343 CHECK_WINDOW_CONFIGURATION (configuration2);
6380 6344
6381 d1 = (struct save_window_data *) XVECTOR (c1); 6345 d1 = (struct save_window_data *) XVECTOR (configuration1);
6382 d2 = (struct save_window_data *) XVECTOR (c2); 6346 d2 = (struct save_window_data *) XVECTOR (configuration2);
6383 sw1 = XVECTOR (d1->saved_windows); 6347 sws1 = XVECTOR (d1->saved_windows);
6384 sw2 = XVECTOR (d2->saved_windows); 6348 sws2 = XVECTOR (d2->saved_windows);
6385 6349
6386 if (d1->frame_cols != d2->frame_cols) 6350 /* Frame settings must match. */
6387 return 0; 6351 if (d1->frame_cols != d2->frame_cols
6388 if (d1->frame_lines != d2->frame_lines) 6352 || d1->frame_lines != d2->frame_lines
6389 return 0; 6353 || d1->frame_menu_bar_lines != d2->frame_menu_bar_lines
6390 if (d1->frame_menu_bar_lines != d2->frame_menu_bar_lines) 6354 || !EQ (d1->selected_frame, d2->selected_frame)
6391 return 0; 6355 || !EQ (d1->current_buffer, d2->current_buffer)
6392 if (! EQ (d1->selected_frame, d2->selected_frame)) 6356 || (!ignore_positions
6393 return 0; 6357 && (!EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window)
6394 /* Don't compare the current_window field directly. 6358 || !EQ (d1->minibuf_selected_window, d2->minibuf_selected_window)))
6395 Instead see w1_is_current and w2_is_current, below. */ 6359 || !EQ (d1->focus_frame, d2->focus_frame)
6396 if (! EQ (d1->current_buffer, d2->current_buffer)) 6360 /* Verify that the two configurations have the same number of windows. */
6397 return 0; 6361 || sws1->header.size != sws2->header.size)
6398 if (! ignore_positions)
6399 {
6400 if (! EQ (d1->minibuf_scroll_window, d2->minibuf_scroll_window))
6401 return 0;
6402 if (! EQ (d1->minibuf_selected_window, d2->minibuf_selected_window))
6403 return 0;
6404 }
6405 /* Don't compare the root_window field.
6406 We don't require the two configurations
6407 to use the same window object,
6408 and the two root windows must be equivalent
6409 if everything else compares equal. */
6410 if (! EQ (d1->focus_frame, d2->focus_frame))
6411 return 0; 6362 return 0;
6412 6363
6413 /* Verify that the two confis have the same number of windows. */ 6364 for (i = 0; i < sws1->header.size; i++)
6414 if (sw1->header.size != sw2->header.size)
6415 return 0;
6416
6417 for (i = 0; i < sw1->header.size; i++)
6418 { 6365 {
6419 struct saved_window *p1, *p2; 6366 struct saved_window *sw1, *sw2;
6420 int w1_is_current, w2_is_current; 6367 int w1_is_current, w2_is_current;
6421 6368
6422 p1 = SAVED_WINDOW_N (sw1, i); 6369 sw1 = SAVED_WINDOW_N (sws1, i);
6423 p2 = SAVED_WINDOW_N (sw2, i); 6370 sw2 = SAVED_WINDOW_N (sws2, i);
6424 6371
6425 /* Verify that the current windows in the two 6372 if (
6426 configurations correspond to each other. */ 6373 /* The "current" windows in the two configurations must
6427 w1_is_current = EQ (d1->current_window, p1->window); 6374 correspond to each other. */
6428 w2_is_current = EQ (d2->current_window, p2->window); 6375 EQ (d1->current_window, sw1->window)
6429 6376 != EQ (d2->current_window, sw2->window)
6430 if (w1_is_current != w2_is_current) 6377 /* Windows' buffers must match. */
6431 return 0; 6378 || !EQ (sw1->buffer, sw2->buffer)
6432 6379 || !EQ (sw1->left_col, sw2->left_col)
6433 /* Verify that the corresponding windows do match. */ 6380 || !EQ (sw1->top_line, sw2->top_line)
6434 if (! EQ (p1->buffer, p2->buffer)) 6381 || !EQ (sw1->total_cols, sw2->total_cols)
6435 return 0; 6382 || !EQ (sw1->total_lines, sw2->total_lines)
6436 if (! EQ (p1->left_col, p2->left_col)) 6383 || !EQ (sw1->display_table, sw2->display_table)
6437 return 0; 6384 /* The next two disjuncts check the window structure for
6438 if (! EQ (p1->top_line, p2->top_line)) 6385 equality. */
6439 return 0; 6386 || !EQ (sw1->parent, sw2->parent)
6440 if (! EQ (p1->total_cols, p2->total_cols)) 6387 || !EQ (sw1->prev, sw2->prev)
6441 return 0; 6388 || (!ignore_positions
6442 if (! EQ (p1->total_lines, p2->total_lines)) 6389 && (!EQ (sw1->hscroll, sw2->hscroll)
6443 return 0; 6390 || !EQ (sw1->min_hscroll, sw2->min_hscroll)
6444 if (! EQ (p1->display_table, p2->display_table)) 6391 || !EQ (sw1->start_at_line_beg, sw2->start_at_line_beg)
6445 return 0; 6392 || NILP (Fequal (sw1->start, sw2->start))
6446 if (! EQ (p1->parent, p2->parent)) 6393 || NILP (Fequal (sw1->pointm, sw2->pointm))
6447 return 0; 6394 || NILP (Fequal (sw1->mark, sw2->mark))))
6448 if (! EQ (p1->prev, p2->prev)) 6395 || !EQ (sw1->left_margin_cols, sw2->left_margin_cols)
6449 return 0; 6396 || !EQ (sw1->right_margin_cols, sw2->right_margin_cols)
6450 if (! ignore_positions) 6397 || !EQ (sw1->left_fringe_width, sw2->left_fringe_width)
6451 { 6398 || !EQ (sw1->right_fringe_width, sw2->right_fringe_width)
6452 if (! EQ (p1->hscroll, p2->hscroll)) 6399 || !EQ (sw1->fringes_outside_margins, sw2->fringes_outside_margins)
6453 return 0; 6400 || !EQ (sw1->scroll_bar_width, sw2->scroll_bar_width)
6454 if (!EQ (p1->min_hscroll, p2->min_hscroll)) 6401 || !EQ (sw1->vertical_scroll_bar_type, sw2->vertical_scroll_bar_type))
6455 return 0;
6456 if (! EQ (p1->start_at_line_beg, p2->start_at_line_beg))
6457 return 0;
6458 if (NILP (Fequal (p1->start, p2->start)))
6459 return 0;
6460 if (NILP (Fequal (p1->pointm, p2->pointm)))
6461 return 0;
6462 if (NILP (Fequal (p1->mark, p2->mark)))
6463 return 0;
6464 }
6465 if (! EQ (p1->left_margin_cols, p2->left_margin_cols))
6466 return 0;
6467 if (! EQ (p1->right_margin_cols, p2->right_margin_cols))
6468 return 0;
6469 if (! EQ (p1->left_fringe_width, p2->left_fringe_width))
6470 return 0;
6471 if (! EQ (p1->right_fringe_width, p2->right_fringe_width))
6472 return 0;
6473 if (! EQ (p1->fringes_outside_margins, p2->fringes_outside_margins))
6474 return 0;
6475 if (! EQ (p1->scroll_bar_width, p2->scroll_bar_width))
6476 return 0;
6477 if (! EQ (p1->vertical_scroll_bar_type, p2->vertical_scroll_bar_type))
6478 return 0; 6402 return 0;
6479 } 6403 }
6480 6404
@@ -6768,7 +6692,6 @@ function `window-nest' and altered by the function `set-window-nest'. */);
6768 defsubr (&Swindow_configuration_frame); 6692 defsubr (&Swindow_configuration_frame);
6769 defsubr (&Sset_window_configuration); 6693 defsubr (&Sset_window_configuration);
6770 defsubr (&Scurrent_window_configuration); 6694 defsubr (&Scurrent_window_configuration);
6771 defsubr (&Swindow_tree);
6772 defsubr (&Sset_window_margins); 6695 defsubr (&Sset_window_margins);
6773 defsubr (&Swindow_margins); 6696 defsubr (&Swindow_margins);
6774 defsubr (&Sset_window_fringes); 6697 defsubr (&Sset_window_fringes);