Mercurial > hg > xemacs-beta

comparison lisp/window-xemacs.el @ 4445:1d41b9bcf74f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add `set-window-configuration/mapping' and `save-window-excursion/mapping'. 2008-04-13 Henry S. Thompson <ht@inf.ed.ac.uk>, Mike Sperber <mike@xemacs.org> * window-xemacs.el (save-window-excursion/mapping, set-window-configuration/mapping): Add. These function return an alist mapping the window objects from the original window configuration to the window objects corresponding to them in the restored configuration. (set-window-configuration): (saved-window): (root-window->saved-window): (really-set-window-configuration): (restore-saved-window): Record the mapping for above functions.
author Mike Sperber <sperber@deinprogramm.de>
date Sun, 13 Apr 2008 11:18:00 +0200
parents 715c3ced8fa8
children 11d71be1c232
comparison
equal deleted inserted replaced
4444:715c3ced8fa8 4445:1d41b9bcf74f
122 start-marker 122 start-marker
123 point-marker 123 point-marker
124 pixel-left pixel-top pixel-right pixel-bottom 124 pixel-left pixel-top pixel-right pixel-bottom
125 hscroll modeline-hscroll 125 hscroll modeline-hscroll
126 dedicatedp 126 dedicatedp
127 first-hchild first-vchild next-child) 127 first-hchild first-vchild next-child
128 window)
128 129
129 (defstruct window-configuration 130 (defstruct window-configuration
130 frame 131 frame
131 frame-top frame-left 132 frame-top frame-left
132 frame-pixel-width frame-pixel-height 133 frame-pixel-width frame-pixel-height
258 (top (nth 1 edges)) 259 (top (nth 1 edges))
259 (right (nth 2 edges)) 260 (right (nth 2 edges))
260 (bottom (nth 3 edges))) 261 (bottom (nth 3 edges)))
261 (let ((saved-window 262 (let ((saved-window
262 (make-saved-window 263 (make-saved-window
264 :window window
263 :currentp (eq window (selected-window (window-frame window))) 265 :currentp (eq window (selected-window (window-frame window)))
264 :minibufferp (eq window (minibuffer-window (window-frame window))) 266 :minibufferp (eq window (minibuffer-window (window-frame window)))
265 :minibuffer-scrollp (eq window minibuffer-scroll-window) 267 :minibuffer-scrollp (eq window minibuffer-scroll-window)
266 :buffer buffer 268 :buffer buffer
267 :pixel-left left :pixel-top top :pixel-right right :pixel-bottom bottom 269 :pixel-left left :pixel-top top :pixel-right right :pixel-bottom bottom
288 (setf (saved-window-point-marker saved-window) marker))) 290 (setf (saved-window-point-marker saved-window) marker)))
289 (setf (saved-window-mark-marker saved-window) 291 (setf (saved-window-mark-marker saved-window)
290 (copy-marker (mark-marker t buffer))))) 292 (copy-marker (mark-marker t buffer)))))
291 saved-window)))) 293 saved-window))))
292 294
295 (defmacro save-window-excursion/mapping (&rest body)
296 "Execute body, preserving window sizes and contents.
297 Restores which buffer appears in which window, where display starts,
298 as well as the current buffer.
299 Return alist mapping old windows to new windows.
300 This alist maps the originally captured windows to the windows that correspond
301 to them in the restored configuration. It does not include entries for
302 windows that have not changed identity.
303 Does not restore the value of point in current buffer."
304 (let ((window-config (gensym 'window-config))
305 (mapping (gensym 'mapping)))
306 `(let ((,window-config (current-window-configuration))
307 (,mapping))
308 (unwind-protect
309 (progn ,@body)
310 (setq ,mapping (set-window-configuration/mapping ,window-config)))
311 ,mapping)))
312
293 (defun set-window-configuration (configuration) 313 (defun set-window-configuration (configuration)
294 "Set the configuration of windows and buffers as specified by CONFIGURATION. 314 "Set the configuration of windows and buffers as specified by CONFIGURATION.
295 CONFIGURATION must be a value previously returned 315 CONFIGURATION must be a value previously returned
296 by `current-window-configuration'." 316 by `current-window-configuration'."
317 (set-window-configuration/mapping configuration)
318 nil) ; make sure nobody relies on mapping return value
319
320 (defun set-window-configuration/mapping (configuration)
321 "Set the configuration of windows and buffers as specified by CONFIGURATION.
322 CONFIGURATION must be a value previously returned
323 by `current-window-configuration'.
324 Return alist mapping old windows to new windows.
325 This alist maps the originally captured windows to the windows that correspond
326 to them in the restored configuration. It does not include entries for
327 windows that have not changed identity."
297 (let ((frame (window-configuration-frame configuration))) 328 (let ((frame (window-configuration-frame configuration)))
298 (if (and (frame-live-p frame) 329 (if (and (frame-live-p frame)
299 (not (window-configuration-equal configuration 330 (not (window-configuration-equal configuration
300 (current-window-configuration)))) 331 (current-window-configuration))))
301 (really-set-window-configuration frame configuration)))) 332 (really-set-window-configuration frame configuration))))
302 333
303 (defun really-set-window-configuration (frame configuration) 334 (defun really-set-window-configuration (frame configuration)
304 "Set the window configuration CONFIGURATION on live frame FRAME." 335 "Set the window configuration CONFIGURATION on live frame FRAME.
336 Return alist mapping old windows to new windows."
305 ;; avoid potential temporary problems 337 ;; avoid potential temporary problems
306 (setq window-min-width 0) 338 (setq window-min-width 0)
307 (setq window-min-height 0) 339 (setq window-min-height 0)
308 (setq minibuffer-scroll-window nil) 340 (setq minibuffer-scroll-window nil)
309 341
330 362
331 ;; avoid that `set-window-point' will set the buffer's point for 363 ;; avoid that `set-window-point' will set the buffer's point for
332 ;; the selected window 364 ;; the selected window
333 (select-window (minibuffer-window frame)) 365 (select-window (minibuffer-window frame))
334 366
335 (let ((window-configuration-current-window nil)) 367 (let ((window-configuration-current-window nil)
368 (mapping (list nil))) ; poor man's box
369
336 (declare (special window-configuration-current-window)) 370 (declare (special window-configuration-current-window))
337 (restore-saved-window configuration 371 (restore-saved-window configuration
338 root-window 372 root-window
339 (window-configuration-saved-root-window configuration) 373 (window-configuration-saved-root-window configuration)
340 'vertical) 374 'vertical
375 mapping)
341 (if window-configuration-current-window 376 (if window-configuration-current-window
342 (select-window window-configuration-current-window)))) 377 (select-window window-configuration-current-window))
343 378
344 (setq window-min-width (window-configuration-min-width configuration)) 379 (setq window-min-width (window-configuration-min-width configuration))
345 (setq window-min-height (window-configuration-min-height configuration)) 380 (setq window-min-height (window-configuration-min-height configuration))
346 381
347 (let ((buffer (window-configuration-current-buffer configuration))) 382 (let ((buffer (window-configuration-current-buffer configuration)))
348 (if (buffer-live-p buffer) 383 (if (buffer-live-p buffer)
349 (set-buffer buffer) 384 (set-buffer buffer)
350 (set-buffer (car (buffer-list)))))) 385 (set-buffer (car (buffer-list)))))
386 (car mapping))))
351 387
352 (defun set-window-configuration-frame-size (configuration) 388 (defun set-window-configuration-frame-size (configuration)
353 "Restore the frame size of a window configuration." 389 "Restore the frame size of a window configuration."
354 (set-frame-pixel-size 390 (set-frame-pixel-size
355 (window-configuration-frame configuration) 391 (window-configuration-frame configuration)
379 ((window-first-hchild window) 415 ((window-first-hchild window)
380 (window-reduce-to-one (window-first-hchild window))) 416 (window-reduce-to-one (window-first-hchild window)))
381 ((window-first-vchild window) 417 ((window-first-vchild window)
382 (window-reduce-to-one (window-first-vchild window))))) 418 (window-reduce-to-one (window-first-vchild window)))))
383 419
384 (defun restore-saved-window (configuration window saved-window direction) 420 (defun restore-saved-window (configuration window saved-window direction mapping)
385 "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW." 421 "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW.
422 MAPPING is a one-element list whose element is an old-window-to-new-window
423 mapping, which this function will extend."
424 (if (not (eq (saved-window-window saved-window) window))
425 (rplaca mapping
426 (cons (cons (saved-window-window saved-window) window)
427 (car mapping))))
386 (cond 428 (cond
387 ((and (saved-window-next-child saved-window) 429 ((and (saved-window-next-child saved-window)
388 (not (saved-window-minibufferp (saved-window-next-child saved-window)))) 430 (not (saved-window-minibufferp (saved-window-next-child saved-window))))
389 (cond ((eq direction 'vertical) 431 (cond ((eq direction 'vertical)
390 (real-split-window window nil nil)) 432 (real-split-window window nil nil))
393 (if (not (saved-window-minibufferp saved-window)) 435 (if (not (saved-window-minibufferp saved-window))
394 (restore-saved-window-parameters configuration window saved-window)) 436 (restore-saved-window-parameters configuration window saved-window))
395 (restore-saved-window configuration 437 (restore-saved-window configuration
396 (window-next-child window) 438 (window-next-child window)
397 (saved-window-next-child saved-window) 439 (saved-window-next-child saved-window)
398 direction)) 440 direction
441 mapping))
399 ((not (saved-window-minibufferp saved-window)) 442 ((not (saved-window-minibufferp saved-window))
400 (restore-saved-window-parameters configuration window saved-window))) 443 (restore-saved-window-parameters configuration window saved-window)))
401 444
402 (if (saved-window-first-hchild saved-window) 445 (if (saved-window-first-hchild saved-window)
403 (restore-saved-window configuration 446 (restore-saved-window configuration
404 window 447 window
405 (saved-window-first-hchild saved-window) 448 (saved-window-first-hchild saved-window)
406 'horizontal)) 449 'horizontal
450 mapping))
407 (if (saved-window-first-vchild saved-window) 451 (if (saved-window-first-vchild saved-window)
408 (restore-saved-window configuration 452 (restore-saved-window configuration
409 window 453 window
410 (saved-window-first-vchild saved-window) 454 (saved-window-first-vchild saved-window)
411 'vertical))) 455 'vertical
456 mapping)))
412 457
413 (defun restore-saved-window-parameters (configuration window saved-window) 458 (defun restore-saved-window-parameters (configuration window saved-window)
414 "Restore the window parameters stored in SAVED-WINDOW on WINDOW." 459 "Restore the window parameters stored in SAVED-WINDOW on WINDOW."
415 (declare (special window-configuration-current-window)) 460 (declare (special window-configuration-current-window))
416 (let ((buffer (saved-window-buffer saved-window))) 461 (let ((buffer (saved-window-buffer saved-window)))