New macro to iterate over live buffers similar to frames.
[bpt/emacs.git] / lisp / frameset.el
CommitLineData
9421876d
JB
1;;; frameset.el --- save and restore frame and window setup -*- lexical-binding: t -*-
2
3;; Copyright (C) 2013 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\f
44;; Framesets have two fields:
45;; - properties: a property list to store both frameset-specific and
46;; user-defined serializable data. Currently defined properties
47;; include:
48;; :version ID - Identifies the version of the frameset struct;
d5671a82
JB
49;; this is the only property always present and
50;; must not be modified.
9421876d 51;; :app APPINFO - Freeform. Can be used by applications and
d5671a82
JB
52;; packages to indicate the intended (but by no
53;; means exclusive) use of the frameset. For
54;; example, currently desktop.el sets :app to
55;; `(desktop . ,desktop-file-version).
9421876d
JB
56;; :name NAME - The name of the frameset instance; a string.
57;; :desc TEXT - A description for user consumption (to choose
d5671a82 58;; among framesets, etc.); a string.
9421876d
JB
59;; - states: an alist of items (FRAME-PARAMETERS . WINDOW-STATE) in
60;; no particular order. Each item represents a frame to be
61;; restored.
62
63(cl-defstruct (frameset (:type list) :named
64 (:copier nil)
65 (:predicate nil))
66 properties ;; property list
67 states) ;; list of conses (frame-state . window-state)
68
69(defun copy-frameset (frameset)
70 "Return a copy of FRAMESET.
71This is a deep copy done with `copy-tree'."
72 (copy-tree frameset t))
73
51d30f2c 74;;;###autoload
9421876d
JB
75(defun frameset-p (frameset)
76 "If FRAMESET is a frameset, return its :version.
77Else return nil."
78 (and (eq (car-safe frameset) 'frameset)
79 (plist-get (cl-second frameset) :version)))
80
2613dea2
JB
81;; A setf'able accessor to the frameset's properties
82(defun frameset-prop (frameset prop)
83 "Return the value of the PROP property of FRAMESET.
84
85Properties other than :version can be set with
86
87 (setf (frameset-prop FRAMESET PROP) NEW-VALUE)"
88 (plist-get (frameset-properties frameset) prop))
89
6475c94b
JB
90(gv-define-setter frameset-prop (val fs prop)
91 (macroexp-let2 nil v val
92 `(progn
93 (cl-assert (not (eq ,prop :version)) t ":version can not be set")
94 (setf (frameset-properties ,fs)
95 (plist-put (frameset-properties ,fs) ,prop ,v))
96 ,v)))
2613dea2 97
9421876d
JB
98\f
99;; Filtering
100
d5671a82
JB
101;;;###autoload
102(defvar frameset-live-filter-alist
103 '((name . t)
104 (minibuffer . frameset-filter-minibuffer)
105 (top . frameset-filter-iconified))
106 "Minimum set of parameters to filter for live (on-session) framesets.
107See `frameset-filter-alist' for a full description.")
108
109;;;###autoload
110(defvar frameset-persistent-filter-alist
111 (nconc
112 '((background-color . frameset-filter-sanitize-color)
113 (buffer-list . t)
114 (buffer-predicate . t)
115 (buried-buffer-list . t)
116 (font . frameset-filter-save-parm)
117 (foreground-color . frameset-filter-sanitize-color)
118 (fullscreen . frameset-filter-save-parm)
119 (GUI:font . frameset-filter-restore-parm)
120 (GUI:fullscreen . frameset-filter-restore-parm)
121 (GUI:height . frameset-filter-restore-parm)
122 (GUI:width . frameset-filter-restore-parm)
123 (height . frameset-filter-save-parm)
124 (left . frameset-filter-iconified)
125 (outer-window-id . t)
126 (parent-id . t)
127 (tty . frameset-filter-tty-to-GUI)
128 (tty-type . frameset-filter-tty-to-GUI)
129 (width . frameset-filter-save-parm)
130 (window-id . t)
131 (window-system . t))
132 frameset-live-filter-alist)
133 "Recommended set of parameters to filter for persistent framesets.
134See `frameset-filter-alist' for a full description.")
135
136;;;###autoload
137(defvar frameset-filter-alist frameset-persistent-filter-alist
9421876d
JB
138 "Alist of frame parameters and filtering functions.
139
140Each element is a cons (PARAM . ACTION), where PARAM is a parameter
141name (a symbol identifying a frame parameter), and ACTION can be:
142
d5671a82
JB
143 t The parameter is always removed from the parameter list.
144 :save The parameter is removed when saving the frame.
9421876d 145 :restore The parameter is removed when restoring the frame.
d5671a82 146 FILTER A filter function.
9421876d
JB
147
148FILTER can be a symbol FILTER-FUN, or a list (FILTER-FUN ARGS...).
149It will be called with four arguments CURRENT, FILTERED, PARAMETERS
150and SAVING, plus any additional ARGS:
151
152 CURRENT A cons (PARAM . VALUE), where PARAM is the one being
d5671a82 153 filtered and VALUE is its current value.
9421876d
JB
154 FILTERED The alist of parameters filtered so far.
155 PARAMETERS The complete alist of parameters being filtered,
d5671a82 156 SAVING Non-nil if filtering before saving state, nil otherwise.
9421876d
JB
157
158The FILTER-FUN function must return:
d5671a82
JB
159 nil CURRENT is removed from the list.
160 t CURRENT is left as is.
9421876d
JB
161 (PARAM' . VALUE') Replace CURRENT with this.
162
163Frame parameters not on this list are passed intact.")
164
165(defvar frameset--target-display nil
166 ;; Either (minibuffer . VALUE) or nil.
167 ;; This refers to the current frame config being processed inside
168 ;; `frame--restore-frames' and its auxiliary functions (like filtering).
169 ;; If nil, there is no need to change the display.
170 ;; If non-nil, display parameter to use when creating the frame.
171 "Internal use only.")
172
173(defun frameset-switch-to-gui-p (parameters)
174 "True when switching to a graphic display.
175Return t if PARAMETERS describes a text-only terminal and
176the target is a graphic display; otherwise return nil.
177Only meaningful when called from a filtering function in
178`frameset-filter-alist'."
d5671a82
JB
179 (and frameset--target-display ; we're switching
180 (null (cdr (assq 'display parameters))) ; from a tty
181 (cdr frameset--target-display))) ; to a GUI display
9421876d
JB
182
183(defun frameset-switch-to-tty-p (parameters)
184 "True when switching to a text-only terminal.
185Return t if PARAMETERS describes a graphic display and
186the target is a text-only terminal; otherwise return nil.
187Only meaningful when called from a filtering function in
188`frameset-filter-alist'."
189 (and frameset--target-display ; we're switching
d5671a82 190 (cdr (assq 'display parameters)) ; from a GUI display
9421876d
JB
191 (null (cdr frameset--target-display)))) ; to a tty
192
d5671a82
JB
193(defun frameset-filter-tty-to-GUI (_current _filtered parameters saving)
194 "Remove CURRENT when switching from tty to a graphic display."
195 (or saving
196 (not (frameset-switch-to-gui-p parameters))))
197
9421876d
JB
198(defun frameset-filter-sanitize-color (current _filtered parameters saving)
199 "When switching to a GUI frame, remove \"unspecified\" colors.
200Useful as a filter function for tty-specific parameters."
201 (or saving
202 (not (frameset-switch-to-gui-p parameters))
203 (not (stringp (cdr current)))
204 (not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
205
206(defun frameset-filter-minibuffer (current _filtered _parameters saving)
51d30f2c 207 "When saving, convert (minibuffer . #<window>) parameter to (minibuffer . t)."
9421876d
JB
208 (or (not saving)
209 (if (windowp (cdr current))
210 '(minibuffer . t)
211 t)))
212
213(defun frameset-filter-save-parm (current _filtered parameters saving
214 &optional prefix)
215 "When switching to a tty frame, save parameter P as PREFIX:P.
216The parameter can be later restored with `frameset-filter-restore-parm'.
217PREFIX defaults to `GUI'."
218 (unless prefix (setq prefix 'GUI))
219 (cond (saving t)
220 ((frameset-switch-to-tty-p parameters)
221 (let ((prefix:p (intern (format "%s:%s" prefix (car current)))))
222 (if (assq prefix:p parameters)
223 nil
224 (cons prefix:p (cdr current)))))
225 ((frameset-switch-to-gui-p parameters)
226 (not (assq (intern (format "%s:%s" prefix (car current))) parameters)))
227 (t t)))
228
229(defun frameset-filter-restore-parm (current filtered parameters saving)
230 "When switching to a GUI frame, restore PREFIX:P parameter as P.
231CURRENT must be of the form (PREFIX:P . value)."
232 (or saving
233 (not (frameset-switch-to-gui-p parameters))
234 (let* ((prefix:p (symbol-name (car current)))
235 (p (intern (substring prefix:p
236 (1+ (string-match-p ":" prefix:p)))))
237 (val (cdr current))
238 (found (assq p filtered)))
239 (if (not found)
240 (cons p val)
241 (setcdr found val)
242 nil))))
243
244(defun frameset-filter-iconified (_current _filtered parameters saving)
245 "Remove CURRENT when saving an iconified frame.
246This is used for positions parameters `left' and `top', which are
247meaningless in an iconified frame, so the frame is restored in a
248default position."
249 (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon))))
250
9421876d
JB
251(defun frameset-filter-params (parameters filter-alist saving)
252 "Filter parameter list PARAMETERS and return a filtered list.
253FILTER-ALIST is an alist of parameter filters, in the format of
254`frameset-filter-alist' (which see).
255SAVING is non-nil while filtering parameters to save a frameset,
256nil while the filtering is done to restore it."
257 (let ((filtered nil))
258 (dolist (current parameters)
259 (pcase (cdr (assq (car current) filter-alist))
260 (`nil
261 (push current filtered))
262 (`t
263 nil)
264 (:save
265 (unless saving (push current filtered)))
266 (:restore
267 (when saving (push current filtered)))
268 ((or `(,fun . ,args) (and fun (pred fboundp)))
f078d570 269 (let ((this (apply fun current filtered parameters saving args)))
9421876d
JB
270 (when this
271 (push (if (eq this t) current this) filtered))))
272 (other
273 (delay-warning 'frameset (format "Unknown filter %S" other) :error))))
274 ;; Set the display parameter after filtering, so that filter functions
275 ;; have access to its original value.
276 (when frameset--target-display
277 (let ((display (assq 'display filtered)))
278 (if display
279 (setcdr display (cdr frameset--target-display))
280 (push frameset--target-display filtered))))
281 filtered))
282
283\f
284;; Saving framesets
285
286(defun frameset--set-id (frame)
d5671a82 287 "Set FRAME's `frameset--id' if not yet set.
9421876d 288Internal use only."
d5671a82 289 (unless (frame-parameter frame 'frameset--id)
9421876d 290 (set-frame-parameter frame
d5671a82 291 'frameset--id
9421876d
JB
292 (mapconcat (lambda (n) (format "%04X" n))
293 (cl-loop repeat 4 collect (random 65536))
294 "-"))))
295
296(defun frameset--process-minibuffer-frames (frame-list)
297 "Process FRAME-LIST and record minibuffer relationships.
d5671a82 298FRAME-LIST is a list of frames. Internal use only."
9421876d
JB
299 ;; Record frames with their own minibuffer
300 (dolist (frame (minibuffer-frame-list))
301 (when (memq frame frame-list)
302 (frameset--set-id frame)
303 ;; For minibuffer-owning frames, frameset--mini is a cons
304 ;; (t . DEFAULT?), where DEFAULT? is a boolean indicating whether
305 ;; the frame is the one pointed out by `default-minibuffer-frame'.
306 (set-frame-parameter frame
307 'frameset--mini
308 (cons t (eq frame default-minibuffer-frame)))))
309 ;; Now link minibufferless frames with their minibuffer frames
310 (dolist (frame frame-list)
311 (unless (frame-parameter frame 'frameset--mini)
312 (frameset--set-id frame)
313 (let* ((mb-frame (window-frame (minibuffer-window frame)))
d5671a82 314 (id (and mb-frame (frame-parameter mb-frame 'frameset--id))))
9421876d
JB
315 (if (null id)
316 (error "Minibuffer frame %S for %S is excluded" mb-frame frame)
317 ;; For minibufferless frames, frameset--mini is a cons
d5671a82
JB
318 ;; (nil . FRAME-ID), where FRAME-ID is the frameset--id
319 ;; of the frame containing its minibuffer window.
9421876d
JB
320 (set-frame-parameter frame
321 'frameset--mini
322 (cons nil id)))))))
323
51d30f2c 324;;;###autoload
9421876d
JB
325(cl-defun frameset-save (frame-list &key filters predicate properties)
326 "Return the frameset of FRAME-LIST, a list of frames.
327If nil, FRAME-LIST defaults to all live frames.
328FILTERS is an alist of parameter filters; defaults to `frameset-filter-alist'.
329PREDICATE is a predicate function, which must return non-nil for frames that
330should be saved; it defaults to saving all frames from FRAME-LIST.
331PROPERTIES is a user-defined property list to add to the frameset."
332 (let ((frames (cl-delete-if-not #'frame-live-p
2613dea2
JB
333 (cl-delete-if-not (or predicate #'framep)
334 (or (copy-sequence frame-list)
335 (frame-list))))))
9421876d
JB
336 (frameset--process-minibuffer-frames frames)
337 (make-frameset :properties (append '(:version 1) properties)
338 :states (mapcar
339 (lambda (frame)
340 (cons
341 (frameset-filter-params (frame-parameters frame)
342 (or filters
343 frameset-filter-alist)
344 t)
345 (window-state-get (frame-root-window frame) t)))
346 frames))))
347
348\f
349;; Restoring framesets
350
351(defvar frameset--reuse-list nil
352 "Internal use only.")
353
354(defun frameset--compute-pos (value left/top right/bottom)
355 (pcase value
356 (`(+ ,val) (+ left/top val))
357 (`(- ,val) (+ right/bottom val))
358 (val val)))
359
360(defun frameset--move-onscreen (frame force-onscreen)
361 "If FRAME is offscreen, move it back onscreen and, if necessary, resize it.
362For the description of FORCE-ONSCREEN, see `frameset-restore'.
363When forced onscreen, frames wider than the monitor's workarea are converted
364to fullwidth, and frames taller than the workarea are converted to fullheight.
365NOTE: This only works for non-iconified frames. Internal use only."
366 (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr (frame-monitor-attributes frame)))
d5671a82
JB
367 (right (+ left width -1))
368 (bottom (+ top height -1))
369 (fr-left (frameset--compute-pos (frame-parameter frame 'left) left right))
370 (fr-top (frameset--compute-pos (frame-parameter frame 'top) top bottom))
9421876d
JB
371 (ch-width (frame-char-width frame))
372 (ch-height (frame-char-height frame))
d5671a82
JB
373 (fr-width (max (frame-pixel-width frame) (* ch-width (frame-width frame))))
374 (fr-height (max (frame-pixel-height frame) (* ch-height (frame-height frame))))
375 (fr-right (+ fr-left fr-width -1))
376 (fr-bottom (+ fr-top fr-height -1)))
9421876d 377 (when (pcase force-onscreen
d5671a82
JB
378 ;; A predicate.
379 ((pred functionp)
380 (funcall force-onscreen
381 frame
382 (list fr-left fr-top fr-width fr-height)
383 (list left top width height)))
9421876d 384 ;; Any corner is outside the screen.
d5671a82 385 (:all (or (< fr-bottom top) (> fr-bottom bottom)
9421876d
JB
386 (< fr-left left) (> fr-left right)
387 (< fr-right left) (> fr-right right)
d5671a82 388 (< fr-top top) (> fr-top bottom)))
9421876d 389 ;; Displaced to the left, right, above or below the screen.
d5671a82 390 (`t (or (> fr-left right)
9421876d 391 (< fr-right left)
d5671a82 392 (> fr-top bottom)
9421876d
JB
393 (< fr-bottom top)))
394 ;; Fully inside, no need to do anything.
395 (_ nil))
396 (let ((fullwidth (> fr-width width))
397 (fullheight (> fr-height height))
398 (params nil))
399 ;; Position frame horizontally.
400 (cond (fullwidth
401 (push `(left . ,left) params))
402 ((> fr-right right)
403 (push `(left . ,(+ left (- width fr-width))) params))
404 ((< fr-left left)
405 (push `(left . ,left) params)))
406 ;; Position frame vertically.
407 (cond (fullheight
408 (push `(top . ,top) params))
409 ((> fr-bottom bottom)
410 (push `(top . ,(+ top (- height fr-height))) params))
411 ((< fr-top top)
412 (push `(top . ,top) params)))
413 ;; Compute fullscreen state, if required.
414 (when (or fullwidth fullheight)
415 (push (cons 'fullscreen
416 (cond ((not fullwidth) 'fullheight)
417 ((not fullheight) 'fullwidth)
418 (t 'maximized)))
419 params))
420 ;; Finally, move the frame back onscreen.
421 (when params
422 (modify-frame-parameters frame params))))))
423
424(defun frameset--find-frame (predicate display &rest args)
425 "Find a frame in `frameset--reuse-list' satisfying PREDICATE.
426Look through available frames whose display property matches DISPLAY
427and return the first one for which (PREDICATE frame ARGS) returns t.
428If PREDICATE is nil, it is always satisfied. Internal use only."
429 (cl-find-if (lambda (frame)
430 (and (equal (frame-parameter frame 'display) display)
431 (or (null predicate)
432 (apply predicate frame args))))
433 frameset--reuse-list))
434
435(defun frameset--reuse-frame (display frame-cfg)
436 "Look for an existing frame to reuse.
437DISPLAY is the display where the frame will be shown, and FRAME-CFG
438is the parameter list of the frame being restored. Internal use only."
439 (let ((frame nil)
440 mini)
441 ;; There are no fancy heuristics there. We could implement some
442 ;; based on frame size and/or position, etc., but it is not clear
443 ;; that any "gain" (in the sense of reduced flickering, etc.) is
444 ;; worth the added complexity. In fact, the code below mainly
445 ;; tries to work nicely when M-x desktop-read is used after a
446 ;; desktop session has already been loaded. The other main use
447 ;; case, which is the initial desktop-read upon starting Emacs,
448 ;; will usually have only one frame, and should already work.
449 (cond ((null display)
450 ;; When the target is tty, every existing frame is reusable.
451 (setq frame (frameset--find-frame nil display)))
452 ((car (setq mini (cdr (assq 'frameset--mini frame-cfg))))
453 ;; If the frame has its own minibuffer, let's see whether
454 ;; that frame has already been loaded (which can happen after
455 ;; M-x desktop-read).
456 (setq frame (frameset--find-frame
457 (lambda (f id)
d5671a82
JB
458 (string= (frame-parameter f 'frameset--id) id))
459 display (cdr (assq 'frameset--id frame-cfg))))
9421876d
JB
460 ;; If it has not been loaded, and it is not a minibuffer-only frame,
461 ;; let's look for an existing non-minibuffer-only frame to reuse.
462 (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only))
463 (setq frame (frameset--find-frame
464 (lambda (f)
465 (let ((w (frame-parameter f 'minibuffer)))
466 (and (window-live-p w)
467 (window-minibuffer-p w)
468 (eq (window-frame w) f))))
469 display))))
470 (mini
471 ;; For minibufferless frames, check whether they already exist,
472 ;; and that they are linked to the right minibuffer frame.
473 (setq frame (frameset--find-frame
a04d36a0 474 (lambda (f id mini-id)
d5671a82 475 (and (string= (frame-parameter f 'frameset--id) id)
a04d36a0 476 (string= (frame-parameter (window-frame (minibuffer-window f))
d5671a82 477 'frameset--id)
a04d36a0 478 mini-id)))
d5671a82 479 display (cdr (assq 'frameset--id frame-cfg)) (cdr mini))))
9421876d
JB
480 (t
481 ;; Default to just finding a frame in the same display.
482 (setq frame (frameset--find-frame nil display))))
483 ;; If found, remove from the list.
484 (when frame
485 (setq frameset--reuse-list (delq frame frameset--reuse-list)))
486 frame))
487
d5671a82
JB
488(defun frameset--initial-params (frame-cfg)
489 "Return parameters from FRAME-CFG that should not be changed later.
490Setting position and size parameters as soon as possible helps reducing
491flickering; other parameters, like `minibuffer' and `border-width', must
492be set when creating the frame because they can not be changed later.
493Internal use only."
494 (cl-loop for param in '(left top with height border-width minibuffer)
495 collect (assq param frame-cfg)))
496
9421876d
JB
497(defun frameset--get-frame (frame-cfg window-cfg filters force-onscreen)
498 "Set up and return a frame according to its saved state.
499That means either reusing an existing frame or creating one anew.
500FRAME-CFG is the frame's parameter list; WINDOW-CFG is its window state.
d5671a82
JB
501For the meaning of FORCE-ONSCREEN, see `frameset-restore'.
502Internal use only."
9421876d
JB
503 (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg)))
504 (lines (assq 'tool-bar-lines frame-cfg))
505 (filtered-cfg (frameset-filter-params frame-cfg filters nil))
506 (display (cdr (assq 'display filtered-cfg))) ;; post-filtering
507 alt-cfg frame)
508
509 ;; This works around bug#14795 (or feature#14795, if not a bug :-)
510 (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
511 (push '(tool-bar-lines . 0) filtered-cfg)
512
513 (when fullscreen
514 ;; Currently Emacs has the limitation that it does not record the size
515 ;; and position of a frame before maximizing it, so we cannot save &
516 ;; restore that info. Instead, when restoring, we resort to creating
517 ;; invisible "fullscreen" frames of default size and then maximizing them
518 ;; (and making them visible) which at least is somewhat user-friendly
519 ;; when these frames are later de-maximized.
520 (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width filtered-cfg))))
521 (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height filtered-cfg))))
522 (visible (assq 'visibility filtered-cfg)))
523 (setq filtered-cfg (cl-delete-if (lambda (p)
524 (memq p '(visibility fullscreen width height)))
525 filtered-cfg :key #'car))
526 (when width
527 (setq filtered-cfg (append `((user-size . t) (width . ,width))
528 filtered-cfg)))
529 (when height
530 (setq filtered-cfg (append `((user-size . t) (height . ,height))
531 filtered-cfg)))
532 ;; These are parameters to apply after creating/setting the frame.
533 (push visible alt-cfg)
534 (push (cons 'fullscreen fullscreen) alt-cfg)))
535
536 ;; Time to find or create a frame an apply the big bunch of parameters.
537 ;; If a frame needs to be created and it falls partially or fully offscreen,
538 ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards is
539 ;; allowed. So we create the frame as invisible and then reapply the full
540 ;; parameter list (including position and size parameters).
541 (setq frame (or (and frameset--reuse-list
542 (frameset--reuse-frame display filtered-cfg))
543 (make-frame-on-display display
544 (cons '(visibility)
d5671a82 545 (frameset--initial-params filtered-cfg)))))
9421876d
JB
546 (modify-frame-parameters frame
547 (if (eq (frame-parameter frame 'fullscreen) fullscreen)
548 ;; Workaround for bug#14949
549 (assq-delete-all 'fullscreen filtered-cfg)
550 filtered-cfg))
551
552 ;; If requested, force frames to be onscreen.
553 (when (and force-onscreen
554 ;; FIXME: iconified frames should be checked too,
555 ;; but it is impossible without deiconifying them.
556 (not (eq (frame-parameter frame 'visibility) 'icon)))
557 (frameset--move-onscreen frame force-onscreen))
558
559 ;; Let's give the finishing touches (visibility, tool-bar, maximization).
560 (when lines (push lines alt-cfg))
561 (when alt-cfg (modify-frame-parameters frame alt-cfg))
562 ;; Now restore window state.
563 (window-state-put window-cfg (frame-root-window frame) 'safe)
564 frame))
565
566(defun frameset--sort-states (state1 state2)
567 "Predicate to sort frame states in a suitable order to be created.
568It sorts minibuffer-owning frames before minibufferless ones."
569 (pcase-let ((`(,hasmini1 ,id-def1) (assq 'frameset--mini (car state1)))
570 (`(,hasmini2 ,id-def2) (assq 'frameset--mini (car state2))))
571 (cond ((eq id-def1 t) t)
572 ((eq id-def2 t) nil)
573 ((not (eq hasmini1 hasmini2)) (eq hasmini1 t))
574 ((eq hasmini1 nil) (string< id-def1 id-def2))
575 (t t))))
576
d5671a82
JB
577(defun frameset-keep-original-display-p (force-display)
578 "True if saved frames' displays should be honored."
579 (cond ((daemonp) t)
580 ((eq system-type 'windows-nt) nil)
581 (t (not force-display))))
582
9421876d
JB
583(defun frameset-sort-frames-for-deletion (frame1 _frame2)
584 "Predicate to sort live frames for deletion.
585Minibufferless frames must go first to avoid errors when attempting
586to delete a frame whose minibuffer window is used by another frame."
587 (not (frame-parameter frame1 'minibuffer)))
588
51d30f2c 589;;;###autoload
d5671a82
JB
590(cl-defun frameset-restore (frameset
591 &key filters reuse-frames force-display force-onscreen)
9421876d
JB
592 "Restore a FRAMESET into the current display(s).
593
51d30f2c 594FILTERS is an alist of parameter filters; defaults to `frameset-filter-alist'.
9421876d
JB
595
596REUSE-FRAMES describes how to reuse existing frames while restoring a frameset:
d5671a82
JB
597 t Reuse any existing frame if possible; delete leftover frames.
598 nil Restore frameset in new frames and delete existing frames.
599 :keep Restore frameset in new frames and keep the existing ones.
600 LIST A list of frames to reuse; only these will be reused, if possible,
601 and any leftover one will be deleted; other frames not on this
602 list will be kept.
9421876d
JB
603
604FORCE-DISPLAY can be:
d5671a82
JB
605 t Frames will be restored in the current display.
606 nil Frames will be restored, if possible, in their original displays.
607 :delete Frames in other displays will be deleted instead of restored.
608 PRED A function which will be called with one argument, the parameter
609 list, and must return t, nil or `:delete', as above but affecting
610 only the frame that will be created from that parameter list.
9421876d
JB
611
612FORCE-ONSCREEN can be:
d5671a82
JB
613 :all Force onscreen any frame fully or partially offscreen.
614 t Force onscreen only those frames that are fully offscreen.
615 nil Do not force any frame back onscreen.
616 PRED A function which will be called with three arguments,
617 - the live frame just restored,
618 - a list (LEFT TOP WIDTH HEIGHT), describing the frame,
619 - a list (LEFT TOP WIDTH HEIGHT), describing the workarea,
620 and must return non-nil to force the frame onscreen, nil otherwise.
621
622Note the timing and scope of the operations described above: REUSE-FRAMES
623affects existing frames, FILTERS and FORCE-DISPLAY affect the frame being
624restored before that happens, and FORCE-ONSCREEN affects the frame once
625it has been restored.
9421876d
JB
626
627All keywords default to nil."
628
629 (cl-assert (frameset-p frameset))
630
d5671a82 631 (let (other-frames)
9421876d
JB
632
633 ;; frameset--reuse-list is a list of frames potentially reusable. Later we
634 ;; will decide which ones can be reused, and how to deal with any leftover.
635 (pcase reuse-frames
d5671a82 636 ((or `nil `:keep)
9421876d
JB
637 (setq frameset--reuse-list nil
638 other-frames (frame-list)))
639 ((pred consp)
640 (setq frameset--reuse-list (copy-sequence reuse-frames)
641 other-frames (cl-delete-if (lambda (frame)
642 (memq frame frameset--reuse-list))
643 (frame-list))))
644 (_
645 (setq frameset--reuse-list (frame-list)
646 other-frames nil)))
647
648 ;; Sort saved states to guarantee that minibufferless frames will be created
649 ;; after the frames that contain their minibuffer windows.
650 (dolist (state (sort (copy-sequence (frameset-states frameset))
651 #'frameset--sort-states))
652 (condition-case-unless-debug err
653 (pcase-let* ((`(,frame-cfg . ,window-cfg) state)
654 ((and d-mini `(,hasmini . ,mb-id))
655 (cdr (assq 'frameset--mini frame-cfg)))
656 (default (and (booleanp mb-id) mb-id))
d5671a82
JB
657 (force-display (if (functionp force-display)
658 (funcall force-display frame-cfg)
659 force-display))
9421876d
JB
660 (frame nil) (to-tty nil))
661 ;; Only set target if forcing displays and the target display is different.
d5671a82
JB
662 (cond ((frameset-keep-original-display-p force-display)
663 (setq frameset--target-display nil))
664 ((eq (frame-parameter nil 'display) (cdr (assq 'display frame-cfg)))
665 (setq frameset--target-display nil))
666 (t
667 (setq frameset--target-display (cons 'display
668 (frame-parameter nil 'display))
669 to-tty (null (cdr frameset--target-display)))))
9421876d
JB
670 ;; Time to restore frames and set up their minibuffers as they were.
671 ;; We only skip a frame (thus deleting it) if either:
672 ;; - we're switching displays, and the user chose the option to delete, or
673 ;; - we're switching to tty, and the frame to restore is minibuffer-only.
674 (unless (and frameset--target-display
d5671a82 675 (or (eq force-display :delete)
9421876d
JB
676 (and to-tty
677 (eq (cdr (assq 'minibuffer frame-cfg)) 'only))))
d5671a82
JB
678 ;; If keeping non-reusable frames, and the frameset--id of one of them
679 ;; matches the id of a frame being restored (because, for example, the
680 ;; frameset has already been read in the same session), remove the
681 ;; frameset--id from the non-reusable frame, which is not useful anymore.
682 (when (and other-frames
683 (or (eq reuse-frames :keep) (consp reuse-frames)))
684 (let ((dup (cl-find (cdr (assq 'frameset--id frame-cfg))
685 other-frames
686 :key (lambda (frame)
687 (frame-parameter frame 'frameset--id))
688 :test #'string=)))
689 (when dup
690 (set-frame-parameter dup 'frameset--id nil))))
9421876d
JB
691 ;; Restore minibuffers. Some of this stuff could be done in a filter
692 ;; function, but it would be messy because restoring minibuffers affects
693 ;; global state; it's best to do it here than add a bunch of global
694 ;; variables to pass info back-and-forth to/from the filter function.
695 (cond
696 ((null d-mini)) ;; No frameset--mini. Process as normal frame.
697 (to-tty) ;; Ignore minibuffer stuff and process as normal frame.
698 (hasmini ;; Frame has minibuffer (or it is minibuffer-only).
699 (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
700 (setq frame-cfg (append '((tool-bar-lines . 0) (menu-bar-lines . 0))
701 frame-cfg))))
702 (t ;; Frame depends on other frame's minibuffer window.
703 (let* ((mb-frame (or (cl-find-if
704 (lambda (f)
d5671a82 705 (string= (frame-parameter f 'frameset--id)
9421876d
JB
706 mb-id))
707 (frame-list))
708 (error "Minibuffer frame %S not found" mb-id)))
709 (mb-param (assq 'minibuffer frame-cfg))
710 (mb-window (minibuffer-window mb-frame)))
711 (unless (and (window-live-p mb-window)
712 (window-minibuffer-p mb-window))
713 (error "Not a minibuffer window %s" mb-window))
714 (if mb-param
715 (setcdr mb-param mb-window)
d5671a82
JB
716 (push (cons 'minibuffer mb-window) frame-cfg)))))
717 ;; OK, we're ready at last to create (or reuse) a frame and
718 ;; restore the window config.
719 (setq frame (frameset--get-frame frame-cfg window-cfg
720 (or filters frameset-filter-alist)
721 force-onscreen))
722 ;; Set default-minibuffer if required.
723 (when default (setq default-minibuffer-frame frame))))
9421876d
JB
724 (error
725 (delay-warning 'frameset (error-message-string err) :error))))
726
727 ;; In case we try to delete the initial frame, we want to make sure that
728 ;; other frames are already visible (discussed in thread for bug#14841).
729 (sit-for 0 t)
730
731 ;; Delete remaining frames, but do not fail if some resist being deleted.
d5671a82 732 (unless (eq reuse-frames :keep)
9421876d
JB
733 (dolist (frame (sort (nconc (if (listp reuse-frames) nil other-frames)
734 frameset--reuse-list)
735 #'frameset-sort-frames-for-deletion))
736 (condition-case err
737 (delete-frame frame)
738 (error
739 (delay-warning 'frameset (error-message-string err))))))
740 (setq frameset--reuse-list nil)
741
742 ;; Make sure there's at least one visible frame.
743 (unless (or (daemonp) (visible-frame-list))
744 (make-frame-visible (car (frame-list))))))
745
746(provide 'frameset)
747
748;;; frameset.el ends here