Mercurial > hg > xemacs-beta
diff lisp/window-xemacs.el @ 5118:e0db3c197671 ben-lisp-object
merge up to latest default branch, doesn't compile yet
author | Ben Wing <ben@xemacs.org> |
---|---|
date | Sat, 26 Dec 2009 21:18:49 -0600 |
parents | e95ddfd6a409 |
children | f00192e1cd49 308d34e9f07d |
line wrap: on
line diff
--- a/lisp/window-xemacs.el Sat Dec 26 00:20:27 2009 -0600 +++ b/lisp/window-xemacs.el Sat Dec 26 21:18:49 2009 -0600 @@ -107,6 +107,15 @@ ;; Window configurations +(defcustom window-configuration-includes-position nil + "*Whether restoring window configurations will restore positions too. +If nil, only the size of windows will be restored. + +Note that setting this value to t may have counterintuitive consequences, +if a window manager employing virtual desktops is in use." +:type 'boolean +:group 'windows) + (defstruct saved-window currentp minibufferp minibuffer-scrollp buffer mark-marker @@ -115,7 +124,8 @@ pixel-left pixel-top pixel-right pixel-bottom hscroll modeline-hscroll dedicatedp - first-hchild first-vchild next-child) + first-hchild first-vchild next-child + window) (defstruct window-configuration frame @@ -126,9 +136,17 @@ min-width min-height saved-root-window) +; make sure we don't get affected by harmful advice +(fset 'real-split-window (symbol-function 'split-window)) +(fset 'real-delete-window (symbol-function 'delete-window)) + (defun window-configuration-equal (conf-1 conf-2) "Returns a boolean indicating whether the two given configurations -are identical." +are identical. + +Window configurations containing windows with different window +positions are not identical iff `window-configuration-includes-position' +is t." (or (eq conf-1 conf-2) (and (eq (window-configuration-frame conf-1) (window-configuration-frame conf-2)) @@ -136,10 +154,12 @@ (window-configuration-frame-pixel-width conf-2)) (= (window-configuration-frame-pixel-height conf-1) (window-configuration-frame-pixel-height conf-2)) - (equal (window-configuration-frame-top conf-1) - (window-configuration-frame-top conf-2)) - (equal (window-configuration-frame-left conf-1) - (window-configuration-frame-left conf-2)) + (if window-configuration-includes-position + (and (equal (window-configuration-frame-top conf-1) + (window-configuration-frame-top conf-2)) + (equal (window-configuration-frame-left conf-1) + (window-configuration-frame-left conf-2))) + t) (eq (window-configuration-current-buffer conf-1) (window-configuration-current-buffer conf-2)) (saved-window-equal (window-configuration-saved-root-window conf-1) @@ -241,6 +261,7 @@ (bottom (nth 3 edges))) (let ((saved-window (make-saved-window + :window window :currentp (eq window (selected-window (window-frame window))) :minibufferp (eq window (minibuffer-window (window-frame window))) :minibuffer-scrollp (eq window minibuffer-scroll-window) @@ -263,72 +284,110 @@ (let ((marker (make-marker))) (set-marker marker (window-start window) buffer) (setf (saved-window-start-marker saved-window) marker)) - (let ((marker (make-marker))) - (if (eq window (selected-window)) - (set-marker marker (point buffer) buffer) - (set-marker marker (window-point window) buffer)) - (setf (saved-window-point-marker saved-window) marker)) + (if (not (eq buffer (current-buffer))) + (let ((marker (make-marker))) + (set-marker marker (window-point window) buffer) + (setf (saved-window-point-marker saved-window) marker))) (setf (saved-window-mark-marker saved-window) (copy-marker (mark-marker t buffer))))) saved-window)))) -(defun set-window-configuration (configuration) +(defmacro save-window-excursion/mapping (&rest body) + "Execute body, preserving window sizes and contents. +Restores which buffer appears in which window, where display starts, +as well as the current buffer. +Return alist mapping old windows to new windows. +This alist maps the originally captured windows to the windows that correspond +to them in the restored configuration. It does not include entries for +windows that have not changed identity. +Does not restore the value of point in current buffer." + (let ((window-config (gensym 'window-config)) + (mapping (gensym 'mapping))) + `(let ((,window-config (current-window-configuration)) + (,mapping)) + (unwind-protect + (progn ,@body) + (setq ,mapping (set-window-configuration/mapping ,window-config))) + ,mapping))) + +(defun set-window-configuration (configuration &optional set-frame-size-p) "Set the configuration of windows and buffers as specified by CONFIGURATION. CONFIGURATION must be a value previously returned -by `current-window-configuration'." +by `current-window-configuration'. +If SET-FRAME-SIZE-P is true, the frame size is also restored. +" + (set-window-configuration/mapping configuration set-frame-size-p) + nil) ; make sure nobody relies on mapping return value + +(defun set-window-configuration/mapping (configuration &optional set-frame-size-p) + "Set the configuration of windows and buffers as specified by CONFIGURATION. +CONFIGURATION must be a value previously returned +by `current-window-configuration'. +If SET-FRAME-SIZE-P is true, the frame size is also restored. +Return alist mapping old windows to new windows. +This alist maps the originally captured windows to the windows that correspond +to them in the restored configuration. It does not include entries for +windows that have not changed identity." (let ((frame (window-configuration-frame configuration))) (if (and (frame-live-p frame) (not (window-configuration-equal configuration (current-window-configuration)))) - (really-set-window-configuration frame configuration)))) + (really-set-window-configuration frame configuration set-frame-size-p)))) -(defun really-set-window-configuration (frame configuration) - "Set the window configuration CONFIGURATION on live frame FRAME." +(defun really-set-window-configuration (frame configuration set-frame-size-p) + "Set the window configuration CONFIGURATION on live frame FRAME. +If SET-FRAME-SIZE-P is true, the frame size is also restored. +Return alist mapping old windows to new windows." ;; avoid potential temporary problems (setq window-min-width 0) (setq window-min-height 0) (setq minibuffer-scroll-window nil) (frame-reduce-to-one-window frame) - (set-window-configuration-frame-size configuration) + (if set-frame-size-p + (set-window-configuration-frame-size configuration)) - ; avoid setting these if they're already up-to-date - ; This also avoids potential inaccuracies in these settings --Mike - (let ((left (window-configuration-frame-left configuration)) - (top (window-configuration-frame-top configuration))) - (if (not (equal left (frame-property frame 'left))) - (set-frame-property frame 'left left)) - (if (not (equal top (frame-property frame 'top))) - (set-frame-property frame 'top top))) + ;; avoid setting these if they're already up-to-date + ;; This also avoids potential inaccuracies in these settings --Mike + (when window-configuration-includes-position + (let ((left (window-configuration-frame-left configuration)) + (top (window-configuration-frame-top configuration))) + (if (not (equal left (frame-property frame 'left))) + (set-frame-property frame 'left left)) + (if (not (equal top (frame-property frame 'top))) + (set-frame-property frame 'top top)))) ;; these may have changed because of the delete - (let ((root-window (frame-root-window frame))) - (enlarge-window-pixels - (- (window-configuration-minibuffer-pixel-height configuration) - (window-pixel-height (minibuffer-window frame))) - nil - (minibuffer-window frame)) + (set-window-pixel-height (minibuffer-window frame) + (window-configuration-minibuffer-pixel-height configuration)) - ;; avoid that `set-window-point' will set the buffer's point for - ;; the selected window - (select-window (minibuffer-window frame)) + ;; avoid that `set-window-point' will set the buffer's point for + ;; the selected window + (select-window (minibuffer-window frame)) - (let ((window-configuration-current-window nil)) - (declare (special window-configuration-current-window)) - (restore-saved-window configuration - root-window - (window-configuration-saved-root-window configuration) - 'vertical) - (if window-configuration-current-window - (select-window window-configuration-current-window)))) - - (setq window-min-width (window-configuration-min-width configuration)) - (setq window-min-height (window-configuration-min-height configuration)) - - (let ((buffer (window-configuration-current-buffer configuration))) - (if (buffer-live-p buffer) - (set-buffer buffer) - (set-buffer (car (buffer-list)))))) + (let ((window-configuration-current-window nil) + (mapping (list nil))) ; poor man's box + + (declare (special window-configuration-current-window)) + (restore-saved-window configuration + (frame-root-window frame) + (window-configuration-saved-root-window configuration) + 'vertical + mapping) + (if window-configuration-current-window + (select-window window-configuration-current-window)) + + (setq window-min-width (window-configuration-min-width configuration)) + (setq window-min-height (window-configuration-min-height configuration)) + + (let ((buffer (window-configuration-current-buffer configuration))) + (if (buffer-live-p buffer) + (set-buffer buffer) + (set-buffer (car (buffer-list))))) + ; this resets the window configuration so that the frame is filled + (if (not set-frame-size-p) + (set-frame-pixel-size frame (frame-pixel-width frame) (frame-pixel-height frame))) + (car mapping))) (defun set-window-configuration-frame-size (configuration) "Restore the frame size of a window configuration." @@ -354,7 +413,7 @@ (while window (if (window-live-p window) (let ((next (window-next-child window))) - (delete-window window) + (real-delete-window window) (setq window next))))) (cond ((window-first-hchild window) @@ -362,33 +421,43 @@ ((window-first-vchild window) (window-reduce-to-one (window-first-vchild window))))) -(defun restore-saved-window (configuration window saved-window direction) - "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW." - (and (saved-window-next-child saved-window) - (not (saved-window-minibufferp (saved-window-next-child saved-window))) - (progn - (cond ((eq direction 'vertical) - (split-window window nil nil)) - ((eq direction 'horizontal) - (split-window window nil t))) - (restore-saved-window configuration - (window-next-child window) - (saved-window-next-child saved-window) - direction))) +(defun restore-saved-window (configuration window saved-window direction mapping) + "Within CONFIGURATION, restore WINDOW to the state of SAVED-WINDOW. +MAPPING is a one-element list whose element is an old-window-to-new-window +mapping, which this function will extend." + (if (not (eq (saved-window-window saved-window) window)) + (rplaca mapping + (cons (cons (saved-window-window saved-window) window) + (car mapping)))) + (cond + ((and (saved-window-next-child saved-window) + (not (saved-window-minibufferp (saved-window-next-child saved-window)))) + (cond ((eq direction 'vertical) + (real-split-window window nil nil)) + ((eq direction 'horizontal) + (real-split-window window nil t))) + (if (not (saved-window-minibufferp saved-window)) + (restore-saved-window-parameters configuration window saved-window)) + (restore-saved-window configuration + (window-next-child window) + (saved-window-next-child saved-window) + direction + mapping)) + ((not (saved-window-minibufferp saved-window)) + (restore-saved-window-parameters configuration window saved-window))) (if (saved-window-first-hchild saved-window) (restore-saved-window configuration window (saved-window-first-hchild saved-window) - 'horizontal)) + 'horizontal + mapping)) (if (saved-window-first-vchild saved-window) (restore-saved-window configuration window (saved-window-first-vchild saved-window) - 'vertical)) - - (if (not (saved-window-minibufferp saved-window)) - (restore-saved-window-parameters configuration window saved-window))) + 'vertical + mapping))) (defun restore-saved-window-parameters (configuration window saved-window) "Restore the window parameters stored in SAVED-WINDOW on WINDOW." @@ -401,8 +470,9 @@ (set-window-start window (marker-position (saved-window-start-marker saved-window)) t) - (set-window-point window - (marker-position (saved-window-point-marker saved-window))) + (if (markerp (saved-window-point-marker saved-window)) + (set-window-point window + (marker-position (saved-window-point-marker saved-window)))) (set-marker (mark-marker t buffer) (marker-position (saved-window-mark-marker saved-window)) buffer) @@ -419,14 +489,10 @@ ;; window to what we want. --Mike (if (not (eq window (frame-root-window (window-frame window)))) (progn - (enlarge-window-pixels (- (saved-window-pixel-width saved-window) - (window-pixel-width window)) - t - window) - (enlarge-window-pixels (- (saved-window-pixel-height saved-window) - (window-pixel-height window)) - nil - window))) + (set-window-pixel-width window + (saved-window-pixel-width saved-window)) + (set-window-pixel-height window + (saved-window-pixel-height saved-window)))) (set-window-hscroll window (saved-window-hscroll saved-window)) (set-modeline-hscroll window (saved-window-modeline-hscroll saved-window)) @@ -446,6 +512,15 @@ "Compute the pixel height of SAVED-WINDOW." (- (saved-window-pixel-bottom saved-window) (saved-window-pixel-top saved-window))) + +(defun set-window-pixel-width (window width) + "Set the pixel width of WINDOW." + (enlarge-window-pixels (- width (window-pixel-width window)) t window)) + +(defun set-window-pixel-height (window height) + "Set the pixel height of WINDOW." + (enlarge-window-pixels (- height (window-pixel-height window)) nil window)) + ;; The window-config stack is stored as a list in frame property ;; 'window-config-stack, with the most recent element at the front.