From: Yuan Fu <casouri@gmail.com>
To: Juri Linkov <juri@linkov.net>
Cc: Emacs developers <emacs-devel@gnu.org>
Subject: Re: Customize ‘window-state-get/put’
Date: Wed, 09 Oct 2019 20:35:51 -0400 [thread overview]
Message-ID: <m2r23ljv2w.fsf@gmail.com> (raw)
In-Reply-To: <87lfttbo70.fsf@mail.linkov.net>
[-- Attachment #1: Type: text/plain, Size: 1727 bytes --]
> But fortunately now we have window-states that are better suitable to build
> the feature that you are adding. So if you will have such template based
> on exported window-state layout:
>
> (hc (vc (leaf (buffer "\\`\\*\\(locals\\|registers\\) of .*\\*\\'"))
> (leaf (buffer "\\`\\*\\(breakpoints\\|threads\\) of .*\\*\\'")))
> (vc (leaf (buffer "\\`\\*memory of .*\\*\\'"))
> (leaf (buffer "\\`\\*stack frames of .*\\*\\'"))))
>
> (window-sizes are omitted in this example, but they could be expressed
> as percentage of relative window dimensions)
>
> then calling (display-buffer "*memory of emacs*") could search in
> such window-tree, find a window that matches the buffer name and
> display this buffer in it.
>
> This could be implemented by just adding a new display-buffer action.
I’m not sure what are you trying to do overall. Why don’t I just create
the buffer by the buffer configurations I saved when saving the window
configuration?
OTOH, here is an experiment I did earlier today. I optionally replace
the buffer names and configurations with a function when saving window
config. So instead of
(buffer "*scratch*"
(selected . t)
...
(dedicated)
(point . 290)
(start . 1))
I save
(buffer lambda nil
(create-my-buffer "some useful info"))
And when window-state-put finds out the data is not buffer name but a
function, it simply calls the function to restore the buffer. This way
we can store information about the buffer and how to restore it in a
rather compact way. The change to existing code is pretty small, too.
WDYT?
Yuan
[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-window.patch --]
[-- Type: text/x-patch, Size: 14739 bytes --]
From 9853d8e0f529be0b495415674e96346e575787e9 Mon Sep 17 00:00:00 2001
From: Yuan Fu <casouri@gmail.com>
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)
next prev parent reply other threads:[~2019-10-10 0:35 UTC|newest]
Thread overview: 15+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-10-07 16:19 Customize ‘window-state-get/put’ Yuan Fu
2019-10-07 22:01 ` Juri Linkov
2019-10-08 0:13 ` Yuan Fu
2019-10-09 22:31 ` Juri Linkov
2019-10-10 0:35 ` Yuan Fu [this message]
2019-10-10 21:54 ` Juri Linkov
2019-10-11 1:38 ` Yuan Fu
2019-10-11 8:18 ` martin rudalics
2019-10-12 16:25 ` Yuan Fu
2019-10-13 8:17 ` martin rudalics
2019-10-12 20:58 ` Juri Linkov
2019-10-14 3:39 ` Yuan Fu
2019-10-15 18:14 ` Juri Linkov
2019-10-08 8:05 ` Eli Zaretskii
2019-10-08 8:45 ` martin rudalics
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=m2r23ljv2w.fsf@gmail.com \
--to=casouri@gmail.com \
--cc=emacs-devel@gnu.org \
--cc=juri@linkov.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this external index
https://git.savannah.gnu.org/cgit/emacs.git
https://git.savannah.gnu.org/cgit/emacs/org-mode.git
This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.