Mercurial > hg > xemacs-beta
annotate lisp/window-xemacs.el @ 4444:715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
2008-04-12 Henry S. Thompson <ht@inf.ed.ac.uk>
* window-xemacs.el (real-split-window, real-delete-window): Define
these to the original definitions of `split-window' and
`delete-window', and use them in the window-configuration code to
make sure it doesn't get affected by advice to these functions.
| author | Mike Sperber <sperber@deinprogramm.de> |
|---|---|
| date | Sat, 12 Apr 2008 16:41:38 +0200 |
| parents | 2785829fe37c |
| children | 1d41b9bcf74f |
| rev | line source |
|---|---|
| 428 | 1 ;;; window-xemacs.el --- XEmacs window commands aside from those written in C. |
| 2 | |
| 3 ;; Copyright (C) 1985, 1989, 1993-94, 1997 Free Software Foundation, Inc. | |
| 4 ;; Copyright (C) 1995, 1996 Ben Wing. | |
| 5 | |
| 6 ;; Maintainer: XEmacs Development Team | |
| 7 ;; Keywords: frames, extensions, dumped | |
| 8 | |
| 9 ;; This file is part of XEmacs. | |
| 10 | |
| 11 ;; XEmacs is free software; you can redistribute it and/or modify it | |
| 12 ;; under the terms of the GNU General Public License as published by | |
| 13 ;; the Free Software Foundation; either version 2, or (at your option) | |
| 14 ;; any later version. | |
| 15 | |
| 16 ;; XEmacs is distributed in the hope that it will be useful, but | |
| 17 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
| 19 ;; General Public License for more details. | |
| 20 | |
| 21 ;; You should have received a copy of the GNU General Public License | |
| 22 ;; along with XEmacs; see the file COPYING. If not, write to the | |
| 23 ;; Free Software Foundation, 59 Temple Place - Suite 330, | |
| 24 ;; Boston, MA 02111-1307, USA. | |
| 25 | |
| 26 ;;; Synched up with: Not synched. | |
| 27 | |
| 28 ;;; Commentary: | |
| 29 | |
| 30 ;; This file is dumped with XEmacs. | |
| 31 | |
| 32 ;; slb - 5/29/97 | |
| 33 ;; Split apart from window.el in order to keep that file better in synch | |
| 34 ;; with Emacs. | |
| 35 | |
| 36 ;;; Code: | |
| 37 | |
| 38 (defgroup windows nil | |
| 39 "Windows within a frame." | |
| 40 :group 'environment) | |
| 41 | |
| 42 (defun recenter (&optional n window) | |
| 43 "Center point in WINDOW and redisplay frame. With N, put point on line N. | |
| 44 The desired position of point is always relative to the window. | |
| 45 Just C-u as prefix means put point in the center of the window. | |
| 46 No N (i.e., it is nil) erases the entire frame and then | |
| 47 redraws with point in the center of the window. | |
| 48 If WINDOW is nil, the selected window is used." | |
| 49 (interactive "_P") | |
| 50 (center-to-window-line (if (consp n) nil n) window) | |
| 51 (when (null n) | |
| 52 (redraw-frame (window-frame window) t))) | |
| 53 | |
| 444 | 54 (defun backward-other-window (count &optional which-frames which-devices) |
| 55 "Select the COUNT'th different window on this frame, going backwards. | |
| 56 This is just like calling `other-window' with COUNT negated." | |
| 428 | 57 (interactive "p") |
| 444 | 58 (other-window (- count) which-frames which-devices)) |
| 428 | 59 |
| 60 (defalias 'windows-of-buffer 'get-buffer-window-list) | |
| 61 | |
| 62 (defun buffer-in-multiple-windows-p (&optional buffer) | |
| 63 "Return t if BUFFER is in multiple windows. | |
| 64 If BUFFER is not specified, the current buffer will be used." | |
| 65 (setq buffer (or buffer | |
| 66 (get-buffer buffer) | |
| 67 (get-file-buffer buffer) | |
| 68 (current-buffer))) | |
| 69 (> (length (windows-of-buffer buffer)) 1)) | |
| 70 | |
| 71 (defun window-list (&optional frame minibuf window) | |
| 72 "Return a list of windows on FRAME, beginning with WINDOW. | |
| 73 FRAME and WINDOW default to the selected ones. | |
| 74 Optional second arg MINIBUF t means count the minibuffer window | |
| 75 even if not active. If MINIBUF is neither t nor nil it means | |
| 76 not to count the minibuffer even if it is active." | |
| 1261 | 77 (setq frame (or frame (selected-frame)) |
| 78 window (or window (selected-window frame))) | |
| 428 | 79 (if (not (eq (window-frame window) frame)) |
| 80 (error "Window must be on frame.")) | |
| 81 (let ((current-frame (selected-frame)) | |
| 82 list) | |
| 83 (unwind-protect | |
| 84 (save-window-excursion | |
| 85 (select-frame frame) | |
| 86 (walk-windows | |
| 87 (function (lambda (cur-window) | |
| 88 (if (not (eq window cur-window)) | |
| 89 (setq list (cons cur-window list))))) | |
| 90 minibuf) | |
| 91 (setq list (cons window list))) | |
| 92 (select-frame current-frame)))) | |
| 93 | |
| 94 ;; We used to have set-window-dedicated-p as an obsolete version | |
| 95 ;; of set-window-buffer-dedicated, but it really makes more sense | |
| 96 ;; this way. | |
| 97 | |
| 98 (make-obsolete 'set-window-buffer-dedicated 'set-window-dedicated-p) | |
| 99 (defun set-window-buffer-dedicated (window buffer) | |
| 100 "Make WINDOW display BUFFER and be dedicated to that buffer. | |
| 101 Then Emacs will not automatically change which buffer appears in WINDOW. | |
| 102 If BUFFER is nil, make WINDOW not be dedicated (but don't change which | |
| 103 buffer appears in it currently)." | |
| 104 (if (bufferp buffer) | |
| 105 (set-window-buffer window (get-buffer-create buffer))) | |
| 106 (set-window-dedicated-p window (not (null buffer)))) | |
| 1149 | 107 |
| 108 ;; Window configurations | |
| 428 | 109 |
| 3646 | 110 (defcustom window-configuration-includes-position nil |
| 111 "*Whether restoring window configurations will restore positions too. | |
| 112 If nil, only the size of windows will be restored. | |
| 113 | |
| 114 Note that setting this value to t may have counterintuitive consequences, | |
| 115 if a window manager employing virtual desktops is in use." | |
| 116 :type 'boolean | |
| 117 :group 'windows) | |
| 118 | |
| 1149 | 119 (defstruct saved-window |
| 120 currentp minibufferp minibuffer-scrollp | |
| 121 buffer mark-marker | |
| 122 start-marker | |
| 123 point-marker | |
| 124 pixel-left pixel-top pixel-right pixel-bottom | |
| 125 hscroll modeline-hscroll | |
| 126 dedicatedp | |
| 127 first-hchild first-vchild next-child) | |
| 128 | |
| 129 (defstruct window-configuration | |
| 130 frame | |
| 2872 | 131 frame-top frame-left |
| 1149 | 132 frame-pixel-width frame-pixel-height |
| 133 current-buffer | |
| 134 minibuffer-pixel-height | |
| 135 min-width min-height | |
| 136 saved-root-window) | |
| 137 | |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
138 ; make sure we don't get affected by harmful advice |
|
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
139 (fset 'real-split-window (symbol-function 'split-window)) |
|
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
140 (fset 'real-delete-window (symbol-function 'delete-window)) |
|
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
141 |
| 1149 | 142 (defun window-configuration-equal (conf-1 conf-2) |
| 143 "Returns a boolean indicating whether the two given configurations | |
| 3646 | 144 are identical. |
| 145 | |
| 146 Window configurations containing windows with different window | |
| 147 positions are not identical iff `window-configuration-includes-position' | |
| 148 is t." | |
| 1149 | 149 (or (eq conf-1 conf-2) |
| 150 (and (eq (window-configuration-frame conf-1) | |
| 151 (window-configuration-frame conf-2)) | |
| 152 (= (window-configuration-frame-pixel-width conf-1) | |
| 153 (window-configuration-frame-pixel-width conf-2)) | |
| 154 (= (window-configuration-frame-pixel-height conf-1) | |
| 155 (window-configuration-frame-pixel-height conf-2)) | |
| 3646 | 156 (if window-configuration-includes-position |
| 157 (and (equal (window-configuration-frame-top conf-1) | |
| 158 (window-configuration-frame-top conf-2)) | |
| 159 (equal (window-configuration-frame-left conf-1) | |
| 160 (window-configuration-frame-left conf-2))) | |
| 161 t) | |
| 1149 | 162 (eq (window-configuration-current-buffer conf-1) |
| 163 (window-configuration-current-buffer conf-2)) | |
| 164 (saved-window-equal (window-configuration-saved-root-window conf-1) | |
| 165 (window-configuration-saved-root-window conf-2))))) | |
| 166 | |
| 167 (defun saved-window-equal (saved-1 saved-2) | |
| 168 "Returns a boolean indicating whether the two given saved windows | |
| 169 are identical." | |
| 170 (or (eq saved-1 saved-2) | |
| 171 (and (eq (saved-window-currentp saved-1) | |
| 172 (saved-window-currentp saved-2)) | |
| 173 (eq (saved-window-minibuffer-scrollp saved-1) | |
| 174 (saved-window-minibuffer-scrollp saved-2)) | |
| 175 (eq (saved-window-buffer saved-1) | |
| 176 (saved-window-buffer saved-2)) | |
| 177 (equal (saved-window-mark-marker saved-1) | |
| 178 (saved-window-mark-marker saved-2)) | |
| 179 (or (and (saved-window-currentp saved-1) | |
| 180 (saved-window-currentp saved-2)) | |
| 181 (equal (saved-window-start-marker saved-1) | |
| 182 (saved-window-start-marker saved-2))) | |
| 183 (or (and (saved-window-currentp saved-1) | |
| 184 (saved-window-currentp saved-2)) | |
| 185 (equal (saved-window-point-marker saved-1) | |
| 186 (saved-window-point-marker saved-2))) | |
| 187 (= (saved-window-pixel-left saved-1) | |
| 188 (saved-window-pixel-left saved-2)) | |
| 189 (= (saved-window-pixel-top saved-1) | |
| 190 (saved-window-pixel-top saved-2)) | |
| 191 (= (saved-window-pixel-right saved-1) | |
| 192 (saved-window-pixel-right saved-2)) | |
| 193 (= (saved-window-pixel-bottom saved-1) | |
| 194 (saved-window-pixel-bottom saved-2)) | |
| 195 (= (saved-window-hscroll saved-1) | |
| 196 (saved-window-hscroll saved-2)) | |
| 1387 | 197 (equal (saved-window-modeline-hscroll saved-1) |
| 198 (saved-window-modeline-hscroll saved-2)) | |
| 1149 | 199 (eq (saved-window-dedicatedp saved-1) |
| 200 (saved-window-dedicatedp saved-2)) | |
| 201 (maybe-saved-window-equal (saved-window-first-hchild saved-1) | |
| 202 (saved-window-first-hchild saved-2)) | |
| 203 (maybe-saved-window-equal (saved-window-first-vchild saved-1) | |
| 204 (saved-window-first-vchild saved-2)) | |
| 205 (maybe-saved-window-equal (saved-window-next-child saved-1) | |
| 206 (saved-window-next-child saved-2))))) | |
| 207 | |
| 208 (defun maybe-saved-window-equal (maybe-saved-1 maybe-saved-2) | |
| 209 "Returns a boolean indicating whether the two given saved windows | |
| 210 or NILs are identical." | |
| 211 (cond | |
| 212 ((and (not maybe-saved-1) (not maybe-saved-2)) t) | |
| 213 ((not maybe-saved-1) (not maybe-saved-2)) | |
| 214 ((not maybe-saved-2) (not maybe-saved-1)) | |
| 215 (t (saved-window-equal maybe-saved-1 maybe-saved-2)))) | |
| 216 | |
| 217 (defun current-window-configuration (&optional frame) | |
| 218 "Return an object representing the current window configuration of FRAME. | |
| 219 If FRAME is nil or omitted, use the selected frame. | |
| 220 This describes the number of windows, their sizes and current buffers, | |
| 221 and for each window on FRAME the displayed buffer, where display | |
| 222 starts, and the positions of point and mark. | |
| 223 An exception is made for point in the current buffer: | |
| 224 its value is -not- saved." | |
| 225 (let ((frame (or frame (selected-frame)))) | |
| 226 ;; The original C code used complicated but still incomplete logic | |
| 227 ;; to decide if and how to restore the size of the minibuffer. It | |
| 228 ;; goes something like this: | |
| 229 ; (let ((real-font-height | |
| 230 ; (font-height (face-font 'default) frame)) | |
| 231 ; (minibuffer-height | |
| 232 ; (if (and (minibuffer-window frame) | |
| 233 ; (not (frame-minibuffer-only-p frame))) | |
| 234 ; (window-pixel-height (minibuffer-window frame)) | |
| 235 ; 0))) | |
| 236 ; ...) | |
| 237 | |
| 238 (make-window-configuration | |
| 239 :frame frame | |
| 2885 | 240 :frame-top (frame-property frame 'top) |
| 241 :frame-left (frame-property frame 'left) | |
| 1149 | 242 :frame-pixel-width (frame-pixel-width frame) |
| 243 :frame-pixel-height (frame-pixel-height frame) | |
| 244 :current-buffer (current-buffer) | |
| 245 :min-width window-min-width :min-height window-min-height | |
| 246 :minibuffer-pixel-height (window-pixel-height (minibuffer-window frame)) | |
| 247 ;; this tries to do what the old code did: | |
| 248 ; :minibuffer-height (if (zerop (% minibuffer-height real-font-height)) | |
| 249 ; (- (/ minibuffer-height real-font-height)) ; lines | |
| 250 ; minibuffer-height) ; pixels | |
| 251 :saved-root-window (root-window->saved-window (frame-root-window frame))))) | |
| 252 | |
| 253 (defun root-window->saved-window (window) | |
| 254 "Converts a root window into a tree of saved-window structures." | |
| 255 (let ((buffer (window-buffer window)) | |
| 256 (edges (window-pixel-edges window))) | |
| 257 (let ((left (nth 0 edges)) | |
| 258 (top (nth 1 edges)) | |
| 259 (right (nth 2 edges)) | |
| 260 (bottom (nth 3 edges))) | |
| 261 (let ((saved-window | |
| 262 (make-saved-window | |
| 263 :currentp (eq window (selected-window (window-frame window))) | |
| 264 :minibufferp (eq window (minibuffer-window (window-frame window))) | |
| 265 :minibuffer-scrollp (eq window minibuffer-scroll-window) | |
| 266 :buffer buffer | |
| 267 :pixel-left left :pixel-top top :pixel-right right :pixel-bottom bottom | |
| 268 :hscroll (window-hscroll window) | |
| 269 :modeline-hscroll (modeline-hscroll window) | |
| 270 :dedicatedp (window-dedicated-p window) | |
| 271 :first-hchild (if (window-first-hchild window) | |
| 272 (root-window->saved-window (window-first-hchild window)) | |
| 273 nil) | |
| 274 :first-vchild (if (window-first-vchild window) | |
| 275 (root-window->saved-window (window-first-vchild window)) | |
| 276 nil) | |
| 277 :next-child (if (window-next-child window) | |
| 278 (root-window->saved-window (window-next-child window)) | |
| 279 nil)))) | |
| 280 (if buffer | |
| 281 (progn | |
| 282 (let ((marker (make-marker))) | |
| 283 (set-marker marker (window-start window) buffer) | |
| 284 (setf (saved-window-start-marker saved-window) marker)) | |
| 4136 | 285 (if (not (eq buffer (current-buffer))) |
| 286 (let ((marker (make-marker))) | |
| 287 (set-marker marker (window-point window) buffer) | |
| 288 (setf (saved-window-point-marker saved-window) marker))) | |
| 1149 | 289 (setf (saved-window-mark-marker saved-window) |
| 290 (copy-marker (mark-marker t buffer))))) | |
| 291 saved-window)))) | |
| 292 | |
| 293 (defun set-window-configuration (configuration) | |
| 294 "Set the configuration of windows and buffers as specified by CONFIGURATION. | |
| 295 CONFIGURATION must be a value previously returned | |
| 296 by `current-window-configuration'." | |
| 297 (let ((frame (window-configuration-frame configuration))) | |
| 298 (if (and (frame-live-p frame) | |
| 299 (not (window-configuration-equal configuration | |
| 300 (current-window-configuration)))) | |
| 301 (really-set-window-configuration frame configuration)))) | |
| 302 | |
| 303 (defun really-set-window-configuration (frame configuration) | |
| 304 "Set the window configuration CONFIGURATION on live frame FRAME." | |
| 305 ;; avoid potential temporary problems | |
| 306 (setq window-min-width 0) | |
| 307 (setq window-min-height 0) | |
| 308 (setq minibuffer-scroll-window nil) | |
| 309 | |
| 310 (frame-reduce-to-one-window frame) | |
| 311 (set-window-configuration-frame-size configuration) | |
| 2888 | 312 |
| 313 ; avoid setting these if they're already up-to-date | |
| 314 ; This also avoids potential inaccuracies in these settings --Mike | |
| 3646 | 315 (when window-configuration-includes-position |
| 316 (let ((left (window-configuration-frame-left configuration)) | |
| 317 (top (window-configuration-frame-top configuration))) | |
| 318 (if (not (equal left (frame-property frame 'left))) | |
| 319 (set-frame-property frame 'left left)) | |
| 320 (if (not (equal top (frame-property frame 'top))) | |
| 321 (set-frame-property frame 'top top)))) | |
| 1149 | 322 |
| 323 ;; these may have changed because of the delete | |
| 324 (let ((root-window (frame-root-window frame))) | |
| 325 (enlarge-window-pixels | |
| 326 (- (window-configuration-minibuffer-pixel-height configuration) | |
| 327 (window-pixel-height (minibuffer-window frame))) | |
| 328 nil | |
| 329 (minibuffer-window frame)) | |
| 330 | |
| 331 ;; avoid that `set-window-point' will set the buffer's point for | |
| 332 ;; the selected window | |
| 333 (select-window (minibuffer-window frame)) | |
| 334 | |
| 335 (let ((window-configuration-current-window nil)) | |
| 1261 | 336 (declare (special window-configuration-current-window)) |
| 1149 | 337 (restore-saved-window configuration |
| 338 root-window | |
| 339 (window-configuration-saved-root-window configuration) | |
| 340 'vertical) | |
| 341 (if window-configuration-current-window | |
| 342 (select-window window-configuration-current-window)))) | |
| 343 | |
| 344 (setq window-min-width (window-configuration-min-width configuration)) | |
| 345 (setq window-min-height (window-configuration-min-height configuration)) | |
| 346 | |
| 2227 | 347 (let ((buffer (window-configuration-current-buffer configuration))) |
| 348 (if (buffer-live-p buffer) | |
| 349 (set-buffer buffer) | |
| 350 (set-buffer (car (buffer-list)))))) | |
| 1149 | 351 |
| 352 (defun set-window-configuration-frame-size (configuration) | |
| 353 "Restore the frame size of a window configuration." | |
| 354 (set-frame-pixel-size | |
| 355 (window-configuration-frame configuration) | |
| 356 (window-configuration-frame-pixel-width configuration) | |
| 357 (window-configuration-frame-pixel-height configuration))) | |
| 358 | |
| 359 (defun frame-reduce-to-one-window (frame) | |
| 360 "Delete all windows except the minibuffer and one other in FRAME." | |
| 361 (let* ((root-window (frame-root-window frame)) | |
| 362 (combination-start (or (window-first-hchild root-window) | |
| 363 (window-first-vchild root-window)))) | |
| 364 (if combination-start | |
| 365 (window-reduce-to-one combination-start)))) | |
| 366 | |
| 1230 | 367 ;; Note that simply using `delete-other-windows' causes obscure |
| 368 ;; breakage. --Mike | |
| 369 | |
| 1149 | 370 (defun window-reduce-to-one (window) |
| 371 "Make sure only one subwindow of WINDOW is left." | |
| 1230 | 372 (let ((window (window-next-child window))) |
| 373 (while window | |
| 374 (if (window-live-p window) | |
| 375 (let ((next (window-next-child window))) | |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
376 (real-delete-window window) |
| 1230 | 377 (setq window next))))) |
| 378 (cond | |
| 379 ((window-first-hchild window) | |
| 380 (window-reduce-to-one (window-first-hchild window))) | |
| 381 ((window-first-vchild window) | |
| 382 (window-reduce-to-one (window-first-vchild window))))) | |
| 1149 | 383 |
| 384 (defun restore-saved-window (configuration window saved-window direction) | |
| 385 "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW." | |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
386 (cond |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
387 ((and (saved-window-next-child saved-window) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
388 (not (saved-window-minibufferp (saved-window-next-child saved-window)))) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
389 (cond ((eq direction 'vertical) |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
390 (real-split-window window nil nil)) |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
391 ((eq direction 'horizontal) |
|
4444
715c3ced8fa8
Use `real-split-window', `real-delete-window' in window-config code.
Mike Sperber <sperber@deinprogramm.de>
parents:
4438
diff
changeset
|
392 (real-split-window window nil t))) |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
393 (if (not (saved-window-minibufferp saved-window)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
394 (restore-saved-window-parameters configuration window saved-window)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
395 (restore-saved-window configuration |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
396 (window-next-child window) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
397 (saved-window-next-child saved-window) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
398 direction)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
399 ((not (saved-window-minibufferp saved-window)) |
|
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
400 (restore-saved-window-parameters configuration window saved-window))) |
| 1149 | 401 |
| 1576 | 402 (if (saved-window-first-hchild saved-window) |
| 403 (restore-saved-window configuration | |
| 404 window | |
| 405 (saved-window-first-hchild saved-window) | |
| 406 'horizontal)) | |
| 407 (if (saved-window-first-vchild saved-window) | |
| 408 (restore-saved-window configuration | |
| 409 window | |
| 410 (saved-window-first-vchild saved-window) | |
|
4438
2785829fe37c
Fix window-configuration problem.
Mike Sperber <sperber@deinprogramm.de>
parents:
4136
diff
changeset
|
411 'vertical))) |
| 1149 | 412 |
| 413 (defun restore-saved-window-parameters (configuration window saved-window) | |
| 414 "Restore the window parameters stored in SAVED-WINDOW on WINDOW." | |
| 1261 | 415 (declare (special window-configuration-current-window)) |
| 1149 | 416 (let ((buffer (saved-window-buffer saved-window))) |
| 417 (if (and buffer (buffer-live-p buffer)) | |
| 418 (progn | |
| 419 (set-window-buffer window | |
| 420 (saved-window-buffer saved-window)) | |
| 421 (set-window-start window | |
| 1161 | 422 (marker-position (saved-window-start-marker saved-window)) |
| 423 t) | |
| 4136 | 424 (if (markerp (saved-window-point-marker saved-window)) |
| 425 (set-window-point window | |
| 426 (marker-position (saved-window-point-marker saved-window)))) | |
| 1149 | 427 (set-marker (mark-marker t buffer) |
| 428 (marker-position (saved-window-mark-marker saved-window)) | |
| 429 buffer) | |
| 430 (if (not (eq buffer (window-configuration-current-buffer configuration))) | |
| 431 (goto-char (window-point window) buffer))))) | |
| 432 | |
| 433 (if (and (not (saved-window-first-hchild saved-window)) | |
| 434 (not (saved-window-first-vchild saved-window))) | |
| 435 ;; only set size for non-container windows | |
| 436 (progn | |
| 437 ;; If this is the root window, it may be the only window. | |
| 438 ;; Because of mismatches between actual and reported frame | |
| 439 ;; size, it may not let us actually set the size of the root | |
| 440 ;; window to what we want. --Mike | |
| 441 (if (not (eq window (frame-root-window (window-frame window)))) | |
| 442 (progn | |
| 443 (enlarge-window-pixels (- (saved-window-pixel-width saved-window) | |
| 444 (window-pixel-width window)) | |
| 445 t | |
| 446 window) | |
| 447 (enlarge-window-pixels (- (saved-window-pixel-height saved-window) | |
| 448 (window-pixel-height window)) | |
| 449 nil | |
| 450 window))) | |
| 451 (set-window-hscroll window (saved-window-hscroll saved-window)) | |
| 452 (set-modeline-hscroll window | |
| 453 (saved-window-modeline-hscroll saved-window)) | |
| 454 (set-window-dedicated-p window (saved-window-dedicatedp saved-window)))) | |
| 455 | |
| 456 (if (saved-window-currentp saved-window) | |
| 457 (setq window-configuration-current-window window)) | |
| 458 (if (saved-window-minibuffer-scrollp saved-window) | |
| 459 (setq minibuffer-scroll-window window))) | |
| 460 | |
| 461 (defun saved-window-pixel-width (saved-window) | |
| 462 "Compute the pixel width of SAVED-WINDOW." | |
| 463 (- (saved-window-pixel-right saved-window) | |
| 464 (saved-window-pixel-left saved-window))) | |
| 465 | |
| 466 (defun saved-window-pixel-height (saved-window) | |
| 467 "Compute the pixel height of SAVED-WINDOW." | |
| 468 (- (saved-window-pixel-bottom saved-window) | |
| 469 (saved-window-pixel-top saved-window))) | |
| 428 | 470 |
| 471 ;; The window-config stack is stored as a list in frame property | |
| 472 ;; 'window-config-stack, with the most recent element at the front. | |
| 473 ;; When you pop off an element, the popped off element gets put at the | |
| 474 ;; front of frame property 'window-config-unpop-stack, so you can | |
| 475 ;; retrieve it using unpop-window-configuration. | |
| 476 | |
| 477 (defcustom window-config-stack-max 16 | |
| 478 "*Maximum size of window configuration stack. | |
| 479 Start discarding off end if it gets this big." | |
| 480 :type 'integer | |
| 481 :group 'windows) | |
| 482 | |
| 483 (defun window-config-stack (&optional frame) | |
| 484 (or frame (setq frame (selected-frame))) | |
| 485 (let ((stack (frame-property frame 'window-config-stack))) | |
| 486 (if stack | |
| 487 (set-undoable-stack-max stack window-config-stack-max) | |
| 488 (progn | |
| 489 (setq stack (make-undoable-stack window-config-stack-max)) | |
| 490 (set-frame-property frame 'window-config-stack stack))) | |
| 491 stack)) | |
| 492 | |
| 493 (defun push-window-configuration (&optional config) | |
| 494 "Push the current window configuration onto the window-config stack. | |
| 495 If CONFIG is specified, push it instead of the current window configuration. | |
| 496 Each frame has its own window-config stack." | |
| 497 (interactive) | |
| 498 (let ((wc (or config (current-window-configuration))) | |
| 499 (stack (window-config-stack))) | |
| 500 (if (or (= 0 (undoable-stack-a-length stack)) | |
| 501 (not (equal (undoable-stack-a-top stack) wc))) | |
| 502 (undoable-stack-push stack wc)))) | |
| 503 | |
| 504 (defun pop-window-configuration () | |
| 505 "Pop the top window configuration off the window-config stack and set it. | |
| 506 Before setting the new window configuration, the current window configuration | |
| 507 is pushed onto the \"unpop\" stack. | |
| 508 `unpop-window-configuration' undoes what this function does. | |
| 509 Each frame has its own window-config and \"unpop\" stack." | |
| 510 (interactive) | |
| 511 (let ((stack (window-config-stack)) | |
| 512 (wc (current-window-configuration)) | |
| 513 popped) | |
| 514 (condition-case nil | |
| 515 (progn | |
| 516 (setq popped (undoable-stack-pop stack)) | |
| 517 (while (equal popped wc) | |
| 518 (setq popped (undoable-stack-pop stack))) | |
| 519 (undoable-stack-push stack wc) | |
| 520 (undoable-stack-undo stack) | |
| 521 (set-window-configuration popped) | |
| 522 popped) | |
| 523 (trunc-stack-bottom | |
| 524 (error "Bottom of window config stack"))))) | |
| 525 | |
| 526 (defun unpop-window-configuration () | |
| 527 "Undo the effect of the most recent `pop-window-configuration'. | |
| 528 This does exactly the inverse of what `pop-window-configuration' does: | |
| 529 i.e. it pops a window configuration off of the \"unpop\" stack and | |
| 530 pushes the current window configuration onto the window-config stack. | |
| 531 Each frame has its own window-config and \"unpop\" stack." | |
| 532 (interactive) | |
| 533 (let ((stack (window-config-stack)) | |
| 534 (wc (current-window-configuration)) | |
| 535 popped) | |
| 536 (condition-case nil | |
| 537 (progn | |
| 538 (setq popped | |
| 539 (progn | |
| 540 (undoable-stack-redo stack) | |
| 541 (undoable-stack-pop stack))) | |
| 542 (while (equal popped wc) | |
| 543 (setq popped | |
| 544 (progn | |
| 545 (undoable-stack-redo stack) | |
| 546 (undoable-stack-pop stack)))) | |
| 547 (undoable-stack-push stack wc) | |
| 548 (set-window-configuration popped) | |
| 549 popped) | |
| 550 (trunc-stack-bottom | |
| 551 (error "Top of window config stack"))))) | |
| 552 | |
| 553 | |
| 554 ;;;;;;;;;;;;; display-buffer, moved here from C. Hallelujah. | |
| 555 | |
| 442 | 556 (make-variable-buffer-local '__buffer-dedicated-frame) |
| 557 | |
| 558 (defun buffer-dedicated-frame (&optional buffer) | |
| 559 "Return the frame dedicated to this BUFFER, or nil if there is none. | |
| 560 No argument or nil as argument means use current buffer as BUFFER." | |
| 561 (let ((buffer (decode-buffer buffer))) | |
| 562 (let ((frame (symbol-value-in-buffer '__buffer-dedicated-frame buffer))) | |
| 563 ;; XEmacs addition: if the frame is dead, silently make it go away. | |
| 564 (when (and (framep frame) (not (frame-live-p frame))) | |
| 565 (with-current-buffer buffer | |
| 566 (setq __buffer-dedicated-frame nil)) | |
| 567 (setq frame nil)) | |
| 568 frame))) | |
| 569 | |
| 570 (defun set-buffer-dedicated-frame (buffer frame) | |
| 571 "For this BUFFER, set the FRAME dedicated to it. | |
| 572 FRAME must be a frame or nil." | |
| 573 (let ((buffer (decode-buffer buffer))) | |
| 574 (and frame | |
| 575 (check-argument-type #'frame-live-p frame)) | |
| 576 (with-current-buffer buffer | |
| 577 (setq __buffer-dedicated-frame frame)))) | |
| 578 | |
| 428 | 579 (defvar display-buffer-function nil |
| 580 "If non-nil, function to call to handle `display-buffer'. | |
| 903 | 581 It will receive four args: the same as those to `display-buffer'.") |
| 428 | 582 |
| 583 (defvar pre-display-buffer-function nil | |
| 584 "If non-nil, function that will be called from `display-buffer' | |
| 903 | 585 as the first action. It will receive four args: the same as those |
| 428 | 586 to `display-buffer'. |
| 587 This function may be used to select an appropriate frame for the buffer, | |
| 588 for example. See also the variable `display-buffer-function', which may | |
| 589 be used to completely replace the `display-buffer' function. | |
| 590 If the return value of this function is non-nil, it should be a frame, | |
| 591 and that frame will be used to display the buffer.") | |
| 592 | |
| 593 (defcustom pop-up-frames nil | |
| 594 "*Non-nil means `display-buffer' should make a separate frame." | |
| 595 :type 'boolean | |
| 596 :group 'frames) | |
| 597 | |
| 598 (defvar pop-up-frame-function nil | |
| 599 "Function to call to handle automatic new frame creation. | |
| 600 It is called with no arguments and should return a newly created frame. | |
| 601 | |
| 602 A typical value might be `(lambda () (new-frame pop-up-frame-alist))' | |
| 603 where `pop-up-frame-alist' would hold the default frame parameters.") | |
| 604 | |
| 605 (defcustom special-display-buffer-names nil | |
| 606 "*List of buffer names that should have their own special frames. | |
| 607 Displaying a buffer whose name is in this list makes a special frame for it | |
| 608 using `special-display-function'. | |
| 609 | |
| 610 An element of the list can be a cons cell instead of just a string. | |
| 611 Then the car should be a buffer name, and the cdr specifies frame | |
| 612 parameters for creating the frame for that buffer. | |
| 613 More precisely, the cdr is passed as the second argument to | |
| 614 the function found in `special-display-function', when making that frame. | |
| 615 See also `special-display-regexps'." | |
| 616 :type '(repeat (choice :value "" | |
| 617 (string :tag "Name") | |
| 618 (cons :menu-tag "Properties" | |
| 619 :value ("" . nil) | |
| 620 (string :tag "Name") | |
| 621 (repeat :tag "Properties" | |
| 622 (group :inline t | |
| 623 (symbol :tag "Property") | |
| 624 (sexp :tag "Value")))))) | |
| 625 :group 'frames) | |
| 626 | |
| 627 (defcustom special-display-regexps nil | |
| 628 "*List of regexps saying which buffers should have their own special frames. | |
| 629 If a buffer name matches one of these regexps, it gets its own frame. | |
| 630 Displaying a buffer whose name is in this list makes a special frame for it | |
| 631 using `special-display-function'. | |
| 632 | |
| 633 An element of the list can be a cons cell instead of just a string. | |
| 634 Then the car should be the regexp, and the cdr specifies frame | |
| 635 parameters for creating the frame for buffers that match. | |
| 636 More precisely, the cdr is passed as the second argument to | |
| 637 the function found in `special-display-function', when making that frame. | |
| 638 See also `special-display-buffer-names'." | |
| 639 :type '(repeat (choice :value "" | |
| 640 regexp | |
| 641 (cons :menu-tag "Properties" | |
| 642 :value ("" . nil) | |
| 643 regexp | |
| 644 (repeat :tag "Properties" | |
| 645 (group :inline t | |
| 646 (symbol :tag "Property") | |
| 647 (sexp :tag "Value")))))) | |
| 648 :group 'frames) | |
| 649 | |
| 650 (defvar special-display-function nil | |
| 651 "Function to call to make a new frame for a special buffer. | |
| 652 It is called with two arguments, the buffer and optional buffer specific | |
| 653 data, and should return a window displaying that buffer. | |
| 654 The default value makes a separate frame for the buffer, | |
| 655 using `special-display-frame-alist' to specify the frame parameters. | |
| 656 | |
| 657 A buffer is special if its is listed in `special-display-buffer-names' | |
| 658 or matches a regexp in `special-display-regexps'.") | |
| 659 | |
| 660 (defcustom same-window-buffer-names nil | |
| 661 "*List of buffer names that should appear in the selected window. | |
| 662 Displaying one of these buffers using `display-buffer' or `pop-to-buffer' | |
| 663 switches to it in the selected window, rather than making it appear | |
| 664 in some other window. | |
| 665 | |
| 666 An element of the list can be a cons cell instead of just a string. | |
| 667 Then the car must be a string, which specifies the buffer name. | |
| 668 This is for compatibility with `special-display-buffer-names'; | |
| 669 the cdr of the cons cell is ignored. | |
| 670 | |
| 671 See also `same-window-regexps'." | |
| 672 :type '(repeat (string :tag "Name")) | |
| 673 :group 'windows) | |
| 674 | |
| 675 (defcustom same-window-regexps nil | |
| 676 "*List of regexps saying which buffers should appear in the selected window. | |
| 677 If a buffer name matches one of these regexps, then displaying it | |
| 678 using `display-buffer' or `pop-to-buffer' switches to it | |
| 679 in the selected window, rather than making it appear in some other window. | |
| 680 | |
| 681 An element of the list can be a cons cell instead of just a string. | |
| 682 Then the car must be a string, which specifies the buffer name. | |
| 683 This is for compatibility with `special-display-buffer-names'; | |
| 684 the cdr of the cons cell is ignored. | |
| 685 | |
| 686 See also `same-window-buffer-names'." | |
| 687 :type '(repeat regexp) | |
| 688 :group 'windows) | |
| 689 | |
| 690 (defcustom pop-up-windows t | |
| 691 "*Non-nil means display-buffer should make new windows." | |
| 692 :type 'boolean | |
| 693 :group 'windows) | |
| 694 | |
| 695 (defcustom split-height-threshold 500 | |
| 696 "*display-buffer would prefer to split the largest window if this large. | |
| 697 If there is only one window, it is split regardless of this value." | |
| 698 :type 'integer | |
| 699 :group 'windows) | |
| 700 | |
| 701 (defcustom split-width-threshold 500 | |
| 702 "*display-buffer would prefer to split the largest window if this large. | |
| 703 If there is only one window, it is split regardless of this value." | |
| 704 :type 'integer | |
| 705 :group 'windows) | |
| 706 | |
| 707 ;; Deiconify the frame containing the window WINDOW, then return WINDOW. | |
| 708 | |
| 709 (defun display-buffer-1 (window) | |
| 710 (if (frame-iconified-p (window-frame window)) | |
| 711 (make-frame-visible (window-frame window))) | |
| 712 window) | |
| 713 | |
| 714 ;; Can you believe that all of this crap was formerly in C? | |
| 715 ;; Praise Jesus that it's not there any more. | |
| 716 | |
| 903 | 717 (defun display-buffer (buffer &optional not-this-window-p override-frame |
| 718 shrink-to-fit) | |
| 428 | 719 "Make BUFFER appear in some window on the current frame, but don't select it. |
| 720 BUFFER can be a buffer or a buffer name. | |
| 721 If BUFFER is shown already in some window in the current frame, | |
| 722 just uses that one, unless the window is the selected window and | |
| 723 NOT-THIS-WINDOW-P is non-nil (interactively, with prefix arg). | |
| 724 | |
| 725 If BUFFER has a dedicated frame, display on that frame instead of | |
| 726 the current frame, unless OVERRIDE-FRAME is non-nil. | |
| 727 | |
| 728 If OVERRIDE-FRAME is non-nil, display on that frame instead of | |
| 729 the current frame (or the dedicated frame). | |
| 730 | |
| 903 | 731 If SHRINK-TO-FIT is non-nil and splitting the window is appropriate, give |
| 732 the new buffer less than half the space if it is small enough to fit. | |
| 733 | |
| 428 | 734 If `pop-up-windows' is non-nil, always use the |
| 735 current frame and create a new window regardless of whether the | |
| 736 buffer has a dedicated frame, and regardless of whether | |
| 737 OVERRIDE-FRAME was specified. | |
| 738 | |
| 739 If `pop-up-frames' is non-nil, make a new frame if no window shows BUFFER. | |
| 740 | |
| 2590 | 741 If the buffer name is a member of the `same-window-buffer-names' list, |
| 742 or matches one of the `same-window-regexps' expressions, display the | |
| 743 buffer in the currently selected window. | |
| 744 | |
| 428 | 745 Returns the window displaying BUFFER." |
| 746 (interactive "BDisplay buffer:\nP") | |
| 747 | |
| 748 (let ((wconfig (current-window-configuration)) | |
| 749 (result | |
| 750 ;; We just simulate a `return' in C. This function is way ugly | |
| 751 ;; and does `returns' all over the place and there's no sense | |
| 752 ;; in trying to rewrite it to be more Lispy. | |
| 753 (catch 'done | |
| 1669 | 754 (let (window old-frame target-frame explicit-frame shrink-it) |
| 428 | 755 (setq old-frame (or (last-nonminibuf-frame) (selected-frame))) |
| 756 (setq buffer (get-buffer buffer)) | |
| 757 (check-argument-type 'bufferp buffer) | |
| 758 | |
| 759 (setq explicit-frame | |
| 760 (if pre-display-buffer-function | |
| 761 (funcall pre-display-buffer-function buffer | |
| 762 not-this-window-p | |
| 903 | 763 override-frame |
| 764 shrink-to-fit))) | |
| 428 | 765 |
| 766 ;; Give the user the ability to completely reimplement | |
| 767 ;; this function via the `display-buffer-function'. | |
| 768 (if display-buffer-function | |
| 769 (throw 'done | |
| 770 (funcall display-buffer-function buffer | |
| 771 not-this-window-p | |
| 903 | 772 override-frame |
| 773 shrink-to-fit))) | |
| 428 | 774 |
| 775 ;; If the buffer has a dedicated frame, that takes | |
| 776 ;; precedence over the current frame, and over what the | |
| 777 ;; pre-display-buffer-function did. | |
| 778 (let ((dedi (buffer-dedicated-frame buffer))) | |
| 779 (if (frame-live-p dedi) (setq explicit-frame dedi))) | |
| 780 | |
| 781 ;; if override-frame is supplied, that takes precedence over | |
| 782 ;; everything. This is gonna look bad if the | |
| 783 ;; pre-display-buffer-function raised some other frame | |
| 784 ;; already. | |
| 785 (if override-frame | |
| 786 (progn | |
| 787 (check-argument-type 'frame-live-p override-frame) | |
| 788 (setq explicit-frame override-frame))) | |
| 789 | |
| 790 (setq target-frame | |
| 791 (or explicit-frame | |
| 792 (last-nonminibuf-frame) | |
| 793 (selected-frame))) | |
| 794 | |
| 795 ;; If we have switched frames, then set not-this-window-p | |
| 796 ;; to false. Switching frames means that selected-window | |
| 797 ;; is no longer the same as it was on entry -- it's the | |
| 798 ;; selected-window of target_frame instead of old_frame, | |
| 799 ;; so it's a fine candidate for display. | |
| 800 (if (not (eq old-frame target-frame)) | |
| 801 (setq not-this-window-p nil)) | |
| 802 | |
| 803 ;; if it's in the selected window, and that's ok, then we're done. | |
| 804 (if (and (not not-this-window-p) | |
| 805 (eq buffer (window-buffer (selected-window)))) | |
| 806 (throw 'done (display-buffer-1 (selected-window)))) | |
| 807 | |
| 808 ;; See if the user has specified this buffer should appear | |
| 809 ;; in the selected window. | |
| 810 | |
| 811 (if not-this-window-p | |
| 812 nil | |
| 813 | |
| 814 (if (or (member (buffer-name buffer) same-window-buffer-names) | |
| 815 (assoc (buffer-name buffer) same-window-buffer-names)) | |
| 816 (progn | |
| 817 (switch-to-buffer buffer) | |
| 818 (throw 'done (display-buffer-1 (selected-window))))) | |
| 819 | |
| 820 (let ((tem same-window-regexps)) | |
| 821 (while tem | |
| 822 (let ((car (car tem))) | |
| 823 (if (or | |
| 824 (and (stringp car) | |
| 825 (string-match car (buffer-name buffer))) | |
| 826 (and (consp car) (stringp (car car)) | |
| 827 (string-match (car car) (buffer-name buffer)))) | |
| 828 (progn | |
| 829 (switch-to-buffer buffer) | |
| 830 (throw 'done (display-buffer-1 | |
| 831 (selected-window)))))) | |
| 832 (setq tem (cdr tem))))) | |
| 833 | |
| 834 ;; If pop-up-frames, look for a window showing BUFFER on | |
| 835 ;; any visible or iconified frame. Otherwise search only | |
| 836 ;; the current frame. | |
| 837 (if (and (not explicit-frame) | |
| 838 (or pop-up-frames (not (last-nonminibuf-frame)))) | |
| 839 (setq target-frame 0)) | |
| 840 | |
| 841 ;; Otherwise, find some window that it's already in, and | |
| 842 ;; return that, unless that window is the selected window | |
| 843 ;; and that isn't ok. What a contorted mess! | |
| 844 (setq window (or (if (not explicit-frame) | |
| 845 ;; search the selected frame | |
| 846 ;; first if the user didn't | |
| 847 ;; specify an explicit frame. | |
| 848 (get-buffer-window buffer nil)) | |
| 849 (get-buffer-window buffer target-frame))) | |
| 850 (if (and window | |
| 851 (or (not not-this-window-p) | |
| 852 (not (eq window (selected-window))))) | |
| 853 (throw 'done (display-buffer-1 window))) | |
| 854 | |
| 855 ;; Certain buffer names get special handling. | |
| 856 (if special-display-function | |
| 857 (progn | |
| 858 (if (member (buffer-name buffer) | |
| 859 special-display-buffer-names) | |
| 860 (throw 'done (funcall special-display-function buffer))) | |
| 861 | |
| 862 (let ((tem (assoc (buffer-name buffer) | |
| 863 special-display-buffer-names))) | |
| 864 (if tem | |
| 865 (throw 'done (funcall special-display-function | |
| 866 buffer (cdr tem))))) | |
| 867 | |
| 868 (let ((tem special-display-regexps)) | |
| 869 (while tem | |
| 870 (let ((car (car tem))) | |
| 871 (if (and (stringp car) | |
| 872 (string-match car (buffer-name buffer))) | |
| 873 (throw 'done | |
| 874 (funcall special-display-function buffer))) | |
| 875 (if (and (consp car) | |
| 876 (stringp (car car)) | |
| 877 (string-match (car car) | |
| 878 (buffer-name buffer))) | |
| 879 (throw 'done (funcall | |
| 880 special-display-function buffer | |
| 881 (cdr car))))) | |
| 882 (setq tem (cdr tem)))))) | |
| 883 | |
| 884 ;; If there are no frames open that have more than a minibuffer, | |
| 885 ;; we need to create a new frame. | |
| 886 (if (or pop-up-frames | |
| 887 (null (last-nonminibuf-frame))) | |
| 888 (progn | |
| 889 (setq window (frame-selected-window | |
| 890 (funcall pop-up-frame-function))) | |
| 891 (set-window-buffer window buffer) | |
| 892 (throw 'done (display-buffer-1 window)))) | |
| 893 | |
| 894 ;; Otherwise, make it be in some window, splitting if | |
| 895 ;; appropriate/possible. Do not split a window if we are | |
| 896 ;; displaying the buffer in a different frame than that which | |
| 897 ;; was current when we were called. (It is already in a | |
| 898 ;; different window by virtue of being in another frame.) | |
| 899 (if (or (and pop-up-windows (eq target-frame old-frame)) | |
| 900 (eq 'only (frame-property (selected-frame) 'minibuffer)) | |
| 901 ;; If the current frame is a special display frame, | |
| 902 ;; don't try to reuse its windows. | |
| 903 (window-dedicated-p (frame-root-window (selected-frame)))) | |
| 904 (progn | |
| 905 (if (eq 'only (frame-property (selected-frame) 'minibuffer)) | |
| 906 (setq target-frame (last-nonminibuf-frame))) | |
| 907 | |
| 908 ;; Don't try to create a window if would get an error with | |
| 909 ;; height. | |
| 910 (if (< split-height-threshold (* 2 window-min-height)) | |
| 911 (setq split-height-threshold (* 2 window-min-height))) | |
| 912 | |
| 913 ;; Same with width. | |
| 914 (if (< split-width-threshold (* 2 window-min-width)) | |
| 915 (setq split-width-threshold (* 2 window-min-width))) | |
| 916 | |
| 917 ;; If the frame we would try to split cannot be split, | |
| 918 ;; try other frames. | |
| 919 (if (frame-property (if (null target-frame) | |
| 920 (selected-frame) | |
| 921 (last-nonminibuf-frame)) | |
| 922 'unsplittable) | |
| 923 (setq window | |
| 924 ;; Try visible frames first. | |
| 925 (or (get-largest-window 'visible) | |
| 926 ;; If that didn't work, try iconified frames. | |
| 927 (get-largest-window 0) | |
| 928 (get-largest-window t))) | |
| 929 (setq window (get-largest-window target-frame))) | |
| 930 | |
| 931 ;; If we got a tall enough full-width window that | |
| 932 ;; can be split, split it. | |
| 933 (if (and window | |
| 934 (not (frame-property (window-frame window) | |
| 935 'unsplittable)) | |
| 936 (>= (window-height window) split-height-threshold) | |
| 937 (or (>= (window-width window) | |
| 938 split-width-threshold) | |
| 939 (and (window-leftmost-p window) | |
| 940 (window-rightmost-p window)))) | |
| 941 (setq window (split-window window)) | |
| 1669 | 942 (let (upper other) |
| 428 | 943 (setq window (get-lru-window target-frame)) |
| 944 ;; If the LRU window is selected, and big enough, | |
| 945 ;; and can be split, split it. | |
| 946 (if (and window | |
| 947 (not (frame-property (window-frame window) | |
| 948 'unsplittable)) | |
| 949 (or (eq window (selected-window)) | |
| 950 (not (window-parent window))) | |
| 951 (>= (window-height window) | |
| 952 (* 2 window-min-height))) | |
| 953 (setq window (split-window window))) | |
| 954 ;; If get-lru-window returned nil, try other approaches. | |
| 955 ;; Try visible frames first. | |
| 956 (or window | |
| 957 (setq window (or (get-largest-window 'visible) | |
| 958 ;; If that didn't work, try | |
| 959 ;; iconified frames. | |
| 960 (get-largest-window 0) | |
| 961 ;; Try invisible frames. | |
| 962 (get-largest-window t) | |
| 963 ;; As a last resort, make | |
| 964 ;; a new frame. | |
| 965 (frame-selected-window | |
| 966 (funcall | |
| 967 pop-up-frame-function))))) | |
| 968 ;; If window appears above or below another, | |
| 969 ;; even out their heights. | |
| 970 (if (window-previous-child window) | |
| 971 (setq other (window-previous-child window) | |
| 972 upper other)) | |
| 973 (if (window-next-child window) | |
| 974 (setq other (window-next-child window) | |
| 975 upper window)) | |
| 976 ;; Check that OTHER and WINDOW are vertically arrayed. | |
| 977 (if (and other | |
| 978 (not (= (nth 1 (window-pixel-edges other)) | |
| 979 (nth 1 (window-pixel-edges window)))) | |
| 980 (> (window-pixel-height other) | |
| 981 (window-pixel-height window))) | |
| 982 (enlarge-window (- (/ (+ (window-height other) | |
| 983 (window-height window)) | |
| 984 2) | |
| 985 (window-height upper)) | |
| 903 | 986 nil upper)) |
| 1669 | 987 ;; Klaus Berndl <klaus.berndl@sdm.de>: Only in |
| 988 ;; this situation we shrink-to-fit but we can do | |
| 989 ;; this first after we have displayed buffer in | |
| 990 ;; window (s.b. (set-window-buffer window buffer)) | |
| 991 (setq shrink-it shrink-to-fit)))) | |
| 428 | 992 |
| 993 (setq window (get-lru-window target-frame))) | |
| 994 | |
| 995 ;; Bring the window's previous buffer to the top of the MRU chain. | |
| 996 (if (window-buffer window) | |
| 997 (save-excursion | |
| 998 (save-selected-window | |
| 999 (select-window window) | |
| 1000 (record-buffer (window-buffer window))))) | |
| 1001 | |
| 1002 (set-window-buffer window buffer) | |
| 1003 | |
| 1669 | 1004 ;; Now window's previous buffer has been brought to the top |
| 1005 ;; of the MRU chain and window displays buffer - now we can | |
| 1006 ;; shrink-to-fit if necessary | |
| 1007 (if shrink-it | |
| 1008 (shrink-window-if-larger-than-buffer window)) | |
| 1009 | |
| 428 | 1010 (display-buffer-1 window))))) |
| 1011 (or (equal wconfig (current-window-configuration)) | |
| 1012 (push-window-configuration wconfig)) | |
| 1013 result)) | |
| 1014 | |
| 1015 ;;; window-xemacs.el ends here |