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