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