>From 9853d8e0f529be0b495415674e96346e575787e9 Mon Sep 17 00:00:00 2001 From: Yuan Fu Date: Wed, 9 Oct 2019 16:26:35 -0400 Subject: [PATCH] window --- lisp/window.el | 261 ++++++++++++++++++++++++++----------------------- 1 file changed, 136 insertions(+), 125 deletions(-) diff --git a/lisp/window.el b/lisp/window.el index d93ec0add6..b2cebdb194 100644 --- a/lisp/window.el +++ b/lisp/window.el @@ -5669,7 +5669,7 @@ balance-windows-area )) ;;; Window states, how to get them and how to put them in a window. -(defun window--state-get-1 (window &optional writable) +(defun window--state-get-1 (window &optional writable buffer-fn) "Helper function for `window-state-get'." (let* ((type (cond @@ -5718,28 +5718,30 @@ window--state-get-1 `((parameters . ,list)))) ,@(when buffer ;; All buffer related things go in here. - (let ((point (window-point window)) - (start (window-start window))) - `((buffer - ,(if writable (buffer-name buffer) buffer) - (selected . ,selected) - (hscroll . ,(window-hscroll window)) - (fringes . ,(window-fringes window)) - (margins . ,(window-margins window)) - (scroll-bars . ,(window-scroll-bars window)) - (vscroll . ,(window-vscroll window)) - (dedicated . ,(window-dedicated-p window)) - (point . ,(if writable - point - (with-current-buffer buffer - (copy-marker point - (buffer-local-value - 'window-point-insertion-type - buffer))))) - (start . ,(if writable - start - (with-current-buffer buffer - (copy-marker start)))))))) + (if buffer-fn + `((buffer . ,(funcall buffer-fn buffer))) + (let ((point (window-point window)) + (start (window-start window))) + `((buffer + ,(if writable (buffer-name buffer) buffer) + (selected . ,selected) + (hscroll . ,(window-hscroll window)) + (fringes . ,(window-fringes window)) + (margins . ,(window-margins window)) + (scroll-bars . ,(window-scroll-bars window)) + (vscroll . ,(window-vscroll window)) + (dedicated . ,(window-dedicated-p window)) + (point . ,(if writable + point + (with-current-buffer buffer + (copy-marker point + (buffer-local-value + 'window-point-insertion-type + buffer))))) + (start . ,(if writable + start + (with-current-buffer buffer + (copy-marker start))))))))) ,@(when next-buffers `((next-buffers . ,(if writable @@ -5765,7 +5767,7 @@ window--state-get-1 (nreverse list))))) (append head tail))) -(defun window-state-get (&optional window writable) +(defun window-state-get (&optional window writable buffer-fn) "Return state of WINDOW as a Lisp object. WINDOW can be any window and defaults to the root window of the selected frame. @@ -5779,6 +5781,13 @@ window-state-get an `invalid-read-syntax' error while attempting to read back the value from file. +Optional argument BUFFER-FN is a function that takes a buffer +object and returns a function that takes no argument and +recreates the buffer. If you set WRITABLE to t, you shouldn't +return any function with non-readable value in it. And it is +recommended to quote the lambda form you return in order to avoid +lexical context. + The return value can be used as argument for `window-state-put' to put the state recorded here into an arbitrary window. The value can be also stored on disk and read back in a new session." @@ -5806,7 +5815,7 @@ window-state-get (min-pixel-width-ignore . ,(window-min-size window t t t)) (min-pixel-height-safe . ,(window-min-size window nil 'safe t)) (min-pixel-width-safe . ,(window-min-size window t 'safe t))) - (window--state-get-1 window writable))) + (window--state-get-1 window writable buffer-fn))) (defvar window-state-put-list nil "Helper variable for `window-state-put'.") @@ -5911,106 +5920,108 @@ window--state-put-2 (set-window-parameter window (car parameter) (cdr parameter)))) ;; Process buffer related state. (when state - (let ((buffer (get-buffer (car state))) - (state (cdr state))) - (if buffer - (with-current-buffer buffer - (set-window-buffer window buffer) - (set-window-hscroll window (cdr (assq 'hscroll state))) - (apply 'set-window-fringes - (cons window (cdr (assq 'fringes state)))) - (let ((margins (cdr (assq 'margins state)))) - (set-window-margins window (car margins) (cdr margins))) - (let ((scroll-bars (cdr (assq 'scroll-bars state)))) - (set-window-scroll-bars - window (car scroll-bars) (nth 2 scroll-bars) - (nth 3 scroll-bars) (nth 5 scroll-bars) (nth 6 scroll-bars))) - (set-window-vscroll window (cdr (assq 'vscroll state))) - ;; Adjust vertically. - (if (or (memq window-size-fixed '(t height)) - (window-preserved-size window)) - ;; A fixed height window, try to restore the - ;; original size. - (let ((delta - (- (cdr (assq - (if pixelwise 'pixel-height 'total-height) - item)) - (window-size window nil pixelwise))) - window-size-fixed) - (when (window--resizable-p - window delta nil nil nil nil nil pixelwise) - (window-resize window delta nil nil pixelwise))) - ;; Else check whether the window is not high enough. - (let* ((min-size - (window-min-size window nil ignore pixelwise)) - (delta - (- min-size (window-size window nil pixelwise)))) - (when (and (> delta 0) - (window--resizable-p - window delta nil ignore nil nil nil pixelwise)) - (window-resize window delta nil ignore pixelwise)))) - ;; Adjust horizontally. - (if (or (memq window-size-fixed '(t width)) - (window-preserved-size window t)) - ;; A fixed width window, try to restore the original - ;; size. - (let ((delta - (- (cdr (assq - (if pixelwise 'pixel-width 'total-width) - item)) - (window-size window t pixelwise))) - window-size-fixed) - (when (window--resizable-p - window delta t nil nil nil nil pixelwise) - (window-resize window delta t nil pixelwise))) - ;; Else check whether the window is not wide enough. - (let* ((min-size (window-min-size window t ignore pixelwise)) - (delta (- min-size (window-size window t pixelwise)))) - (when (and (> delta 0) - (window--resizable-p - window delta t ignore nil nil nil pixelwise)) - (window-resize window delta t ignore pixelwise)))) - ;; Set dedicated status. - (set-window-dedicated-p window (cdr (assq 'dedicated state))) - ;; Install positions (maybe we should do this after all - ;; windows have been created and sized). - (ignore-errors - ;; Set 'noforce argument to avoid that window start - ;; overrides window point set below (Bug#24240). - (set-window-start window (cdr (assq 'start state)) 'noforce) - (set-window-point window (cdr (assq 'point state)))) - ;; Select window if it's the selected one. - (when (cdr (assq 'selected state)) - (select-window window)) - (when next-buffers - (set-window-next-buffers - window - (delq nil (mapcar (lambda (buffer) - (setq buffer (get-buffer buffer)) - (when (buffer-live-p buffer) buffer)) - next-buffers)))) - (when prev-buffers - (set-window-prev-buffers - window - (delq nil (mapcar (lambda (entry) - (let ((buffer (get-buffer (nth 0 entry))) - (m1 (nth 1 entry)) - (m2 (nth 2 entry))) - (when (buffer-live-p buffer) - (list buffer - (if (markerp m1) m1 - (set-marker (make-marker) m1 - buffer)) - (if (markerp m2) m2 - (set-marker (make-marker) m2 - buffer)))))) - prev-buffers))))) - ;; We don't want to raise an error in case the buffer does - ;; not exist anymore, so we switch to a previous one and - ;; save the window with the intention of deleting it later - ;; if possible. - (switch-to-prev-buffer window) - (push window window-state-put-stale-windows))))))) + (if (functionp state) + (funcall state) + (let ((buffer (get-buffer (car state))) + (state (cdr state))) + (if buffer + (with-current-buffer buffer + (set-window-buffer window buffer) + (set-window-hscroll window (cdr (assq 'hscroll state))) + (apply 'set-window-fringes + (cons window (cdr (assq 'fringes state)))) + (let ((margins (cdr (assq 'margins state)))) + (set-window-margins window (car margins) (cdr margins))) + (let ((scroll-bars (cdr (assq 'scroll-bars state)))) + (set-window-scroll-bars + window (car scroll-bars) (nth 2 scroll-bars) + (nth 3 scroll-bars) (nth 5 scroll-bars) (nth 6 scroll-bars))) + (set-window-vscroll window (cdr (assq 'vscroll state))) + ;; Adjust vertically. + (if (or (memq window-size-fixed '(t height)) + (window-preserved-size window)) + ;; A fixed height window, try to restore the + ;; original size. + (let ((delta + (- (cdr (assq + (if pixelwise 'pixel-height 'total-height) + item)) + (window-size window nil pixelwise))) + window-size-fixed) + (when (window--resizable-p + window delta nil nil nil nil nil pixelwise) + (window-resize window delta nil nil pixelwise))) + ;; Else check whether the window is not high enough. + (let* ((min-size + (window-min-size window nil ignore pixelwise)) + (delta + (- min-size (window-size window nil pixelwise)))) + (when (and (> delta 0) + (window--resizable-p + window delta nil ignore nil nil nil pixelwise)) + (window-resize window delta nil ignore pixelwise)))) + ;; Adjust horizontally. + (if (or (memq window-size-fixed '(t width)) + (window-preserved-size window t)) + ;; A fixed width window, try to restore the original + ;; size. + (let ((delta + (- (cdr (assq + (if pixelwise 'pixel-width 'total-width) + item)) + (window-size window t pixelwise))) + window-size-fixed) + (when (window--resizable-p + window delta t nil nil nil nil pixelwise) + (window-resize window delta t nil pixelwise))) + ;; Else check whether the window is not wide enough. + (let* ((min-size (window-min-size window t ignore pixelwise)) + (delta (- min-size (window-size window t pixelwise)))) + (when (and (> delta 0) + (window--resizable-p + window delta t ignore nil nil nil pixelwise)) + (window-resize window delta t ignore pixelwise)))) + ;; Set dedicated status. + (set-window-dedicated-p window (cdr (assq 'dedicated state))) + ;; Install positions (maybe we should do this after all + ;; windows have been created and sized). + (ignore-errors + ;; Set 'noforce argument to avoid that window start + ;; overrides window point set below (Bug#24240). + (set-window-start window (cdr (assq 'start state)) 'noforce) + (set-window-point window (cdr (assq 'point state)))) + ;; Select window if it's the selected one. + (when (cdr (assq 'selected state)) + (select-window window)) + (when next-buffers + (set-window-next-buffers + window + (delq nil (mapcar (lambda (buffer) + (setq buffer (get-buffer buffer)) + (when (buffer-live-p buffer) buffer)) + next-buffers)))) + (when prev-buffers + (set-window-prev-buffers + window + (delq nil (mapcar (lambda (entry) + (let ((buffer (get-buffer (nth 0 entry))) + (m1 (nth 1 entry)) + (m2 (nth 2 entry))) + (when (buffer-live-p buffer) + (list buffer + (if (markerp m1) m1 + (set-marker (make-marker) m1 + buffer)) + (if (markerp m2) m2 + (set-marker (make-marker) m2 + buffer)))))) + prev-buffers))))) + ;; We don't want to raise an error in case the buffer does + ;; not exist anymore, so we switch to a previous one and + ;; save the window with the intention of deleting it later + ;; if possible. + (switch-to-prev-buffer window) + (push window window-state-put-stale-windows)))))))) (defun window-state-put (state &optional window ignore) "Put window state STATE into WINDOW. -- 2.21.0 (Apple Git-122)