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