Line data Source code
1 : ;;; frameset.el --- save and restore frame and window setup -*- lexical-binding: t -*-
2 :
3 : ;; Copyright (C) 2013-2017 Free Software Foundation, Inc.
4 :
5 : ;; Author: Juanma Barranquero <lekktu@gmail.com>
6 : ;; Keywords: convenience
7 :
8 : ;; This file is part of GNU Emacs.
9 :
10 : ;; GNU Emacs is free software: you can redistribute it and/or modify
11 : ;; it under the terms of the GNU General Public License as published by
12 : ;; the Free Software Foundation, either version 3 of the License, or
13 : ;; (at your option) any later version.
14 :
15 : ;; GNU Emacs is distributed in the hope that it will be useful,
16 : ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
17 : ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
18 : ;; GNU General Public License for more details.
19 :
20 : ;; You should have received a copy of the GNU General Public License
21 : ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
22 :
23 : ;;; Commentary:
24 :
25 : ;; This file provides a set of operations to save a frameset (the state
26 : ;; of all or a subset of the existing frames and windows), both
27 : ;; in-session and persistently, and restore it at some point in the
28 : ;; future.
29 : ;;
30 : ;; It should be noted that restoring the frames' windows depends on
31 : ;; the buffers they are displaying, but this package does not provide
32 : ;; any way to save and restore sets of buffers (see desktop.el for
33 : ;; that). So, it's up to the user of frameset.el to make sure that
34 : ;; any relevant buffer is loaded before trying to restore a frameset.
35 : ;; When a window is restored and a buffer is missing, the window will
36 : ;; be deleted unless it is the last one in the frame, in which case
37 : ;; some previous buffer will be shown instead.
38 :
39 : ;;; Code:
40 :
41 : (require 'cl-lib)
42 :
43 :
44 : (cl-defstruct (frameset (:type vector) :named
45 : (:constructor frameset--make)
46 : ;; Copier is defined below.
47 : (:copier nil))
48 :
49 : "A frameset encapsulates a serializable view of a set of frames and windows.
50 :
51 : It contains the following slots, which can be accessed with
52 : \(frameset-SLOT fs) and set with (setf (frameset-SLOT fs) VALUE):
53 :
54 : version A read-only version number, identifying the format
55 : of the frameset struct. Currently its value is 1.
56 : timestamp A read-only timestamp, the output of `current-time'.
57 : app A symbol, or a list whose first element is a symbol, which
58 : identifies the creator of the frameset and related info;
59 : for example, desktop.el sets this slot to a list
60 : `(desktop . ,desktop-file-version).
61 : name A string, the name of the frameset instance.
62 : description A string, a description for user consumption (to show in
63 : menus, messages, etc).
64 : properties A property list, to store both frameset-specific and
65 : user-defined serializable data.
66 : states A list of items (FRAME-PARAMETERS . WINDOW-STATE), in no
67 : particular order. Each item represents a frame to be
68 : restored. FRAME-PARAMETERS is a frame's parameter alist,
69 : extracted with (frame-parameters FRAME) and filtered
70 : through `frameset-filter-params'.
71 : WINDOW-STATE is the output of `window-state-get' applied
72 : to the root window of the frame.
73 :
74 : To avoid collisions, it is recommended that applications wanting to add
75 : private serializable data to `properties' either store all info under a
76 : single, distinctive name, or use property names with a well-chosen prefix.
77 :
78 : A frameset is intended to be used through the following simple API:
79 :
80 : - `frameset-save', the type's constructor, captures all or a subset of the
81 : live frames, and returns a serializable snapshot of them (a frameset).
82 : - `frameset-restore' takes a frameset, and restores the frames and windows
83 : it describes, as faithfully as possible.
84 : - `frameset-p' is the predicate for the frameset type.
85 : - `frameset-valid-p' checks a frameset's validity.
86 : - `frameset-copy' returns a deep copy of a frameset.
87 : - `frameset-prop' is a `setf'able accessor for the contents of the
88 : `properties' slot.
89 : - The `frameset-SLOT' accessors described above."
90 :
91 : (version 1 :read-only t)
92 0 : (timestamp (current-time) :read-only t)
93 : (app nil)
94 : (name nil)
95 : (description nil)
96 : (properties nil)
97 : (states nil))
98 :
99 : ;; Add nicer docstrings for built-in predicate and accessors.
100 : (put 'frameset-p 'function-documentation
101 : "Return non-nil if OBJECT is a frameset, nil otherwise.\n\n(fn OBJECT)")
102 : (put 'frameset-version 'function-documentation
103 : "Return the version number of FRAMESET.\n
104 : It is an integer that identifies the format of the frameset struct.
105 : This slot cannot be modified.\n\n(fn FRAMESET)")
106 : (put 'frameset-timestamp 'function-documentation
107 : "Return the creation timestamp of FRAMESET.\n
108 : The value is in the format returned by `current-time'.
109 : This slot cannot be modified.\n\n(fn FRAMESET)")
110 : (put 'frameset-app 'function-documentation
111 : "Return the application identifier for FRAMESET.\n
112 : The value is either a symbol, like `my-app', or a list
113 : \(my-app ADDITIONAL-DATA...).\n\n(fn FRAMESET)")
114 : (put 'frameset-name 'function-documentation
115 : "Return the name of FRAMESET (a string).\n\n(fn FRAMESET)")
116 : (put 'frameset-description 'function-documentation
117 : "Return the description of FRAMESET (a string).\n\n(fn FRAMESET)")
118 : (put 'frameset-properties 'function-documentation
119 : "Return the property list of FRAMESET.\n
120 : This list is useful to store both frameset-specific and user-defined
121 : serializable data. The simplest way to access and modify it is
122 : through `frameset-prop' (which see).\n\n(fn FRAMESET)")
123 : (put 'frameset-states 'function-documentation
124 : "Return the list of frame states of FRAMESET.\n
125 : A frame state is a pair (FRAME-PARAMETERS . WINDOW-STATE), where
126 : FRAME-PARAMETERS is a frame's parameter alist, extracted with
127 : \(frame-parameters FRAME) and filtered through `frameset-filter-params',
128 : and WINDOW-STATE is the output of `window-state-get' applied to the
129 : root window of the frame.\n
130 : IMPORTANT: Modifying this slot may cause frameset functions to fail,
131 : unless the type constraints defined above are respected.\n\n(fn FRAMESET)")
132 :
133 : ;; We autoloaded this for use in register.el, but now that we use registerv
134 : ;; objects, this autoload is not useful any more.
135 : ;; ;;;###autoload (autoload 'frameset-p "frameset"
136 : ;; ;;;###autoload "Return non-nil if OBJECT is a frameset, nil otherwise." nil)
137 :
138 : (defun frameset-copy (frameset)
139 : "Return a deep copy of FRAMESET.
140 : FRAMESET is copied with `copy-tree'."
141 0 : (copy-tree frameset t))
142 :
143 : (defun frameset-valid-p (object)
144 : "Return non-nil if OBJECT is a valid frameset, nil otherwise."
145 0 : (and (frameset-p object)
146 0 : (integerp (frameset-version object))
147 0 : (consp (frameset-timestamp object))
148 0 : (let ((app (frameset-app object)))
149 0 : (or (null app) ; APP is nil
150 0 : (symbolp app) ; or a symbol
151 0 : (and (consp app) ; or a list
152 0 : (symbolp (car app))))) ; starting with a symbol
153 0 : (stringp (or (frameset-name object) ""))
154 0 : (stringp (or (frameset-description object) ""))
155 0 : (listp (frameset-properties object))
156 0 : (let ((states (frameset-states object)))
157 0 : (and (listp states)
158 0 : (cl-every #'consp (frameset-states object))))
159 0 : (frameset-version object))) ; And VERSION is non-nil.
160 :
161 : (defun frameset--prop-setter (frameset property value)
162 : "Setter function for `frameset-prop'. Internal use only."
163 0 : (setf (frameset-properties frameset)
164 0 : (plist-put (frameset-properties frameset) property value))
165 0 : value)
166 :
167 : ;; A setf'able accessor to the frameset's properties
168 : (defun frameset-prop (frameset property)
169 : "Return the value for FRAMESET of PROPERTY.
170 :
171 : Properties can be set with
172 :
173 : (setf (frameset-prop FRAMESET PROPERTY) NEW-VALUE)"
174 : (declare (gv-setter frameset--prop-setter))
175 0 : (plist-get (frameset-properties frameset) property))
176 :
177 :
178 : ;; Filtering
179 :
180 : ;; What's the deal with these "filter alists"?
181 : ;;
182 : ;; Let's say that Emacs' frame parameters were never designed as a tool to
183 : ;; precisely record (or restore) a frame's state. They grew organically,
184 : ;; and their uses and behaviors reflect their history. In using them to
185 : ;; implement framesets, the unwary implementer, or the prospective package
186 : ;; writer willing to use framesets in their code, might fall victim of some
187 : ;; unexpected... oddities.
188 : ;;
189 : ;; You can find frame parameters that:
190 : ;;
191 : ;; - can be used to get and set some data from the frame's current state
192 : ;; (`height', `width')
193 : ;; - can be set at creation time, and setting them afterwards has no effect
194 : ;; (`window-state', `minibuffer')
195 : ;; - can be set at creation time, and setting them afterwards will fail with
196 : ;; an error, *unless* you set it to the same value, a noop (`border-width')
197 : ;; - act differently when passed at frame creation time, and when set
198 : ;; afterwards (`height')
199 : ;; - affect the value of other parameters (`name', `visibility')
200 : ;; - can be ignored by window managers (most positional args, like `height',
201 : ;; `width', `left' and `top', and others, like `auto-raise', `auto-lower')
202 : ;; - can be set externally in X resources or Window registry (again, most
203 : ;; positional parameters, and also `toolbar-lines', `menu-bar-lines' etc.)
204 : ;, - can contain references to live objects (`buffer-list', `minibuffer') or
205 : ;; code (`buffer-predicate')
206 : ;; - are set automatically, and cannot be changed (`window-id', `parent-id'),
207 : ;; but setting them produces no error
208 : ;; - have a noticeable effect in some window managers, and are ignored in
209 : ;; others (`menu-bar-lines')
210 : ;; - can not be safely set in a tty session and then copied back to a GUI
211 : ;; session (`font', `background-color', `foreground-color')
212 : ;;
213 : ;; etc etc.
214 : ;;
215 : ;; Which means that, in order to save a parameter alist to disk and read it
216 : ;; back later to reconstruct a frame, some processing must be done. That's
217 : ;; what `frameset-filter-params' and the `frameset-*-filter-alist' variables
218 : ;; are for.
219 : ;;
220 : ;; First, a clarification. The word "filter" in these names refers to both
221 : ;; common meanings of filter: to filter out (i.e., to remove), and to pass
222 : ;; through a transformation function (think `filter-buffer-substring').
223 : ;;
224 : ;; `frameset-filter-params' takes a parameter alist PARAMETERS, a filtering
225 : ;; alist FILTER-ALIST, and a flag SAVING to indicate whether we are filtering
226 : ;; parameters with the intent of saving a frame or restoring it. It then
227 : ;; accumulates an output alist, FILTERED, by checking each parameter in
228 : ;; PARAMETERS against FILTER-ALIST and obeying any rule found there. The
229 : ;; absence of a rule just means the parameter/value pair (called CURRENT in
230 : ;; filtering functions) is copied to FILTERED as is. Keyword values :save,
231 : ;; :restore and :never tell the function to copy CURRENT to FILTERED in the
232 : ;; respective situations, that is, when saving, restoring, or never at all.
233 : ;; Values :save and :restore are not used in this package, because usually if
234 : ;; you don't want to save a parameter, you don't want to restore it either.
235 : ;; But they can be useful, for example, if you already have a saved frameset
236 : ;; created with some intent, and want to reuse it for a different objective
237 : ;; where the expected parameter list has different requirements.
238 : ;;
239 : ;; Finally, the value can also be a filtering function, or a filtering
240 : ;; function plus some arguments. The function is called for each matching
241 : ;; parameter, and receives CURRENT (the parameter/value pair being processed),
242 : ;; FILTERED (the output alist so far), PARAMETERS (the full parameter alist),
243 : ;; SAVING (the save/restore flag), plus any additional ARGS set along the
244 : ;; function in the `frameset-*-filter-alist' entry. The filtering function
245 : ;; then has the possibility to pass along CURRENT, or reject it altogether,
246 : ;; or pass back a (NEW-PARAM . NEW-VALUE) pair, which does not even need to
247 : ;; refer to the same parameter (so you can filter `width' and return `height'
248 : ;; and vice versa, if you're feeling silly and want to mess with the user's
249 : ;; mind). As a help in deciding what to do, the filtering function has
250 : ;; access to PARAMETERS, but must not change it in any way. It also has
251 : ;; access to FILTERED, which can be modified at will. This allows two or
252 : ;; more filters to coordinate themselves, because in general there's no way
253 : ;; to predict the order in which they will be run.
254 : ;;
255 : ;; So, which parameters are filtered by default, and why? Let's see.
256 : ;;
257 : ;; - `buffer-list', `buried-buffer-list', `buffer-predicate': They contain
258 : ;; references to live objects, or in the case of `buffer-predicate', it
259 : ;; could also contain an fbound symbol (a predicate function) that could
260 : ;; not be defined in a later session.
261 : ;;
262 : ;; - `window-id', `outer-window-id', `parent-id': They are assigned
263 : ;; automatically and cannot be set, so keeping them is harmless, but they
264 : ;; add clutter. `window-system' is similar: it's assigned at frame
265 : ;; creation, and does not serve any useful purpose later.
266 : ;;
267 : ;; - `left', `top': Only problematic when saving an iconified frame, because
268 : ;; when the frame is iconified they are set to (- 32000), which doesn't
269 : ;; really help in restoring the frame. Better to remove them and let the
270 : ;; window manager choose a default position for the frame.
271 : ;;
272 : ;; - `background-color', `foreground-color': In tty frames they can be set
273 : ;; to "unspecified-bg" and "unspecified-fg", which aren't understood on
274 : ;; GUI sessions. They have to be filtered out when switching from tty to
275 : ;; a graphical display.
276 : ;;
277 : ;; - `tty', `tty-type': These are tty-specific. When switching to a GUI
278 : ;; display they do no harm, but they clutter the parameter alist.
279 : ;;
280 : ;; - `minibuffer': It can contain a reference to a live window, which cannot
281 : ;; be serialized. Because of Emacs' idiosyncratic treatment of this
282 : ;; parameter, frames created with (minibuffer . t) have a parameter
283 : ;; (minibuffer . #<window...>), while frames created with
284 : ;; (minibuffer . #<window...>) have (minibuffer . nil), which is madness
285 : ;; but helps to differentiate between minibufferless and "normal" frames.
286 : ;; So, changing (minibuffer . #<window...>) to (minibuffer . t) allows
287 : ;; Emacs to set up the new frame correctly. Nice, uh?
288 : ;;
289 : ;; - `name': If this parameter is directly set, `explicit-name' is
290 : ;; automatically set to t, and then `name' no longer changes dynamically.
291 : ;; So, in general, not saving `name' is the right thing to do, though
292 : ;; surely there are applications that will want to override this filter.
293 : ;;
294 : ;; - `font', `fullscreen', `height' and `width': These parameters suffer
295 : ;; from the fact that they are badly mangled when going through a
296 : ;; tty session, though not all in the same way. When saving a GUI frame
297 : ;; and restoring it in a tty, the height and width of the new frame are
298 : ;; those of the tty screen (let's say 80x25, for example); going back
299 : ;; to a GUI session means getting frames of the tty screen size (so all
300 : ;; your frames are 80 cols x 25 rows). For `fullscreen' there's a
301 : ;; similar problem, because a tty frame cannot really be fullscreen or
302 : ;; maximized, so the state is lost. The problem with `font' is a bit
303 : ;; different, because a valid GUI font spec in `font' turns into
304 : ;; (font . "tty") in a tty frame, and when read back into a GUI session
305 : ;; it fails because `font's value is no longer a valid font spec.
306 : ;;
307 : ;; In most cases, the filtering functions just do the obvious thing: remove
308 : ;; CURRENT when it is meaningless to keep it, or pass a modified copy if
309 : ;; that helps (as in the case of `minibuffer').
310 : ;;
311 : ;; The exception are the parameters in the last set, which should survive
312 : ;; the roundtrip though tty-land. The answer is to add "stashing
313 : ;; parameters", working in pairs, to shelve the GUI-specific contents and
314 : ;; restore it once we're back in pixel country. That's what functions
315 : ;; `frameset-filter-shelve-param' and `frameset-filter-unshelve-param' do.
316 : ;;
317 : ;; Basically, if you set `frameset-filter-shelve-param' as the filter for
318 : ;; a parameter P, it will detect when it is restoring a GUI frame into a
319 : ;; tty session, and save P's value in the custom parameter X:P, but only
320 : ;; if X:P does not exist already (so it is not overwritten if you enter
321 : ;; the tty session more than once). If you're not switching to a tty
322 : ;; frame, the filter just passes CURRENT along.
323 : ;;
324 : ;; The parameter X:P, on the other hand, must have been setup to be
325 : ;; filtered by `frameset-filter-unshelve-param', which unshelves the
326 : ;; value: if we're entering a GUI session, returns P instead of CURRENT,
327 : ;; while in other cases it just passes it along.
328 : ;;
329 : ;; The only additional trick is that `frameset-filter-shelve-param' does
330 : ;; not set P if switching back to GUI and P already has a value, because
331 : ;; it assumes that `frameset-filter-unshelve-param' did set it up. And
332 : ;; `frameset-filter-unshelve-param', when unshelving P, must look into
333 : ;; FILTERED to determine if P has already been set and if so, modify it;
334 : ;; else just returns P.
335 : ;;
336 : ;; Currently, the value of X in X:P is `GUI', but you can use any prefix,
337 : ;; by passing its symbol as argument in the filter:
338 : ;;
339 : ;; (my-parameter frameset-filter-shelve-param MYPREFIX)
340 : ;;
341 : ;; instead of
342 : ;;
343 : ;; (my-parameter . frameset-filter-shelve-param)
344 : ;;
345 : ;; Note that `frameset-filter-unshelve-param' does not need MYPREFIX
346 : ;; because it is available from the parameter name in CURRENT. Also note
347 : ;; that the colon between the prefix and the parameter name is hardcoded.
348 : ;; The reason is that X:P is quite readable, and that the colon is a
349 : ;; very unusual character in symbol names, other than in initial position
350 : ;; in keywords (emacs -Q has only two such symbols, and one of them is a
351 : ;; URL). So the probability of a collision with existing or future
352 : ;; symbols is quite insignificant.
353 : ;;
354 : ;; Now, what about the filter alist variables? There are three of them,
355 : ;; though only two sets of parameters:
356 : ;;
357 : ;; - `frameset-session-filter-alist' contains these filters that allow
358 : ;; saving and restoring framesets in-session, without the need to
359 : ;; serialize the frameset or save it to disk (for example, to save a
360 : ;; frameset in a register and restore it later). Filters in this
361 : ;; list do not remove live objects, except in `minibuffer', which is
362 : ;; dealt especially by `frameset-save' / `frameset-restore'.
363 : ;;
364 : ;; - `frameset-persistent-filter-alist' is the whole deal. It does all
365 : ;; the filtering described above, and the result is ready to be saved on
366 : ;; disk without loss of information. That's the format used by the
367 : ;; desktop.el package, for example.
368 : ;;
369 : ;; IMPORTANT: These variables share structure and should NEVER be modified.
370 : ;;
371 : ;; - `frameset-filter-alist': The value of this variable is the default
372 : ;; value for the FILTERS arguments of `frameset-save' and
373 : ;; `frameset-restore'. It is set to `frameset-persistent-filter-alist',
374 : ;; though it can be changed by specific applications.
375 : ;;
376 : ;; How to use them?
377 : ;;
378 : ;; The simplest way is just do nothing. The default should work
379 : ;; reasonably and sensibly enough. But, what if you really need a
380 : ;; customized filter alist? Then you can create your own variable
381 : ;;
382 : ;; (defvar my-filter-alist
383 : ;; '((my-param1 . :never)
384 : ;; (my-param2 . :save)
385 : ;; (my-param3 . :restore)
386 : ;; (my-param4 . my-filtering-function-without-args)
387 : ;; (my-param5 my-filtering-function-with arg1 arg2)
388 : ;; ;;; many other parameters
389 : ;; )
390 : ;; "My customized parameter filter alist.")
391 : ;;
392 : ;; or, if you're only changing a few items,
393 : ;;
394 : ;; (defvar my-filter-alist
395 : ;; (nconc '((my-param1 . :never)
396 : ;; (my-param2 . my-filtering-function))
397 : ;; frameset-filter-alist)
398 : ;; "My brief customized parameter filter alist.")
399 : ;;
400 : ;; and pass it to the FILTER arg of the save/restore functions,
401 : ;; ALWAYS taking care of not modifying the original lists; if you're
402 : ;; going to do any modifying of my-filter-alist, please use
403 : ;;
404 : ;; (nconc '((my-param1 . :never) ...)
405 : ;; (copy-sequence frameset-filter-alist))
406 : ;;
407 : ;; One thing you shouldn't forget is that they are alists, so searching
408 : ;; in them is sequential. If you just want to change the default of
409 : ;; `name' to allow it to be saved, you can set (name . nil) in your
410 : ;; customized filter alist; it will take precedence over the latter
411 : ;; setting. In case you decide that you *always* want to save `name',
412 : ;; you can add it to `frameset-filter-alist':
413 : ;;
414 : ;; (push '(name . nil) frameset-filter-alist)
415 : ;;
416 : ;; In certain applications, having a parameter filtering function like
417 : ;; `frameset-filter-params' can be useful, even if you're not using
418 : ;; framesets. The interface of `frameset-filter-params' is generic
419 : ;; and does not depend of global state, with one exception: it uses
420 : ;; the dynamically bound variable `frameset--target-display' to decide
421 : ;; if, and how, to modify the `display' parameter of FILTERED. That
422 : ;; should not represent a problem, because it's only meaningful when
423 : ;; restoring, and customized uses of `frameset-filter-params' are
424 : ;; likely to use their own filter alist and just call
425 : ;;
426 : ;; (setq my-filtered (frameset-filter-params my-params my-filters t))
427 : ;;
428 : ;; In case you want to use it with the standard filters, you can
429 : ;; wrap the call to `frameset-filter-params' in a let form to bind
430 : ;; `frameset--target-display' to nil or the desired value.
431 : ;;
432 :
433 : ;;;###autoload
434 : (defvar frameset-session-filter-alist
435 : '((name . :never)
436 : (left . frameset-filter-iconified)
437 : (minibuffer . frameset-filter-minibuffer)
438 : (top . frameset-filter-iconified))
439 : "Minimum set of parameters to filter for live (on-session) framesets.
440 : DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
441 :
442 : ;;;###autoload
443 : (defvar frameset-persistent-filter-alist
444 : (nconc
445 : '((background-color . frameset-filter-sanitize-color)
446 : (buffer-list . :never)
447 : (buffer-predicate . :never)
448 : (buried-buffer-list . :never)
449 : (delete-before . :never)
450 : (font . frameset-filter-shelve-param)
451 : (foreground-color . frameset-filter-sanitize-color)
452 : (fullscreen . frameset-filter-shelve-param)
453 : (GUI:font . frameset-filter-unshelve-param)
454 : (GUI:fullscreen . frameset-filter-unshelve-param)
455 : (GUI:height . frameset-filter-unshelve-param)
456 : (GUI:width . frameset-filter-unshelve-param)
457 : (height . frameset-filter-shelve-param)
458 : (outer-window-id . :never)
459 : (parent-frame . :never)
460 : (parent-id . :never)
461 : (mouse-wheel-frame . :never)
462 : (tty . frameset-filter-tty-to-GUI)
463 : (tty-type . frameset-filter-tty-to-GUI)
464 : (width . frameset-filter-shelve-param)
465 : (window-id . :never)
466 : (window-system . :never))
467 : frameset-session-filter-alist)
468 : "Parameters to filter for persistent framesets.
469 : DO NOT MODIFY. See `frameset-filter-alist' for a full description.")
470 :
471 : ;;;###autoload
472 : (defvar frameset-filter-alist frameset-persistent-filter-alist
473 : "Alist of frame parameters and filtering functions.
474 :
475 : This alist is the default value of the FILTERS argument of
476 : `frameset-save' and `frameset-restore' (which see).
477 :
478 : Initially, `frameset-filter-alist' is set to, and shares the value of,
479 : `frameset-persistent-filter-alist'. You can override any item in
480 : this alist by `push'ing a new item onto it. If, for some reason, you
481 : intend to modify existing values, do
482 :
483 : (setq frameset-filter-alist (copy-tree frameset-filter-alist))
484 :
485 : before changing anything.
486 :
487 : On saving, PARAMETERS is the parameter alist of each frame processed,
488 : and FILTERED is the parameter alist that gets saved to the frameset.
489 :
490 : On restoring, PARAMETERS is the parameter alist extracted from the
491 : frameset, and FILTERED is the resulting frame parameter alist used
492 : to restore the frame.
493 :
494 : Elements of `frameset-filter-alist' are conses (PARAM . ACTION),
495 : where PARAM is a parameter name (a symbol identifying a frame
496 : parameter), and ACTION can be:
497 :
498 : nil The parameter is copied to FILTERED.
499 : :never The parameter is never copied to FILTERED.
500 : :save The parameter is copied only when saving the frame.
501 : :restore The parameter is copied only when restoring the frame.
502 : FILTER A filter function.
503 :
504 : FILTER can be a symbol FILTER-FUN, or a list (FILTER-FUN ARGS...).
505 : FILTER-FUN is invoked with
506 :
507 : (apply FILTER-FUN CURRENT FILTERED PARAMETERS SAVING ARGS)
508 :
509 : where
510 :
511 : CURRENT A cons (PARAM . VALUE), where PARAM is the one being
512 : filtered and VALUE is its current value.
513 : FILTERED The resulting alist (so far).
514 : PARAMETERS The complete alist of parameters being filtered,
515 : SAVING Non-nil if filtering before saving state, nil if filtering
516 : before restoring it.
517 : ARGS Any additional arguments specified in the ACTION.
518 :
519 : FILTER-FUN is allowed to modify items in FILTERED, but no other arguments.
520 : It must return:
521 : nil Skip CURRENT (do not add it to FILTERED).
522 : t Add CURRENT to FILTERED as is.
523 : (NEW-PARAM . NEW-VALUE) Add this to FILTERED instead of CURRENT.
524 :
525 : Frame parameters not on this alist are passed intact, as if they were
526 : defined with ACTION = nil.")
527 :
528 : ;; Dynamically bound in `frameset-save', `frameset-restore'.
529 : (defvar frameset--target-display)
530 : ;; Either (display . VALUE) or nil.
531 : ;; This refers to the current frame config being processed with
532 : ;; `frameset-filter-params' and its auxiliary filtering functions.
533 : ;; If nil, there is no need to change the display.
534 : ;; If non-nil, display parameter to use when creating the frame.
535 :
536 : (defun frameset-switch-to-gui-p (parameters)
537 : "True when switching to a graphic display.
538 : Return non-nil if the parameter alist PARAMETERS describes a frame on a
539 : text-only terminal, and the frame is being restored on a graphic display;
540 : otherwise return nil. Only meaningful when called from a filtering
541 : function in `frameset-filter-alist'."
542 0 : (and frameset--target-display ; we're switching
543 0 : (null (cdr (assq 'display parameters))) ; from a tty
544 0 : (cdr frameset--target-display))) ; to a GUI display
545 :
546 : (defun frameset-switch-to-tty-p (parameters)
547 : "True when switching to a text-only terminal.
548 : Return non-nil if the parameter alist PARAMETERS describes a frame on a
549 : graphic display, and the frame is being restored on a text-only terminal;
550 : otherwise return nil. Only meaningful when called from a filtering
551 : function in `frameset-filter-alist'."
552 0 : (and frameset--target-display ; we're switching
553 0 : (cdr (assq 'display parameters)) ; from a GUI display
554 0 : (null (cdr frameset--target-display)))) ; to a tty
555 :
556 : (defun frameset-filter-tty-to-GUI (_current _filtered parameters saving)
557 : "Remove CURRENT when switching from tty to a graphic display.
558 :
559 : For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING,
560 : see `frameset-filter-alist'."
561 0 : (or saving
562 0 : (not (frameset-switch-to-gui-p parameters))))
563 :
564 : (defun frameset-filter-sanitize-color (current _filtered parameters saving)
565 : "When switching to a GUI frame, remove \"unspecified\" colors.
566 : Useful as a filter function for tty-specific parameters.
567 :
568 : For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING,
569 : see `frameset-filter-alist'."
570 0 : (or saving
571 0 : (not (frameset-switch-to-gui-p parameters))
572 0 : (not (stringp (cdr current)))
573 0 : (not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
574 :
575 : (defun frameset-filter-minibuffer (current filtered _parameters saving)
576 : "Force the minibuffer parameter to have a sensible value.
577 :
578 : When saving, convert (minibuffer . #<window>) to (minibuffer . nil).
579 : When restoring, if there are two copies, keep the one pointing to
580 : a live window.
581 :
582 : For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING,
583 : see `frameset-filter-alist'."
584 0 : (let ((value (cdr current)) mini)
585 0 : (cond (saving
586 : ;; "Fix semantics of 'minibuffer' frame parameter" change:
587 : ;; When the cdr of the parameter is a minibuffer window, save
588 : ;; (minibuffer . nil) instead of (minibuffer . t).
589 0 : (if (windowp value)
590 : '(minibuffer . nil)
591 0 : t))
592 0 : ((setq mini (assq 'minibuffer filtered))
593 0 : (when (windowp value) (setcdr mini value))
594 : nil)
595 0 : (t t))))
596 :
597 : (defun frameset-filter-shelve-param (current _filtered parameters saving
598 : &optional prefix)
599 : "When switching to a tty frame, save parameter P as PREFIX:P.
600 : The parameter can be later restored with `frameset-filter-unshelve-param'.
601 : PREFIX defaults to `GUI'.
602 :
603 : For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING,
604 : see `frameset-filter-alist'."
605 0 : (unless prefix (setq prefix 'GUI))
606 0 : (cond (saving t)
607 0 : ((frameset-switch-to-tty-p parameters)
608 0 : (let ((prefix:p (intern (format "%s:%s" prefix (car current)))))
609 0 : (if (assq prefix:p parameters)
610 : nil
611 0 : (cons prefix:p (cdr current)))))
612 0 : ((frameset-switch-to-gui-p parameters)
613 0 : (not (assq (intern (format "%s:%s" prefix (car current))) parameters)))
614 0 : (t t)))
615 :
616 : (defun frameset-filter-unshelve-param (current filtered parameters saving)
617 : "When switching to a GUI frame, restore PREFIX:P parameter as P.
618 : CURRENT must be of the form (PREFIX:P . value).
619 :
620 : For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING,
621 : see `frameset-filter-alist'."
622 0 : (or saving
623 0 : (not (frameset-switch-to-gui-p parameters))
624 0 : (let* ((prefix:p (symbol-name (car current)))
625 0 : (p (intern (substring prefix:p
626 0 : (1+ (string-match-p ":" prefix:p)))))
627 0 : (val (cdr current))
628 0 : (found (assq p filtered)))
629 0 : (if (not found)
630 0 : (cons p val)
631 0 : (setcdr found val)
632 0 : nil))))
633 :
634 : (defun frameset-filter-iconified (_current _filtered parameters saving)
635 : "Remove CURRENT when saving an iconified frame.
636 : This is used for positional parameters `left' and `top', which are
637 : meaningless in an iconified frame, so the frame is restored in a
638 : default position.
639 :
640 : For the meaning of CURRENT, FILTERED, PARAMETERS and SAVING,
641 : see `frameset-filter-alist'."
642 0 : (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon))))
643 :
644 : (defun frameset-filter-params (parameters filter-alist saving)
645 : "Filter parameter alist PARAMETERS and return a filtered alist.
646 : FILTER-ALIST is an alist of parameter filters, in the format of
647 : `frameset-filter-alist' (which see).
648 : SAVING is non-nil while filtering parameters to save a frameset,
649 : nil while the filtering is done to restore it."
650 0 : (let ((filtered nil))
651 0 : (dolist (current parameters)
652 : ;; When saving, the parameter alist is temporary, so modifying it
653 : ;; is not a problem. When restoring, the parameter alist is part
654 : ;; of a frameset, so we must copy parameters to avoid inadvertent
655 : ;; modifications.
656 0 : (pcase (cdr (assq (car current) filter-alist))
657 : (`nil
658 0 : (push (if saving current (copy-tree current)) filtered))
659 : (:never
660 : nil)
661 : (:restore
662 0 : (unless saving (push (copy-tree current) filtered)))
663 : (:save
664 0 : (when saving (push current filtered)))
665 : ((or `(,fun . ,args) (and fun (pred fboundp)))
666 0 : (let* ((this (apply fun current filtered parameters saving args))
667 0 : (val (if (eq this t) current this)))
668 0 : (when val
669 0 : (push (if saving val (copy-tree val)) filtered))))
670 : (other
671 0 : (delay-warning 'frameset (format "Unknown filter %S" other) :error))))
672 : ;; Set the display parameter after filtering, so that filter functions
673 : ;; have access to its original value.
674 0 : (when frameset--target-display
675 0 : (setf (alist-get 'display filtered) (cdr frameset--target-display)))
676 0 : filtered))
677 :
678 :
679 : ;; Frame ids
680 :
681 : (defun frameset--set-id (frame)
682 : "Set FRAME's id if not yet set.
683 : Internal use only."
684 0 : (unless (frame-parameter frame 'frameset--id)
685 0 : (set-frame-parameter frame
686 : 'frameset--id
687 0 : (mapconcat (lambda (n) (format "%04X" n))
688 0 : (cl-loop repeat 4 collect (random 65536))
689 0 : "-"))))
690 :
691 : (defun frameset-cfg-id (frame-cfg)
692 : "Return the frame id for frame configuration FRAME-CFG."
693 0 : (cdr (assq 'frameset--id frame-cfg)))
694 :
695 : ;;;###autoload
696 : (defun frameset-frame-id (frame)
697 : "Return the frame id of FRAME, if it has one; else, return nil.
698 : A frame id is a string that uniquely identifies a frame.
699 : It is persistent across `frameset-save' / `frameset-restore'
700 : invocations, and once assigned is never changed unless the same
701 : frame is duplicated (via `frameset-restore'), in which case the
702 : newest frame keeps the id and the old frame's is set to nil."
703 0 : (frame-parameter frame 'frameset--id))
704 :
705 : ;;;###autoload
706 : (defun frameset-frame-id-equal-p (frame id)
707 : "Return non-nil if FRAME's id matches ID."
708 0 : (string= (frameset-frame-id frame) id))
709 :
710 : ;;;###autoload
711 : (defun frameset-frame-with-id (id &optional frame-list)
712 : "Return the live frame with id ID, if exists; else nil.
713 : If FRAME-LIST is a list of frames, check these frames only.
714 : If nil, check all live frames."
715 0 : (cl-find-if (lambda (f)
716 0 : (and (frame-live-p f)
717 0 : (frameset-frame-id-equal-p f id)))
718 0 : (or frame-list (frame-list))))
719 :
720 :
721 : ;; Saving framesets
722 :
723 : (defun frameset--record-relationships (frame-list)
724 : "Process FRAME-LIST and record relationships.
725 : FRAME-LIST is a list of frames.
726 :
727 : The relationships recorded for each frame are
728 :
729 : - `minibuffer' via `frameset--mini'
730 : - `delete-before' via `frameset--delete-before'
731 : - `parent-frame' via `frameset--parent-frame'
732 : - `mouse-wheel-frame' via `frameset--mouse-wheel-frame'
733 :
734 : Internal use only."
735 : ;; Record frames with their own minibuffer
736 0 : (dolist (frame (minibuffer-frame-list))
737 0 : (when (memq frame frame-list)
738 0 : (frameset--set-id frame)
739 : ;; For minibuffer-owning frames, frameset--mini is a cons
740 : ;; (t . DEFAULT?), where DEFAULT? is a boolean indicating whether
741 : ;; the frame is the one pointed out by `default-minibuffer-frame'.
742 0 : (set-frame-parameter frame
743 : 'frameset--mini
744 0 : (cons t (eq frame default-minibuffer-frame)))))
745 : ;; Now link minibufferless frames with their minibuffer frames and
746 : ;; store `parent-frame', `delete-before' and `mouse-wheel-frame'
747 : ;; relationships in a similar way.
748 0 : (dolist (frame frame-list)
749 0 : (let ((parent-frame (frame-parent frame))
750 0 : (delete-before (frame-parameter frame 'delete-before))
751 0 : (mouse-wheel-frame (frame-parameter frame 'mouse-wheel-frame))
752 0 : (nomini (not (frame-parameter frame 'frameset--mini))))
753 0 : (when (or nomini parent-frame delete-before mouse-wheel-frame)
754 0 : (when nomini
755 0 : (frameset--set-id frame))
756 0 : (when parent-frame
757 0 : (set-frame-parameter
758 0 : frame 'frameset--parent-frame (frameset-frame-id parent-frame)))
759 0 : (when delete-before
760 0 : (set-frame-parameter
761 0 : frame 'frameset--delete-before (frameset-frame-id delete-before)))
762 0 : (when mouse-wheel-frame
763 0 : (set-frame-parameter
764 0 : frame 'frameset--mouse-wheel-frame
765 0 : (frameset-frame-id mouse-wheel-frame)))
766 0 : (when nomini
767 0 : (let ((mb-frame (window-frame (minibuffer-window frame))))
768 : ;; For minibufferless frames, frameset--mini is a cons
769 : ;; (nil . FRAME-ID), where FRAME-ID is the frameset--id of
770 : ;; the frame containing its minibuffer window.
771 : ;; FRAME-ID can be set to nil, if FRAME-LIST doesn't contain
772 : ;; the minibuffer frame of a minibufferless frame; we allow
773 : ;; it without trying to second-guess the user.
774 0 : (set-frame-parameter
775 0 : frame
776 : 'frameset--mini
777 0 : (cons nil
778 0 : (and mb-frame
779 0 : (frameset-frame-id mb-frame))))))))))
780 :
781 : ;;;###autoload
782 : (cl-defun frameset-save (frame-list
783 : &key app name description
784 : filters predicate properties)
785 : "Return a frameset for FRAME-LIST, a list of frames.
786 : Dead frames and non-frame objects are silently removed from the list.
787 : If nil, FRAME-LIST defaults to the output of `frame-list' (all live frames).
788 : APP, NAME and DESCRIPTION are optional data; see the docstring of the
789 : `frameset' defstruct for details.
790 : FILTERS is an alist of parameter filters; if nil, the value of the variable
791 : `frameset-filter-alist' is used instead.
792 : PREDICATE is a predicate function, which must return non-nil for frames that
793 : should be saved; if PREDICATE is nil, all frames from FRAME-LIST are saved.
794 : PROPERTIES is a user-defined property list to add to the frameset."
795 0 : (let* ((list (or (copy-sequence frame-list) (frame-list)))
796 : (frameset--target-display nil)
797 0 : (frames (cl-delete-if-not #'frame-live-p
798 0 : (if predicate
799 0 : (cl-delete-if-not predicate list)
800 0 : list)))
801 : fs)
802 0 : (frameset--record-relationships frames)
803 0 : (setq fs (frameset--make
804 0 : :app app
805 0 : :name name
806 0 : :description description
807 0 : :properties properties
808 0 : :states (mapcar
809 : (lambda (frame)
810 0 : (cons
811 0 : (frameset-filter-params (frame-parameters frame)
812 0 : (or filters
813 0 : frameset-filter-alist)
814 0 : t)
815 0 : (window-state-get (frame-root-window frame) t)))
816 0 : frames)))
817 0 : (cl-assert (frameset-valid-p fs))
818 0 : fs))
819 :
820 :
821 : ;; Restoring framesets
822 :
823 : ;; Dynamically bound in `frameset-restore'.
824 : (defvar frameset--reuse-list)
825 : (defvar frameset--action-map)
826 :
827 : (defun frameset-compute-pos (value left/top right/bottom)
828 : "Return an absolute positioning value for a frame.
829 : VALUE is the value of a positional frame parameter (`left' or `top').
830 : If VALUE is relative to the screen edges (like (+ -35) or (-200), it is
831 : converted to absolute by adding it to the corresponding edge; if it is
832 : an absolute position, it is returned unmodified.
833 : LEFT/TOP and RIGHT/BOTTOM indicate the dimensions of the screen in
834 : pixels along the relevant direction: either the position of the left
835 : and right edges for a `left' positional parameter, or the position of
836 : the top and bottom edges for a `top' parameter."
837 0 : (pcase value
838 0 : (`(+ ,val) (+ left/top val))
839 0 : (`(- ,val) (+ right/bottom val))
840 0 : (val val)))
841 :
842 : (defun frameset-move-onscreen (frame force-onscreen)
843 : "If FRAME is offscreen, move it back onscreen and, if necessary, resize it.
844 : For the description of FORCE-ONSCREEN, see `frameset-restore'.
845 : When forced onscreen, frames wider than the monitor's workarea are converted
846 : to fullwidth, and frames taller than the workarea are converted to fullheight.
847 : NOTE: This only works for non-iconified frames."
848 0 : (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr (frame-monitor-attributes frame)))
849 0 : (right (+ left width -1))
850 0 : (bottom (+ top height -1))
851 0 : (fr-left (frameset-compute-pos (frame-parameter frame 'left) left right))
852 0 : (fr-top (frameset-compute-pos (frame-parameter frame 'top) top bottom))
853 0 : (ch-width (frame-char-width frame))
854 0 : (ch-height (frame-char-height frame))
855 0 : (fr-width (max (frame-pixel-width frame) (* ch-width (frame-width frame))))
856 0 : (fr-height (max (frame-pixel-height frame) (* ch-height (frame-height frame))))
857 0 : (fr-right (+ fr-left fr-width -1))
858 0 : (fr-bottom (+ fr-top fr-height -1)))
859 0 : (when (pcase force-onscreen
860 : ;; A predicate.
861 : ((pred functionp)
862 0 : (funcall force-onscreen
863 0 : frame
864 0 : (list fr-left fr-top fr-width fr-height)
865 0 : (list left top width height)))
866 : ;; Any corner is outside the screen.
867 0 : (:all (or (< fr-bottom top) (> fr-bottom bottom)
868 0 : (< fr-left left) (> fr-left right)
869 0 : (< fr-right left) (> fr-right right)
870 0 : (< fr-top top) (> fr-top bottom)))
871 : ;; Displaced to the left, right, above or below the screen.
872 0 : (`t (or (> fr-left right)
873 0 : (< fr-right left)
874 0 : (> fr-top bottom)
875 0 : (< fr-bottom top)))
876 : ;; Fully inside, no need to do anything.
877 0 : (_ nil))
878 0 : (let ((fullwidth (> fr-width width))
879 0 : (fullheight (> fr-height height))
880 : (params nil))
881 : ;; Position frame horizontally.
882 0 : (cond (fullwidth
883 0 : (push `(left . ,left) params))
884 0 : ((> fr-right right)
885 0 : (push `(left . ,(+ left (- width fr-width))) params))
886 0 : ((< fr-left left)
887 0 : (push `(left . ,left) params)))
888 : ;; Position frame vertically.
889 0 : (cond (fullheight
890 0 : (push `(top . ,top) params))
891 0 : ((> fr-bottom bottom)
892 0 : (push `(top . ,(+ top (- height fr-height))) params))
893 0 : ((< fr-top top)
894 0 : (push `(top . ,top) params)))
895 : ;; Compute fullscreen state, if required.
896 0 : (when (or fullwidth fullheight)
897 0 : (push (cons 'fullscreen
898 0 : (cond ((not fullwidth) 'fullheight)
899 0 : ((not fullheight) 'fullwidth)
900 0 : (t 'maximized)))
901 0 : params))
902 : ;; Finally, move the frame back onscreen.
903 0 : (when params
904 0 : (modify-frame-parameters frame params))))))
905 :
906 : (defun frameset--find-frame-if (predicate display &rest args)
907 : "Find a reusable frame satisfying PREDICATE.
908 : Look through available frames whose display property matches DISPLAY
909 : and return the first one for which (PREDICATE frame ARGS) returns t.
910 : If PREDICATE is nil, it is always satisfied. Internal use only."
911 0 : (cl-find-if (lambda (frame)
912 0 : (and (equal (frame-parameter frame 'display) display)
913 0 : (or (null predicate)
914 0 : (apply predicate frame args))))
915 0 : frameset--reuse-list))
916 :
917 : (defun frameset--reuse-frame (display parameters)
918 : "Return an existing frame to reuse, or nil if none found.
919 : DISPLAY is the display where the frame will be shown, and PARAMETERS
920 : is the parameter alist of the frame being restored. Internal use only."
921 0 : (let ((frame nil)
922 : mini)
923 : ;; There are no fancy heuristics there. We could implement some
924 : ;; based on frame size and/or position, etc., but it is not clear
925 : ;; that any "gain" (in the sense of reduced flickering, etc.) is
926 : ;; worth the added complexity. In fact, the code below mainly
927 : ;; tries to work nicely when M-x desktop-read is used after a
928 : ;; desktop session has already been loaded. The other main use
929 : ;; case, which is the initial desktop-read upon starting Emacs,
930 : ;; will usually have only one frame, and should already work.
931 0 : (cond ((null display)
932 : ;; When the target is tty, every existing frame is reusable.
933 0 : (setq frame (frameset--find-frame-if nil display)))
934 0 : ((car (setq mini (cdr (assq 'frameset--mini parameters))))
935 : ;; If the frame has its own minibuffer, let's see whether
936 : ;; that frame has already been loaded (which can happen after
937 : ;; M-x desktop-read).
938 0 : (setq frame (frameset--find-frame-if
939 : (lambda (f id)
940 0 : (frameset-frame-id-equal-p f id))
941 0 : display (frameset-cfg-id parameters)))
942 : ;; If it has not been loaded, and it is not a minibuffer-only frame,
943 : ;; let's look for an existing non-minibuffer-only frame to reuse.
944 0 : (unless (or frame (eq (cdr (assq 'minibuffer parameters)) 'only))
945 : ;; "Fix semantics of 'minibuffer' frame parameter" change:
946 : ;; The 'minibuffer' frame parameter of a non-minibuffer-only
947 : ;; frame is t instead of that frame's minibuffer window.
948 0 : (setq frame (frameset--find-frame-if
949 : (lambda (f)
950 0 : (eq (frame-parameter f 'minibuffer) t))
951 0 : display))))
952 0 : (mini
953 : ;; For minibufferless frames, check whether they already exist,
954 : ;; and that they are linked to the right minibuffer frame.
955 0 : (setq frame (frameset--find-frame-if
956 : (lambda (f id mini-id)
957 0 : (and (frameset-frame-id-equal-p f id)
958 0 : (or (null mini-id) ; minibuffer frame not saved
959 0 : (frameset-frame-id-equal-p
960 0 : (window-frame (minibuffer-window f))
961 0 : mini-id))))
962 0 : display (frameset-cfg-id parameters) (cdr mini))))
963 : (t
964 : ;; Default to just finding a frame in the same display.
965 0 : (setq frame (frameset--find-frame-if nil display))))
966 : ;; If found, remove from the list.
967 0 : (when frame
968 0 : (setq frameset--reuse-list (delq frame frameset--reuse-list)))
969 0 : frame))
970 :
971 : (defun frameset--initial-params (parameters)
972 : "Return a list of PARAMETERS that must be set when creating the frame.
973 : Setting position and size parameters as soon as possible helps reducing
974 : flickering; other parameters, like `minibuffer' and `border-width', can
975 : not be changed once the frame has been created. Internal use only."
976 0 : (cl-loop for param in '(left top width height border-width minibuffer)
977 0 : when (assq param parameters) collect it))
978 :
979 : (defun frameset--restore-frame (parameters window-state filters force-onscreen)
980 : "Set up and return a frame according to its saved state.
981 : That means either reusing an existing frame or creating one anew.
982 : PARAMETERS is the frame's parameter alist; WINDOW-STATE is its window state.
983 : For the meaning of FILTERS and FORCE-ONSCREEN, see `frameset-restore'.
984 : Internal use only."
985 0 : (let* ((fullscreen (cdr (assq 'fullscreen parameters)))
986 0 : (filtered-cfg (frameset-filter-params parameters filters nil))
987 0 : (display (cdr (assq 'display filtered-cfg))) ;; post-filtering
988 : alt-cfg frame)
989 :
990 0 : (when fullscreen
991 : ;; Currently Emacs has the limitation that it does not record the size
992 : ;; and position of a frame before maximizing it, so we cannot save &
993 : ;; restore that info. Instead, when restoring, we resort to creating
994 : ;; invisible "fullscreen" frames of default size and then maximizing them
995 : ;; (and making them visible) which at least is somewhat user-friendly
996 : ;; when these frames are later de-maximized.
997 0 : (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg))))
998 0 : (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg))))
999 0 : (visible (assq 'visibility filtered-cfg)))
1000 0 : (setq filtered-cfg (cl-delete-if (lambda (p)
1001 0 : (memq p '(visibility fullscreen width height)))
1002 0 : filtered-cfg :key #'car))
1003 0 : (when width
1004 0 : (setq filtered-cfg (append `((user-size . t) (width . ,width))
1005 0 : filtered-cfg)))
1006 0 : (when height
1007 0 : (setq filtered-cfg (append `((user-size . t) (height . ,height))
1008 0 : filtered-cfg)))
1009 : ;; These are parameters to apply after creating/setting the frame.
1010 0 : (push visible alt-cfg)
1011 0 : (push (cons 'fullscreen fullscreen) alt-cfg)))
1012 :
1013 : ;; Time to find or create a frame and apply the big bunch of parameters.
1014 0 : (setq frame (and frameset--reuse-list
1015 0 : (frameset--reuse-frame display filtered-cfg)))
1016 0 : (if frame
1017 0 : (puthash frame :reused frameset--action-map)
1018 : ;; If a frame needs to be created and it falls partially or fully offscreen,
1019 : ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards is
1020 : ;; allowed. So we create the frame as invisible and then reapply the full
1021 : ;; parameter alist (including position and size parameters).
1022 0 : (setq frame (make-frame-on-display display
1023 0 : (cons '(visibility)
1024 0 : (frameset--initial-params filtered-cfg))))
1025 0 : (puthash frame :created frameset--action-map))
1026 :
1027 : ;; Try to assign parent-frame right here - it will improve things
1028 : ;; for minibuffer-less child frames.
1029 0 : (let* ((frame-id (frame-parameter frame 'frameset--parent-frame))
1030 : (parent-frame
1031 0 : (and frame-id (frameset-frame-with-id frame-id))))
1032 0 : (when (frame-live-p parent-frame)
1033 0 : (set-frame-parameter frame 'parent-frame parent-frame)))
1034 :
1035 0 : (modify-frame-parameters frame
1036 0 : (if (eq (frame-parameter frame 'fullscreen) fullscreen)
1037 : ;; Workaround for bug#14949
1038 0 : (assq-delete-all 'fullscreen filtered-cfg)
1039 0 : filtered-cfg))
1040 :
1041 : ;; If requested, force frames to be onscreen.
1042 0 : (when (and force-onscreen
1043 : ;; FIXME: iconified frames should be checked too,
1044 : ;; but it is impossible without deiconifying them.
1045 0 : (not (eq (frame-parameter frame 'visibility) 'icon)))
1046 0 : (frameset-move-onscreen frame force-onscreen))
1047 :
1048 : ;; Let's give the finishing touches (visibility, maximization).
1049 0 : (when alt-cfg (modify-frame-parameters frame alt-cfg))
1050 : ;; Now restore window state.
1051 0 : (window-state-put window-state (frame-root-window frame) 'safe)
1052 0 : frame))
1053 :
1054 : (defun frameset--minibufferless-last-p (state1 state2)
1055 : "Predicate to sort frame states in an order suitable for creating frames.
1056 : It sorts minibuffer-owning frames before minibufferless ones.
1057 : Internal use only."
1058 0 : (pcase-let ((`(,hasmini1 ,id-def1) (assq 'frameset--mini (car state1)))
1059 0 : (`(,hasmini2 ,id-def2) (assq 'frameset--mini (car state2))))
1060 0 : (cond ((eq id-def1 t) t)
1061 0 : ((eq id-def2 t) nil)
1062 0 : ((not (eq hasmini1 hasmini2)) (eq hasmini1 t))
1063 0 : ((eq hasmini1 nil) (or id-def1 id-def2))
1064 0 : (t t))))
1065 :
1066 : (defun frameset-keep-original-display-p (force-display)
1067 : "True if saved frames' displays should be honored.
1068 : For the meaning of FORCE-DISPLAY, see `frameset-restore'."
1069 0 : (cond ((eq system-type 'windows-nt) nil) ;; Does ns support more than one display?
1070 0 : ((daemonp) t)
1071 0 : (t (not force-display))))
1072 :
1073 : (defun frameset-minibufferless-first-p (frame1 _frame2)
1074 : "Predicate to sort minibuffer-less frames before other frames."
1075 : ;; "Fix semantics of 'minibuffer' frame parameter" change: The
1076 : ;; 'minibuffer' frame parameter of a minibuffer-less frame is that
1077 : ;; frame's minibuffer window instead of nil.
1078 0 : (windowp (frame-parameter frame1 'minibuffer)))
1079 :
1080 : ;;;###autoload
1081 : (cl-defun frameset-restore (frameset
1082 : &key predicate filters reuse-frames
1083 : force-display force-onscreen
1084 : cleanup-frames)
1085 : "Restore a FRAMESET into the current display(s).
1086 :
1087 : PREDICATE is a function called with two arguments, the parameter alist
1088 : and the window-state of the frame being restored, in that order (see
1089 : the docstring of the `frameset' defstruct for additional details).
1090 : If PREDICATE returns nil, the frame described by that parameter alist
1091 : and window-state is not restored.
1092 :
1093 : FILTERS is an alist of parameter filters; if nil, the value of
1094 : `frameset-filter-alist' is used instead.
1095 :
1096 : REUSE-FRAMES selects the policy to reuse frames when restoring:
1097 : t All existing frames can be reused.
1098 : nil No existing frame can be reused.
1099 : match Only frames with matching frame ids can be reused.
1100 : PRED A predicate function; it receives as argument a live frame,
1101 : and must return non-nil to allow reusing it, nil otherwise.
1102 :
1103 : FORCE-DISPLAY can be:
1104 : t Frames are restored in the current display.
1105 : nil Frames are restored, if possible, in their original displays.
1106 : delete Frames in other displays are deleted instead of restored.
1107 : PRED A function called with two arguments, the parameter alist and
1108 : the window state (in that order). It must return t, nil or
1109 : `delete', as above but affecting only the frame that will
1110 : be created from that parameter alist.
1111 :
1112 : FORCE-ONSCREEN can be:
1113 : t Force onscreen only those frames that are fully offscreen.
1114 : nil Do not force any frame back onscreen.
1115 : all Force onscreen any frame fully or partially offscreen.
1116 : PRED A function called with three arguments,
1117 : - the live frame just restored,
1118 : - a list (LEFT TOP WIDTH HEIGHT), describing the frame,
1119 : - a list (LEFT TOP WIDTH HEIGHT), describing the workarea.
1120 : It must return non-nil to force the frame onscreen, nil otherwise.
1121 :
1122 : CLEANUP-FRAMES allows \"cleaning up\" the frame list after restoring a frameset:
1123 : t Delete all frames that were not created or restored upon.
1124 : nil Keep all frames.
1125 : FUNC A function called with two arguments:
1126 : - FRAME, a live frame.
1127 : - ACTION, which can be one of
1128 : :rejected Frame existed, but was not a candidate for reuse.
1129 : :ignored Frame existed, was a candidate, but wasn't reused.
1130 : :reused Frame existed, was a candidate, and restored upon.
1131 : :created Frame didn't exist, was created and restored upon.
1132 : Return value is ignored.
1133 :
1134 : Note the timing and scope of the operations described above: REUSE-FRAMES
1135 : affects existing frames; PREDICATE, FILTERS and FORCE-DISPLAY affect the frame
1136 : being restored before that happens; FORCE-ONSCREEN affects the frame once
1137 : it has been restored; and CLEANUP-FRAMES affects all frames alive after the
1138 : restoration, including those that have been reused or created anew.
1139 :
1140 : All keyword parameters default to nil."
1141 :
1142 0 : (cl-assert (frameset-valid-p frameset))
1143 :
1144 0 : (let* ((frames (frame-list))
1145 0 : (frameset--action-map (make-hash-table :test #'eq))
1146 : ;; frameset--reuse-list is a list of frames potentially reusable. Later we
1147 : ;; will decide which ones can be reused, and how to deal with any leftover.
1148 : (frameset--reuse-list
1149 0 : (pcase reuse-frames
1150 : (`t
1151 0 : frames)
1152 : (`nil
1153 : nil)
1154 : (`match
1155 0 : (cl-loop for (state) in (frameset-states frameset)
1156 0 : when (frameset-frame-with-id (frameset-cfg-id state) frames)
1157 0 : collect it))
1158 : ((pred functionp)
1159 0 : (cl-remove-if-not reuse-frames frames))
1160 : (_
1161 0 : (error "Invalid arg :reuse-frames %s" reuse-frames)))))
1162 :
1163 : ;; Mark existing frames in the map; candidates to reuse are marked as :ignored;
1164 : ;; they will be reassigned later, if chosen.
1165 0 : (dolist (frame frames)
1166 0 : (puthash frame
1167 0 : (if (memq frame frameset--reuse-list) :ignored :rejected)
1168 0 : frameset--action-map))
1169 :
1170 : ;; Sort saved states to guarantee that minibufferless frames will be created
1171 : ;; after the frames that contain their minibuffer windows.
1172 0 : (dolist (state (sort (copy-sequence (frameset-states frameset))
1173 0 : #'frameset--minibufferless-last-p))
1174 0 : (pcase-let ((`(,frame-cfg . ,window-cfg) state))
1175 0 : (when (or (null predicate) (funcall predicate frame-cfg window-cfg))
1176 0 : (condition-case-unless-debug err
1177 0 : (let* ((d-mini (cdr (assq 'frameset--mini frame-cfg)))
1178 0 : (mb-id (cdr d-mini))
1179 0 : (default (and (car d-mini) mb-id))
1180 0 : (force-display (if (functionp force-display)
1181 0 : (funcall force-display frame-cfg window-cfg)
1182 0 : force-display))
1183 : (frameset--target-display nil)
1184 : frame to-tty duplicate)
1185 : ;; Only set target if forcing displays and the target display is different.
1186 0 : (unless (or (frameset-keep-original-display-p force-display)
1187 0 : (equal (frame-parameter nil 'display)
1188 0 : (cdr (assq 'display frame-cfg))))
1189 0 : (setq frameset--target-display (cons 'display
1190 0 : (frame-parameter nil 'display))
1191 0 : to-tty (null (cdr frameset--target-display))))
1192 : ;; Time to restore frames and set up their minibuffers as they were.
1193 : ;; We only skip a frame (thus deleting it) if either:
1194 : ;; - we're switching displays, and the user chose the option to delete, or
1195 : ;; - we're switching to tty, and the frame to restore is minibuffer-only.
1196 0 : (unless (and frameset--target-display
1197 0 : (or (eq force-display 'delete)
1198 0 : (and to-tty
1199 0 : (eq (cdr (assq 'minibuffer frame-cfg)) 'only))))
1200 : ;; To avoid duplicating frame ids after restoration, we note any
1201 : ;; existing frame whose id matches a frame configuration in the
1202 : ;; frameset. Once the frame config is properly restored, we can
1203 : ;; reset the old frame's id to nil.
1204 0 : (setq duplicate (frameset-frame-with-id (frameset-cfg-id frame-cfg)
1205 0 : frames))
1206 : ;; Restore minibuffers. Some of this stuff could be done in a filter
1207 : ;; function, but it would be messy because restoring minibuffers affects
1208 : ;; global state; it's best to do it here than add a bunch of global
1209 : ;; variables to pass info back-and-forth to/from the filter function.
1210 0 : (cond
1211 0 : ((null d-mini)) ;; No frameset--mini. Process as normal frame.
1212 0 : (to-tty) ;; Ignore minibuffer stuff and process as normal frame.
1213 0 : ((car d-mini) ;; Frame has minibuffer (or it is minibuffer-only).
1214 0 : (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
1215 0 : (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0))
1216 0 : frame-cfg))))
1217 : (t ;; Frame depends on other frame's minibuffer window.
1218 0 : (when mb-id
1219 0 : (let ((mb-frame (frameset-frame-with-id mb-id))
1220 : (mb-window nil))
1221 0 : (if (not mb-frame)
1222 0 : (delay-warning 'frameset
1223 0 : (format "Minibuffer frame %S not found" mb-id)
1224 0 : :warning)
1225 0 : (setq mb-window (minibuffer-window mb-frame))
1226 0 : (unless (and (window-live-p mb-window)
1227 0 : (window-minibuffer-p mb-window))
1228 0 : (delay-warning 'frameset
1229 0 : (format "Not a minibuffer window %s" mb-window)
1230 0 : :warning)
1231 0 : (setq mb-window nil)))
1232 0 : (when mb-window
1233 0 : (push (cons 'minibuffer mb-window) frame-cfg))))))
1234 : ;; OK, we're ready at last to create (or reuse) a frame and
1235 : ;; restore the window config.
1236 0 : (setq frame (frameset--restore-frame frame-cfg window-cfg
1237 0 : (or filters frameset-filter-alist)
1238 0 : force-onscreen))
1239 : ;; Now reset any duplicate frameset--id
1240 0 : (when (and duplicate (not (eq frame duplicate)))
1241 0 : (set-frame-parameter duplicate 'frameset--id nil))
1242 : ;; Set default-minibuffer if required.
1243 0 : (when default (setq default-minibuffer-frame frame))))
1244 : (error
1245 0 : (delay-warning 'frameset (error-message-string err) :error))))))
1246 :
1247 : ;; Setting the parent frame after the frame has been created is a
1248 : ;; pain because one can see the frame move on the screen. Ideally,
1249 : ;; we would restore minibuffer equipped child frames after their
1250 : ;; respective parents have been made but this might interfere with
1251 : ;; the reordering of minibuffer frames. Left to the experts ...
1252 0 : (dolist (frame (frame-list))
1253 0 : (let* ((frame-id (frame-parameter frame 'frameset--parent-frame))
1254 : (parent-frame
1255 0 : (and frame-id (frameset-frame-with-id frame-id))))
1256 0 : (when (and (not (eq (frame-parameter frame 'parent-frame) parent-frame))
1257 0 : (frame-live-p parent-frame))
1258 0 : (set-frame-parameter frame 'parent-frame parent-frame)))
1259 0 : (let* ((frame-id (frame-parameter frame 'frameset--delete-before))
1260 : (delete-before
1261 0 : (and frame-id (frameset-frame-with-id frame-id))))
1262 0 : (when (frame-live-p delete-before)
1263 0 : (set-frame-parameter frame 'delete-before delete-before)))
1264 0 : (let* ((frame-id (frame-parameter frame 'frameset--mouse-wheel-frame))
1265 : (mouse-wheel-frame
1266 0 : (and frame-id (frameset-frame-with-id frame-id))))
1267 0 : (when (frame-live-p mouse-wheel-frame)
1268 0 : (set-frame-parameter frame 'mouse-wheel-frame mouse-wheel-frame))))
1269 :
1270 : ;; In case we try to delete the initial frame, we want to make sure that
1271 : ;; other frames are already visible (discussed in thread for bug#14841).
1272 0 : (sit-for 0 t)
1273 :
1274 : ;; Clean up the frame list
1275 0 : (when cleanup-frames
1276 0 : (let ((map nil)
1277 0 : (cleanup (if (eq cleanup-frames t)
1278 : (lambda (frame action)
1279 0 : (when (memq action '(:rejected :ignored))
1280 0 : (delete-frame frame)))
1281 0 : cleanup-frames)))
1282 0 : (maphash (lambda (frame _action) (push frame map)) frameset--action-map)
1283 0 : (dolist (frame (sort map
1284 : ;; Minibufferless frames must go first to avoid
1285 : ;; errors when attempting to delete a frame whose
1286 : ;; minibuffer window is used by another frame.
1287 0 : #'frameset-minibufferless-first-p))
1288 0 : (condition-case-unless-debug err
1289 0 : (funcall cleanup frame (gethash frame frameset--action-map))
1290 : (error
1291 0 : (delay-warning 'frameset (error-message-string err) :warning))))))
1292 :
1293 : ;; Make sure there's at least one visible frame.
1294 0 : (unless (or (daemonp)
1295 0 : (catch 'visible
1296 0 : (maphash (lambda (frame _)
1297 0 : (and (frame-live-p frame) (frame-visible-p frame)
1298 0 : (throw 'visible t)))
1299 0 : frameset--action-map)))
1300 0 : (make-frame-visible (selected-frame)))))
1301 :
1302 :
1303 : ;; Register support
1304 :
1305 : ;;;###autoload
1306 : (defun frameset--jump-to-register (data)
1307 : "Restore frameset from DATA stored in register.
1308 : Called from `jump-to-register'. Internal use only."
1309 0 : (frameset-restore
1310 0 : (aref data 0)
1311 0 : :filters frameset-session-filter-alist
1312 0 : :reuse-frames (if current-prefix-arg t 'match)
1313 0 : :cleanup-frames (if current-prefix-arg
1314 : ;; delete frames
1315 : nil
1316 : ;; iconify frames
1317 : (lambda (frame action)
1318 0 : (pcase action
1319 0 : (`rejected (iconify-frame frame))
1320 : ;; In the unexpected case that a frame was a candidate
1321 : ;; (matching frame id) and yet not restored, remove it
1322 : ;; because it is in fact a duplicate.
1323 0 : (`ignored (delete-frame frame))))))
1324 :
1325 : ;; Restore selected frame, buffer and point.
1326 0 : (let ((frame (frameset-frame-with-id (aref data 1)))
1327 : buffer window)
1328 0 : (when frame
1329 0 : (select-frame-set-input-focus frame)
1330 0 : (when (and (buffer-live-p (setq buffer (marker-buffer (aref data 2))))
1331 0 : (window-live-p (setq window (get-buffer-window buffer frame))))
1332 0 : (set-frame-selected-window frame window)
1333 0 : (with-current-buffer buffer (goto-char (aref data 2)))))))
1334 :
1335 : ;;;###autoload
1336 : (defun frameset--print-register (data)
1337 : "Print basic info about frameset stored in DATA.
1338 : Called from `list-registers' and `view-register'. Internal use only."
1339 0 : (let* ((fs (aref data 0))
1340 0 : (ns (length (frameset-states fs))))
1341 0 : (princ (format "a frameset (%d frame%s, saved on %s)."
1342 0 : ns
1343 0 : (if (= 1 ns) "" "s")
1344 0 : (format-time-string "%c" (frameset-timestamp fs))))))
1345 :
1346 : ;;;###autoload
1347 : (defun frameset-to-register (register)
1348 : "Store the current frameset in register REGISTER.
1349 : Use \\[jump-to-register] to restore the frameset.
1350 : Argument is a character, naming the register.
1351 :
1352 : Interactively, reads the register using `register-read-with-preview'."
1353 0 : (interactive (list (register-read-with-preview "Frameset to register: ")))
1354 0 : (set-register register
1355 0 : (registerv-make
1356 0 : (vector (frameset-save nil
1357 : :app 'register
1358 0 : :filters frameset-session-filter-alist)
1359 : ;; frameset-save does not include the value of point
1360 : ;; in the current buffer, so record that separately.
1361 0 : (frameset-frame-id nil)
1362 0 : (point-marker))
1363 0 : :print-func #'frameset--print-register
1364 0 : :jump-func #'frameset--jump-to-register)))
1365 :
1366 : (provide 'frameset)
1367 :
1368 : ;;; frameset.el ends here
|