Mercurial > hg > xemacs-beta
comparison lisp/window-xemacs.el @ 1149:a123f88fa975
[xemacs-hg @ 2002-12-08 10:24:33 by michaels]
2002-12-02 Mike Sperber <mike@xemacs.org>
* The Great Window Configuration rewrite: Re-implement window
configuration functionality in Emacs Lisp.
* window.h (Fcurrent_window_configuration): Don't export anymore.
(Qcurrent_window_configuration): Declare.
(Qset_window_configuration): Declare.
* event-stream.c (execute_help_form):
* bytecode.c (execute_rare_opcode): Call out to Lisp to save
window excursion.
* window.c (Qcurrent_window_configuration): Declare.
(Qwindow_configurationp):
(Vwindow_configuration_free_list):
(Qset_window_configuration):
(Qtemp_buffer_show_hook):
(struct saved_window):
(struct window_config):
(SAVED_WINDOW_N):
(XWINDOW_CONFIGURATION):
(wrap_window_configuration):
(WINDOW_CONFIGURATIONP):
(CHECK_WINDOW_CONFIGURATION):
(mark_window_config):
(sizeof_window_config_for_n_windows):
(sizeof_window_config):
(print_window_config):
(saved_window_equal):
(window_config_equal):
(Fwindow_configuration_p):
(mark_windows_in_use_closure):
(mark_windows_in_use):
(free_window_configuration):
(Fset_window_configuration):
(count_windows):
(saved_window_index):
(save_window_save):
(Fcurrent_window_configuration):
(Fsave_window_excursion): Remove.
(mark_window_as_deleted): Rectify comment about
`set-window-configuration'.
(Fset_window_buffer): Reinstate code not activated because of old
implementation of window configurations.
(temp_output_buffer_show): Don't run `temp-buffer-show-hook'
anymore---this wasn't supposed to happen anyway according to the
documentation of `temp-buffer-show-function'.
(reinit_vars_of_window): Don't do the window configuration stuff
no more
(vars_of_window): Don't set up `temp-buffer-show-hook' any more.
2002-12-02 Mike Sperber <mike@xemacs.org>
* The Great Window Configuration rewrite: Re-implement window
configuration functionality in Emacs Lisp.
* window-xemacs.el (current-window-configuration):
(set-window-configuration): (plus many functions they depend on)
Re-implement window configurations in Emacs Lisp.
| author | michaels |
|---|---|
| date | Sun, 08 Dec 2002 10:25:14 +0000 |
| parents | 4a27df428c73 |
| children | 8e95979f01c6 |
comparison
equal
deleted
inserted
replaced
| 1148:1649f1fb3177 | 1149:a123f88fa975 |
|---|---|
| 102 If BUFFER is nil, make WINDOW not be dedicated (but don't change which | 102 If BUFFER is nil, make WINDOW not be dedicated (but don't change which |
| 103 buffer appears in it currently)." | 103 buffer appears in it currently)." |
| 104 (if (bufferp buffer) | 104 (if (bufferp buffer) |
| 105 (set-window-buffer window (get-buffer-create buffer))) | 105 (set-window-buffer window (get-buffer-create buffer))) |
| 106 (set-window-dedicated-p window (not (null buffer)))) | 106 (set-window-dedicated-p window (not (null buffer)))) |
| 107 | 107 |
| 108 ;; Window configurations | |
| 109 | |
| 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)) | |
| 173 (= (saved-window-modeline-hscroll saved-1) | |
| 174 (saved-window-modeline-hscroll saved-2)) | |
| 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)) | |
| 301 (restore-saved-window configuration | |
| 302 root-window | |
| 303 (window-configuration-saved-root-window configuration) | |
| 304 'vertical) | |
| 305 (if window-configuration-current-window | |
| 306 (select-window window-configuration-current-window)))) | |
| 307 | |
| 308 (setq window-min-width (window-configuration-min-width configuration)) | |
| 309 (setq window-min-height (window-configuration-min-height configuration)) | |
| 310 | |
| 311 (set-buffer (window-configuration-current-buffer configuration))) | |
| 312 | |
| 313 (defun set-window-configuration-frame-size (configuration) | |
| 314 "Restore the frame size of a window configuration." | |
| 315 (set-frame-pixel-size | |
| 316 (window-configuration-frame configuration) | |
| 317 (window-configuration-frame-pixel-width configuration) | |
| 318 (window-configuration-frame-pixel-height configuration))) | |
| 319 | |
| 320 (defun frame-reduce-to-one-window (frame) | |
| 321 "Delete all windows except the minibuffer and one other in FRAME." | |
| 322 (let* ((root-window (frame-root-window frame)) | |
| 323 (combination-start (or (window-first-hchild root-window) | |
| 324 (window-first-vchild root-window)))) | |
| 325 (if combination-start | |
| 326 (window-reduce-to-one combination-start)))) | |
| 327 | |
| 328 (defun window-reduce-to-one (window) | |
| 329 "Make sure only one subwindow of WINDOW is left." | |
| 330 (let ((window (window-next-child window))) | |
| 331 (while window | |
| 332 (if (window-live-p window) | |
| 333 (let ((next (window-next-child window))) | |
| 334 (delete-window window) | |
| 335 (setq window next))))) | |
| 336 (cond | |
| 337 ((window-first-hchild window) | |
| 338 (window-reduce-to-one (window-first-hchild window))) | |
| 339 ((window-first-vchild window) | |
| 340 (window-reduce-to-one (window-first-vchild window))))) | |
| 341 | |
| 342 (defun restore-saved-window (configuration window saved-window direction) | |
| 343 "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW." | |
| 344 (if (saved-window-next-child saved-window) | |
| 345 (progn | |
| 346 (if (not (saved-window-minibufferp (saved-window-next-child saved-window))) | |
| 347 (progn | |
| 348 (cond ((eq direction 'vertical) | |
| 349 (split-window window nil nil)) | |
| 350 ((eq direction 'horizontal) | |
| 351 (split-window window nil t))) | |
| 352 (restore-saved-window configuration | |
| 353 (window-next-child window) | |
| 354 (saved-window-next-child saved-window) | |
| 355 direction))) | |
| 356 | |
| 357 (if (saved-window-first-hchild saved-window) | |
| 358 (restore-saved-window configuration | |
| 359 window | |
| 360 (saved-window-first-hchild saved-window) | |
| 361 'horizontal)) | |
| 362 (if (saved-window-first-vchild saved-window) | |
| 363 (restore-saved-window configuration | |
| 364 window | |
| 365 (saved-window-first-vchild saved-window) | |
| 366 'vertical)))) | |
| 367 | |
| 368 (if (not (saved-window-minibufferp saved-window)) | |
| 369 (restore-saved-window-parameters configuration window saved-window))) | |
| 370 | |
| 371 (defun restore-saved-window-parameters (configuration window saved-window) | |
| 372 "Restore the window parameters stored in SAVED-WINDOW on WINDOW." | |
| 373 (let ((buffer (saved-window-buffer saved-window))) | |
| 374 (if (and buffer (buffer-live-p buffer)) | |
| 375 (progn | |
| 376 (set-window-buffer window | |
| 377 (saved-window-buffer saved-window)) | |
| 378 (set-window-start window | |
| 379 (marker-position (saved-window-start-marker saved-window))) | |
| 380 (set-window-point window | |
| 381 (marker-position (saved-window-point-marker saved-window))) | |
| 382 (set-marker (mark-marker t buffer) | |
| 383 (marker-position (saved-window-mark-marker saved-window)) | |
| 384 buffer) | |
| 385 (if (not (eq buffer (window-configuration-current-buffer configuration))) | |
| 386 (goto-char (window-point window) buffer))))) | |
| 387 | |
| 388 (if (and (not (saved-window-first-hchild saved-window)) | |
| 389 (not (saved-window-first-vchild saved-window))) | |
| 390 ;; only set size for non-container windows | |
| 391 (progn | |
| 392 ;; If this is the root window, it may be the only window. | |
| 393 ;; Because of mismatches between actual and reported frame | |
| 394 ;; size, it may not let us actually set the size of the root | |
| 395 ;; window to what we want. --Mike | |
| 396 (if (not (eq window (frame-root-window (window-frame window)))) | |
| 397 (progn | |
| 398 (enlarge-window-pixels (- (saved-window-pixel-width saved-window) | |
| 399 (window-pixel-width window)) | |
| 400 t | |
| 401 window) | |
| 402 (enlarge-window-pixels (- (saved-window-pixel-height saved-window) | |
| 403 (window-pixel-height window)) | |
| 404 nil | |
| 405 window))) | |
| 406 (set-window-hscroll window (saved-window-hscroll saved-window)) | |
| 407 (set-modeline-hscroll window | |
| 408 (saved-window-modeline-hscroll saved-window)) | |
| 409 (set-window-dedicated-p window (saved-window-dedicatedp saved-window)))) | |
| 410 | |
| 411 (if (saved-window-currentp saved-window) | |
| 412 (setq window-configuration-current-window window)) | |
| 413 (if (saved-window-minibuffer-scrollp saved-window) | |
| 414 (setq minibuffer-scroll-window window))) | |
| 415 | |
| 416 (defun saved-window-pixel-width (saved-window) | |
| 417 "Compute the pixel width of SAVED-WINDOW." | |
| 418 (- (saved-window-pixel-right saved-window) | |
| 419 (saved-window-pixel-left saved-window))) | |
| 420 | |
| 421 (defun saved-window-pixel-height (saved-window) | |
| 422 "Compute the pixel height of SAVED-WINDOW." | |
| 423 (- (saved-window-pixel-bottom saved-window) | |
| 424 (saved-window-pixel-top saved-window))) | |
| 108 | 425 |
| 109 ;; The window-config stack is stored as a list in frame property | 426 ;; The window-config stack is stored as a list in frame property |
| 110 ;; 'window-config-stack, with the most recent element at the front. | 427 ;; 'window-config-stack, with the most recent element at the front. |
| 111 ;; When you pop off an element, the popped off element gets put at the | 428 ;; When you pop off an element, the popped off element gets put at the |
| 112 ;; front of frame property 'window-config-unpop-stack, so you can | 429 ;; front of frame property 'window-config-unpop-stack, so you can |