[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] trunk r113648: lisp/desktop.el: Move code related to savin
|
From: |
Juanma Barranquero |
|
Subject: |
[Emacs-diffs] trunk r113648: lisp/desktop.el: Move code related to saving frames to frameset.el. |
|
Date: |
Fri, 02 Aug 2013 04:34:09 +0000 |
|
User-agent: |
Bazaar (2.6b2) |
------------------------------------------------------------
revno: 113648
revision-id: address@hidden
parent: address@hidden
committer: Juanma Barranquero <address@hidden>
branch nick: trunk
timestamp: Fri 2013-08-02 06:33:58 +0200
message:
lisp/desktop.el: Move code related to saving frames to frameset.el.
Require frameset.
(desktop-restore-frames): Doc fix.
(desktop-restore-reuses-frames): Rename from
desktop-restoring-reuses-frames.
(desktop-saved-frameset): Rename from desktop-saved-frame-states.
(desktop-clear): Clear frames too.
(desktop-filter-parameters-alist): Set from frameset-filter-alist.
(desktop--filter-tty*, desktop-save, desktop-read):
Use frameset functions.
(desktop-before-saving-frames-functions, desktop--filter-*-color)
(desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
(desktop--filter-save-desktop-parm, desktop--filter-iconified-position)
(desktop-restore-in-original-display-p, desktop--filter-frame-parms)
(desktop--process-minibuffer-frames, desktop-save-frames)
(desktop--reuse-list, desktop--compute-pos, desktop--move-onscreen)
(desktop--find-frame, desktop--select-frame, desktop--make-frame)
(desktop--sort-states, desktop-restoring-frames-p)
(desktop-restore-frames): Remove. Most code moved to frameset.el.
(desktop-restoring-frameset-p, desktop-restore-frameset)
(desktop--check-dont-save, desktop-save-frameset): New functions.
(desktop--app-id): New constant.
(desktop-first-buffer, desktop-buffer-ok-count)
(desktop-buffer-fail-count): Move before first use.
lisp/frameset.el: New file.
added:
lisp/frameset.el frameset.el-20130802043218-tfwraxv1c2zlibpw-1
modified:
lisp/ChangeLog changelog-20091113204419-o5vbwnq5f7feedwu-1432
lisp/desktop.el desktop.el-20091113204419-o5vbwnq5f7feedwu-591
=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog 2013-08-01 23:18:37 +0000
+++ b/lisp/ChangeLog 2013-08-02 04:33:58 +0000
@@ -1,3 +1,31 @@
+2013-08-02 Juanma Barranquero <address@hidden>
+
+ Move code related to saving frames to frameset.el.
+ * desktop.el: Require frameset.
+ (desktop-restore-frames): Doc fix.
+ (desktop-restore-reuses-frames): Rename from
+ desktop-restoring-reuses-frames.
+ (desktop-saved-frameset): Rename from desktop-saved-frame-states.
+ (desktop-clear): Clear frames too.
+ (desktop-filter-parameters-alist): Set from frameset-filter-alist.
+ (desktop--filter-tty*, desktop-save, desktop-read):
+ Use frameset functions.
+ (desktop-before-saving-frames-functions, desktop--filter-*-color)
+ (desktop--filter-minibuffer, desktop--filter-restore-desktop-parm)
+ (desktop--filter-save-desktop-parm, desktop--filter-iconified-position)
+ (desktop-restore-in-original-display-p, desktop--filter-frame-parms)
+ (desktop--process-minibuffer-frames, desktop-save-frames)
+ (desktop--reuse-list, desktop--compute-pos, desktop--move-onscreen)
+ (desktop--find-frame, desktop--select-frame, desktop--make-frame)
+ (desktop--sort-states, desktop-restoring-frames-p)
+ (desktop-restore-frames): Remove. Most code moved to frameset.el.
+ (desktop-restoring-frameset-p, desktop-restore-frameset)
+ (desktop--check-dont-save, desktop-save-frameset): New functions.
+ (desktop--app-id): New constant.
+ (desktop-first-buffer, desktop-buffer-ok-count)
+ (desktop-buffer-fail-count): Move before first use.
+ * frameset.el: New file.
+
2013-08-01 Stefan Monnier <address@hidden>
* files.el: Use lexical-binding.
=== modified file 'lisp/desktop.el'
--- a/lisp/desktop.el 2013-07-28 22:43:01 +0000
+++ b/lisp/desktop.el 2013-08-02 04:33:58 +0000
@@ -134,6 +134,7 @@
;;; Code:
(require 'cl-lib)
+(require 'frameset)
(defvar desktop-file-version "206"
"Version number of desktop file format.
@@ -372,7 +373,7 @@
:group 'desktop)
(defcustom desktop-restore-frames t
- "When non-nil, save window/frame configuration to desktop file."
+ "When non-nil, save frames to desktop file."
:type 'boolean
:group 'desktop
:version "24.4")
@@ -399,7 +400,7 @@
:group 'desktop
:version "24.4")
-(defcustom desktop-restoring-reuses-frames t
+(defcustom desktop-restore-reuses-frames t
"If t, restoring frames reuses existing frames.
If nil, existing frames are deleted.
If `keep', existing frames are kept and not reused."
@@ -409,13 +410,6 @@
:group 'desktop
:version "24.4")
-(defcustom desktop-before-saving-frames-functions nil
- "Abnormal hook run before saving frames.
-Functions in this hook are called with one argument, a live frame."
- :type 'hook
- :group 'desktop
- :version "24.4")
-
(defcustom desktop-file-name-format 'absolute
"Format in which desktop file names should be saved.
Possible values are:
@@ -599,7 +593,7 @@
"Checksum of the last auto-saved contents of the desktop file.
Used to avoid writing contents unchanged between auto-saves.")
-(defvar desktop-saved-frame-states nil
+(defvar desktop-saved-frameset nil
"Saved state of all frames.
Only valid during frame saving & restoring; intended for internal use.")
@@ -667,7 +661,17 @@
(unless (or (eq (aref bufname 0) ?\s) ;; Don't kill internal buffers
(string-match-p preserve-regexp bufname))
(kill-buffer buffer)))))
- (delete-other-windows))
+ (delete-other-windows)
+ (let* ((this (selected-frame))
+ (mini (window-frame (minibuffer-window this)))) ; in case they difer
+ (dolist (frame (sort (frame-list) #'frameset-sort-frames-for-deletion))
+ (condition-case err
+ (unless (or (eq frame this)
+ (eq frame mini)
+ (frame-parameter frame 'desktop-dont-clear))
+ (delete-frame frame))
+ (error
+ (delay-warning 'desktop (error-message-string err)))))))
;; ----------------------------------------------------------------------------
(unless noninteractive
@@ -890,223 +894,41 @@
;; ----------------------------------------------------------------------------
(defvar desktop-filter-parameters-alist
- '((background-color . desktop--filter-*-color)
- (buffer-list . t)
- (buffer-predicate . t)
- (buried-buffer-list . t)
- (desktop--font . desktop--filter-restore-desktop-parm)
- (desktop--fullscreen . desktop--filter-restore-desktop-parm)
- (desktop--height . desktop--filter-restore-desktop-parm)
- (desktop--width . desktop--filter-restore-desktop-parm)
- (font . desktop--filter-save-desktop-parm)
- (font-backend . t)
- (foreground-color . desktop--filter-*-color)
- (fullscreen . desktop--filter-save-desktop-parm)
- (height . desktop--filter-save-desktop-parm)
- (left . desktop--filter-iconified-position)
- (minibuffer . desktop--filter-minibuffer)
- (name . t)
- (outer-window-id . t)
- (parent-id . t)
- (top . desktop--filter-iconified-position)
- (tty . desktop--filter-tty*)
- (tty-type . desktop--filter-tty*)
- (width . desktop--filter-save-desktop-parm)
- (window-id . t)
- (window-system . t))
+ (append '((font-backend . t)
+ (name . t)
+ (outer-window-id . t)
+ (parent-id . t)
+ (tty . desktop--filter-tty*)
+ (tty-type . desktop--filter-tty*)
+ (window-id . t)
+ (window-system . t))
+ frameset-filter-alist)
"Alist of frame parameters and filtering functions.
-
-Each element is a cons (PARAM . FILTER), where PARAM is a parameter
-name (a symbol identifying a frame parameter), and FILTER can be t
-\(meaning the parameter is removed from the parameter list on saving
-and restoring), or a function that will be called with three args:
-
- CURRENT a cons (PARAM . VALUE), where PARAM is the one being
- filtered and VALUE is its current value
- PARAMETERS the complete alist of parameters being filtered
- SAVING non-nil if filtering before saving state, nil otherwise
-
-The FILTER function must return:
- nil CURRENT is removed from the list
- t CURRENT is left as is
- (PARAM' . VALUE') replace CURRENT with this
-
-Frame parameters not on this list are passed intact.")
-
-(defvar desktop--target-display nil
- "Either (minibuffer . VALUE) or nil.
-This refers to the current frame config being processed inside
-`frame--restore-frames' and its auxiliary functions (like filtering).
-If nil, there is no need to change the display.
-If non-nil, display parameter to use when creating the frame.
-Internal use only.")
-
-(defun desktop-switch-to-gui-p (parameters)
- "True when switching to a graphic display.
-Return t if PARAMETERS describes a text-only terminal and
-the target is a graphic display; otherwise return nil.
-Only meaningful when called from a filtering function in
-`desktop-filter-parameters-alist'."
- (and desktop--target-display ; we're switching
- (null (cdr (assq 'display parameters))) ; from a tty
- (cdr desktop--target-display))) ; to a GUI display
-
-(defun desktop-switch-to-tty-p (parameters)
- "True when switching to a text-only terminal.
-Return t if PARAMETERS describes a graphic display and
-the target is a text-only terminal; otherwise return nil.
-Only meaningful when called from a filtering function in
-`desktop-filter-parameters-alist'."
- (and desktop--target-display ; we're switching
- (cdr (assq 'display parameters)) ; from a GUI display
- (null (cdr desktop--target-display)))) ; to a tty
+Its format is identical to `frameset-filter-alist' (which see).")
(defun desktop--filter-tty* (_current parameters saving)
;; Remove tty and tty-type parameters when switching
;; to a GUI frame.
(or saving
- (not (desktop-switch-to-gui-p parameters))))
-
-(defun desktop--filter-*-color (current parameters saving)
- ;; Remove (foreground|background)-color parameters
- ;; when switching to a GUI frame if they denote an
- ;; "unspecified" color.
- (or saving
- (not (desktop-switch-to-gui-p parameters))
- (not (stringp (cdr current)))
- (not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
-
-(defun desktop--filter-minibuffer (current _parameters saving)
- ;; When minibuffer is a window, save it as minibuffer . t
- (or (not saving)
- (if (windowp (cdr current))
- '(minibuffer . t)
- t)))
-
-(defun desktop--filter-restore-desktop-parm (current parameters saving)
- ;; When switching to a GUI frame, convert desktop--XXX parameter to XXX
- (or saving
- (not (desktop-switch-to-gui-p parameters))
- (let ((val (cdr current)))
- (if (eq val :desktop-processed)
- nil
- (cons (intern (substring (symbol-name (car current))
- 9)) ;; (length "desktop--")
- val)))))
-
-(defun desktop--filter-save-desktop-parm (current parameters saving)
- ;; When switching to a tty frame, save parameter XXX as desktop--XXX so it
- ;; can be restored in a subsequent GUI session, unless it already exists.
- (cond (saving t)
- ((desktop-switch-to-tty-p parameters)
- (let ((sym (intern (format "desktop--%s" (car current)))))
- (if (assq sym parameters)
- nil
- (cons sym (cdr current)))))
- ((desktop-switch-to-gui-p parameters)
- (let* ((dtp (assq (intern (format "desktop--%s" (car current)))
- parameters))
- (val (cdr dtp)))
- (if (eq val :desktop-processed)
- nil
- (setcdr dtp :desktop-processed)
- (cons (car current) val))))
- (t t)))
-
-(defun desktop--filter-iconified-position (_current parameters saving)
- ;; When saving an iconified frame, top & left are meaningless,
- ;; so remove them to allow restoring to a default position.
- (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon))))
-
-(defun desktop-restore-in-original-display-p ()
- "True if saved frames' displays should be honored."
- (cond ((daemonp) t)
- ((eq system-type 'windows-nt) nil)
- (t (null desktop-restore-in-current-display))))
-
-(defun desktop--filter-frame-parms (parameters saving)
- "Filter frame parameters and return filtered list.
-PARAMETERS is a parameter alist as returned by `frame-parameters'.
-If SAVING is non-nil, filtering is happening before saving frame state;
-otherwise, filtering is being done before restoring frame state.
-Parameters are filtered according to the setting of
-`desktop-filter-parameters-alist' (which see).
-Internal use only."
- (let ((filtered nil))
- (dolist (param parameters)
- (let ((filter (cdr (assq (car param) desktop-filter-parameters-alist)))
- this)
- (cond (;; no filter: pass param
- (null filter)
- (push param filtered))
- (;; filter = t; skip param
- (eq filter t))
- (;; filter func returns nil: skip param
- (null (setq this (funcall filter param parameters saving))))
- (;; filter func returns t: pass param
- (eq this t)
- (push param filtered))
- (;; filter func returns a new param: use it
- t
- (push this filtered)))))
- ;; Set the display parameter after filtering, so that filter functions
- ;; have access to its original value.
- (when desktop--target-display
- (let ((display (assq 'display filtered)))
- (if display
- (setcdr display (cdr desktop--target-display))
- (push desktop--target-display filtered))))
- filtered))
-
-(defun desktop--process-minibuffer-frames (frames)
- ;; Adds a desktop--mini parameter to frames
- ;; desktop--mini is a list (MINIBUFFER NUMBER DEFAULT?) where
- ;; MINIBUFFER t if the frame (including minibuffer-only) owns a
minibuffer
- ;; NUMBER if MINIBUFFER = t, an ID for the frame; if nil, the ID of
- ;; the frame containing the minibuffer used by this frame
- ;; DEFAULT? if t, this frame is the value of default-minibuffer-frame
- (let ((count 0))
- ;; Reset desktop--mini for all frames
- (dolist (frame (frame-list))
- (set-frame-parameter frame 'desktop--mini nil))
- ;; Number all frames with its own minibuffer
- (dolist (frame (minibuffer-frame-list))
- (set-frame-parameter frame 'desktop--mini
- (list t
- (cl-incf count)
- (eq frame default-minibuffer-frame))))
- ;; Now link minibufferless frames with their minibuffer frames
- (dolist (frame frames)
- (unless (frame-parameter frame 'desktop--mini)
- (let ((mb-frame (window-frame (minibuffer-window frame))))
- ;; Frames whose minibuffer frame has been filtered out will have
- ;; desktop--mini = nil, so desktop-restore-frames will restore them
- ;; according to their minibuffer parameter. Set up desktop--mini
- ;; for the rest.
- (when (memq mb-frame frames)
- (set-frame-parameter frame 'desktop--mini
- (list nil
- (cl-second (frame-parameter mb-frame
'desktop--mini))
- nil))))))))
-
-(defun desktop-save-frames ()
- "Save frame state in `desktop-saved-frame-states'.
-Runs the hook `desktop-before-saving-frames-functions'.
+ (not (frameset-switch-to-gui-p parameters))))
+
+(defun desktop--check-dont-save (frame)
+ (not (frame-parameter frame 'desktop-dont-save)))
+
+(defconst desktop--app-id `(desktop . ,desktop-file-version))
+
+(defun desktop-save-frameset ()
+ "Save the state of existing frames in `desktop-saved-frameset'.
Frames with a non-nil `desktop-dont-save' parameter are not saved."
- (setq desktop-saved-frame-states
+ (setq desktop-saved-frameset
(and desktop-restore-frames
- (let ((frames (cl-delete-if
- (lambda (frame)
- (run-hook-with-args
'desktop-before-saving-frames-functions frame)
- (frame-parameter frame 'desktop-dont-save))
- (frame-list))))
- ;; In case some frame was deleted by a hook function
- (setq frames (cl-delete-if-not #'frame-live-p frames))
- (desktop--process-minibuffer-frames frames)
- (mapcar (lambda (frame)
- (cons (desktop--filter-frame-parms (frame-parameters
frame) t)
- (window-state-get (frame-root-window frame) t)))
- frames)))))
+ (let ((name (concat user-login-name "@" system-name
+ (format-time-string " %Y-%m-%d %T"))))
+ (frameset-save nil
+ :filters desktop-filter-parameters-alist
+ :predicate #'desktop--check-dont-save
+ :properties (list :app desktop--app-id
+ :name name))))))
;;;###autoload
(defun desktop-save (dirname &optional release auto-save)
@@ -1148,11 +970,11 @@
(insert "\n;; Global section:\n")
;; Called here because we save the window/frame state as a global
;; variable for compatibility with previous Emacsen.
- (desktop-save-frames)
- (unless (memq 'desktop-saved-frame-states desktop-globals-to-save)
- (desktop-outvar 'desktop-saved-frame-states))
+ (desktop-save-frameset)
+ (unless (memq 'desktop-saved-frameset desktop-globals-to-save)
+ (desktop-outvar 'desktop-saved-frameset))
(mapc (function desktop-outvar) desktop-globals-to-save)
- (setq desktop-saved-frame-states nil) ; after saving
desktop-globals-to-save
+ (setq desktop-saved-frameset nil) ; after saving
desktop-globals-to-save
(when (memq 'kill-ring desktop-globals-to-save)
(insert
"(setq kill-ring-yank-pointer (nthcdr "
@@ -1210,319 +1032,26 @@
(defvar desktop-lazy-timer nil)
;; ----------------------------------------------------------------------------
-(defvar desktop--reuse-list nil
- "Internal use only.")
-
-(defun desktop--compute-pos (value left/top right/bottom)
- (pcase value
- (`(+ ,val) (+ left/top val))
- (`(- ,val) (+ right/bottom val))
- (val val)))
-
-(defun desktop--move-onscreen (frame)
- "If FRAME is offscreen, move it back onscreen and, if necessary, resize it.
-When forced onscreen, frames wider than the monitor's workarea are converted
-to fullwidth, and frames taller than the workarea are converted to fullheight.
-NOTE: This only works for non-iconified frames."
- (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr
(frame-monitor-attributes frame)))
- (right (+ left width -1))
- (bottom (+ top height -1))
- (fr-left (desktop--compute-pos (frame-parameter frame 'left)
left right))
- (fr-top (desktop--compute-pos (frame-parameter frame 'top) top
bottom))
- (ch-width (frame-char-width frame))
- (ch-height (frame-char-height frame))
- (fr-width (max (frame-pixel-width frame) (* ch-width
(frame-width frame))))
- (fr-height (max (frame-pixel-height frame) (* ch-height
(frame-height frame))))
- (fr-right (+ fr-left fr-width -1))
- (fr-bottom (+ fr-top fr-height -1)))
- (when (pcase desktop-restore-forces-onscreen
- ;; Any corner is outside the screen.
- (`all (or (< fr-bottom top) (> fr-bottom bottom)
- (< fr-left left) (> fr-left right)
- (< fr-right left) (> fr-right right)
- (< fr-top top) (> fr-top bottom)))
- ;; Displaced to the left, right, above or below the screen.
- (`t (or (> fr-left right)
- (< fr-right left)
- (> fr-top bottom)
- (< fr-bottom top)))
- (_ nil))
- (let ((fullwidth (> fr-width width))
- (fullheight (> fr-height height))
- (params nil))
- ;; Position frame horizontally.
- (cond (fullwidth
- (push `(left . ,left) params))
- ((> fr-right right)
- (push `(left . ,(+ left (- width fr-width))) params))
- ((< fr-left left)
- (push `(left . ,left) params)))
- ;; Position frame vertically.
- (cond (fullheight
- (push `(top . ,top) params))
- ((> fr-bottom bottom)
- (push `(top . ,(+ top (- height fr-height))) params))
- ((< fr-top top)
- (push `(top . ,top) params)))
- ;; Compute fullscreen state, if required.
- (when (or fullwidth fullheight)
- (push (cons 'fullscreen
- (cond ((not fullwidth) 'fullheight)
- ((not fullheight) 'fullwidth)
- (t 'maximized)))
- params))
- ;; Finally, move the frame back onscreen.
- (when params
- (modify-frame-parameters frame params))))))
-
-(defun desktop--find-frame (predicate display &rest args)
- "Find a suitable frame in `desktop--reuse-list'.
-Look through frames whose display property matches DISPLAY and
-return the first one for which (PREDICATE frame ARGS) returns t.
-If PREDICATE is nil, it is always satisfied. Internal use only.
-This is an auxiliary function for `desktop--select-frame'."
- (cl-find-if (lambda (frame)
- (and (equal (frame-parameter frame 'display) display)
- (or (null predicate)
- (apply predicate frame args))))
- desktop--reuse-list))
-
-(defun desktop--select-frame (display frame-cfg)
- "Look for an existing frame to reuse.
-DISPLAY is the display where the frame will be shown, and FRAME-CFG
-is the parameter list of the frame being restored. Internal use only."
- (if (eq desktop-restoring-reuses-frames t)
- (let ((frame nil)
- mini)
- ;; There are no fancy heuristics there. We could implement some
- ;; based on frame size and/or position, etc., but it is not clear
- ;; that any "gain" (in the sense of reduced flickering, etc.) is
- ;; worth the added complexity. In fact, the code below mainly
- ;; tries to work nicely when M-x desktop-read is used after a desktop
- ;; session has already been loaded. The other main use case, which
- ;; is the initial desktop-read upon starting Emacs, should usually
- ;; only have one, or very few, frame(s) to reuse.
- (cond ((null display)
- ;; When the target is tty, every existing frame is reusable.
- (setq frame (desktop--find-frame nil display)))
- ((car (setq mini (cdr (assq 'desktop--mini frame-cfg))))
- ;; If the frame has its own minibuffer, let's see whether
- ;; that frame has already been loaded (which can happen after
- ;; M-x desktop-read).
- (setq frame (desktop--find-frame
- (lambda (f m)
- (equal (frame-parameter f 'desktop--mini) m))
- display mini))
- ;; If it has not been loaded, and it is not a minibuffer-only
frame,
- ;; let's look for an existing non-minibuffer-only frame to reuse.
- (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only))
- (setq frame (desktop--find-frame
- (lambda (f)
- (let ((w (frame-parameter f 'minibuffer)))
- (and (window-live-p w)
- (window-minibuffer-p w)
- (eq (window-frame w) f))))
- display))))
- (mini
- ;; For minibufferless frames, check whether they already exist,
- ;; and that they are linked to the right minibuffer frame.
- (setq frame (desktop--find-frame
- (lambda (f n)
- (pcase-let (((and m `(,hasmini ,num))
- (frame-parameter f 'desktop--mini)))
- (and m
- (null hasmini)
- (= num n)
- (equal (cl-second (frame-parameter
- (window-frame
(minibuffer-window f))
- 'desktop--mini))
- n))))
- display (cl-second mini))))
- (t
- ;; Default to just finding a frame in the same display.
- (setq frame (desktop--find-frame nil display))))
- ;; If found, remove from the list.
- (when frame
- (setq desktop--reuse-list (delq frame desktop--reuse-list)))
- frame)
- nil))
-
-(defun desktop--make-frame (frame-cfg window-cfg)
- "Set up a frame according to its saved state.
-That means either creating a new frame or reusing an existing one.
-FRAME-CFG is the parameter list of the new frame; WINDOW-CFG is
-its window state. Internal use only."
- (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg)))
- (lines (assq 'tool-bar-lines frame-cfg))
- (filtered-cfg (desktop--filter-frame-parms frame-cfg nil))
- (display (cdr (assq 'display filtered-cfg))) ;; post-filtering
- alt-cfg frame)
-
- ;; This works around bug#14795 (or feature#14795, if not a bug :-)
- (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
- (push '(tool-bar-lines . 0) filtered-cfg)
-
- (when fullscreen
- ;; Currently Emacs has the limitation that it does not record the size
- ;; and position of a frame before maximizing it, so we cannot save &
- ;; restore that info. Instead, when restoring, we resort to creating
- ;; invisible "fullscreen" frames of default size and then maximizing them
- ;; (and making them visible) which at least is somewhat user-friendly
- ;; when these frames are later de-maximized.
- (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width
filtered-cfg))))
- (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height
filtered-cfg))))
- (visible (assq 'visibility filtered-cfg)))
- (setq filtered-cfg (cl-delete-if (lambda (p)
- (memq p '(visibility fullscreen
width height)))
- filtered-cfg :key #'car))
- (when width
- (setq filtered-cfg (append `((user-size . t) (width . ,width))
- filtered-cfg)))
- (when height
- (setq filtered-cfg (append `((user-size . t) (height . ,height))
- filtered-cfg)))
- ;; These are parameters to apply after creating/setting the frame.
- (push visible alt-cfg)
- (push (cons 'fullscreen fullscreen) alt-cfg)))
-
- ;; Time to find or create a frame an apply the big bunch of parameters.
- ;; If a frame needs to be created and it falls partially or wholly
offscreen,
- ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards
is
- ;; allowed. So we create the frame as invisible and then reapply the full
- ;; parameter list (including position and size parameters).
- (setq frame (or (desktop--select-frame display filtered-cfg)
- (make-frame-on-display display
- (cons '(visibility)
- (cl-loop
- for param in '(left top width
height minibuffer)
- collect (assq param
filtered-cfg))))))
- (modify-frame-parameters frame
- (if (eq (frame-parameter frame 'fullscreen)
fullscreen)
- ;; Workaround for bug#14949
- (assq-delete-all 'fullscreen filtered-cfg)
- filtered-cfg))
-
- ;; If requested, force frames to be onscreen.
- (when (and desktop-restore-forces-onscreen
- ;; FIXME: iconified frames should be checked too,
- ;; but it is impossible without deiconifying them.
- (not (eq (frame-parameter frame 'visibility) 'icon)))
- (desktop--move-onscreen frame))
-
- ;; Let's give the finishing touches (visibility, tool-bar, maximization).
- (when lines (push lines alt-cfg))
- (when alt-cfg (modify-frame-parameters frame alt-cfg))
- ;; Now restore window state.
- (window-state-put window-cfg (frame-root-window frame) 'safe)
- frame))
-
-(defun desktop--sort-states (state1 state2)
- ;; Order: default minibuffer frame
- ;; other frames with minibuffer, ascending ID
- ;; minibufferless frames, ascending ID
- (pcase-let ((`(,_p1 ,hasmini1 ,num1 ,default1) (assq 'desktop--mini (car
state1)))
- (`(,_p2 ,hasmini2 ,num2 ,default2) (assq 'desktop--mini (car
state2))))
- (cond (default1 t)
- (default2 nil)
- ((eq hasmini1 hasmini2) (< num1 num2))
- (t hasmini1))))
-
-(defun desktop-restoring-frames-p ()
- "True if calling `desktop-restore-frames' will actually restore frames."
- (and desktop-restore-frames desktop-saved-frame-states t))
-
-(defun desktop-restore-frames ()
- "Restore window/frame configuration.
-This function depends on the value of `desktop-saved-frame-states'
+(defun desktop-restoring-frameset-p ()
+ "True if calling `desktop-restore-frameset' will actually restore it."
+ (and desktop-restore-frames desktop-saved-frameset t))
+
+(defun desktop-restore-frameset ()
+ "Restore the state of a set of frames.
+This function depends on the value of `desktop-saved-frameset'
being set (usually, by reading it from the desktop)."
- (when (desktop-restoring-frames-p)
- (let* ((frame-mb-map nil) ;; Alist of frames with their own minibuffer
- (delete-saved (eq desktop-restore-in-current-display 'delete))
- (forcing (not (desktop-restore-in-original-display-p)))
- (target (and forcing (cons 'display (frame-parameter nil
'display)))))
-
- ;; Sorting saved states allows us to easily restore minibuffer-owning
frames
- ;; before minibufferless ones.
- (setq desktop-saved-frame-states (sort desktop-saved-frame-states
- #'desktop--sort-states))
- ;; Potentially all existing frames are reusable. Later we will decide
which ones
- ;; to reuse, and how to deal with any leftover.
- (setq desktop--reuse-list (frame-list))
-
- (dolist (state desktop-saved-frame-states)
- (condition-case err
- (pcase-let* ((`(,frame-cfg . ,window-cfg) state)
- ((and d-mini `(,hasmini ,num ,default))
- (cdr (assq 'desktop--mini frame-cfg)))
- (frame nil) (to-tty nil))
- ;; Only set target if forcing displays and the target display is
different.
- (if (or (not forcing)
- (equal target (or (assq 'display frame-cfg) '(display .
nil))))
- (setq desktop--target-display nil)
- (setq desktop--target-display target
- to-tty (null (cdr target))))
- ;; Time to restore frames and set up their minibuffers as they
were.
- ;; We only skip a frame (thus deleting it) if either:
- ;; - we're switching displays, and the user chose the option to
delete, or
- ;; - we're switching to tty, and the frame to restore is
minibuffer-only.
- (unless (and desktop--target-display
- (or delete-saved
- (and to-tty
- (eq (cdr (assq 'minibuffer frame-cfg))
'only))))
-
- ;; Restore minibuffers. Some of this stuff could be done in a
filter
- ;; function, but it would be messy because restoring
minibuffers affects
- ;; global state; it's best to do it here than add a bunch of
global
- ;; variables to pass info back-and-forth to/from the filter
function.
- (cond
- ((null d-mini)) ;; No desktop--mini. Process as normal frame.
- (to-tty) ;; Ignore minibuffer stuff and process as normal
frame.
- (hasmini ;; Frame has minibuffer (or it is minibuffer-only).
- (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
- (setq frame-cfg (append '((tool-bar-lines . 0)
(menu-bar-lines . 0))
- frame-cfg))))
- (t ;; Frame depends on other frame's minibuffer window.
- (let ((mb-frame (cdr (assq num frame-mb-map))))
- (unless (frame-live-p mb-frame)
- (error "Minibuffer frame %s not found" num))
- (let ((mb-param (assq 'minibuffer frame-cfg))
- (mb-window (minibuffer-window mb-frame)))
- (unless (and (window-live-p mb-window)
- (window-minibuffer-p mb-window))
- (error "Not a minibuffer window %s" mb-window))
- (if mb-param
- (setcdr mb-param mb-window)
- (push (cons 'minibuffer mb-window) frame-cfg))))))
- ;; OK, we're ready at last to create (or reuse) a frame and
- ;; restore the window config.
- (setq frame (desktop--make-frame frame-cfg window-cfg))
- ;; Set default-minibuffer if required.
- (when default (setq default-minibuffer-frame frame))
- ;; Store NUM/frame to assign to minibufferless frames.
- (when hasmini (push (cons num frame) frame-mb-map))))
- (error
- (delay-warning 'desktop (error-message-string err) :error))))
-
- ;; In case we try to delete the initial frame, we want to make sure that
- ;; other frames are already visible (discussed in thread for bug#14841).
- (sit-for 0 t)
-
- ;; Delete remaining frames, but do not fail if some resist being deleted.
- (unless (eq desktop-restoring-reuses-frames 'keep)
- (dolist (frame desktop--reuse-list)
- (condition-case err
- (delete-frame frame)
- (error
- (delay-warning 'desktop (error-message-string err))))))
- (setq desktop--reuse-list nil)
- ;; Make sure there's at least one visible frame, and select it.
- (unless (or (daemonp)
- (cl-find-if #'frame-visible-p (frame-list)))
- (let ((visible (if (frame-live-p default-minibuffer-frame)
- default-minibuffer-frame
- (car (frame-list)))))
- (make-frame-visible visible)
- (select-frame-set-input-focus visible))))))
+ (when (desktop-restoring-frameset-p)
+ (frameset-restore desktop-saved-frameset
+ :filters desktop-filter-parameters-alist
+ :reuse-frames desktop-restore-reuses-frames
+ :force-display desktop-restore-in-current-display
+ :force-onscreen desktop-restore-forces-onscreen)))
+
+;; Just to silence the byte compiler.
+;; Dynamicaly bound in `desktop-read'.
+(defvar desktop-first-buffer)
+(defvar desktop-buffer-ok-count)
+(defvar desktop-buffer-fail-count)
;;;###autoload
(defun desktop-read (&optional dirname)
@@ -1583,7 +1112,7 @@
(file-error (message "Couldn't record use of desktop file")
(sit-for 1))))
- (unless (desktop-restoring-frames-p)
+ (unless (desktop-restoring-frameset-p)
;; `desktop-create-buffer' puts buffers at end of the buffer list.
;; We want buffers existing prior to evaluating the desktop (and
;; not reused) to be placed at the end of the buffer list, so we
@@ -1593,9 +1122,14 @@
(switch-to-buffer (car (buffer-list))))
(run-hooks 'desktop-delay-hook)
(setq desktop-delay-hook nil)
- (desktop-restore-frames)
+ (desktop-restore-frameset)
(run-hooks 'desktop-after-read-hook)
- (message "Desktop: %d buffer%s restored%s%s."
+ (message "Desktop: %s%d buffer%s restored%s%s."
+ (if desktop-saved-frameset
+ (let ((fn (length (frameset-states
desktop-saved-frameset))))
+ (format "%d frame%s, "
+ fn (if (= fn 1) "" "s")))
+ "")
desktop-buffer-ok-count
(if (= 1 desktop-buffer-ok-count) "" "s")
(if (< 0 desktop-buffer-fail-count)
@@ -1605,7 +1139,7 @@
(format ", %d to restore lazily"
(length desktop-buffer-args-list))
""))
- (unless (desktop-restoring-frames-p)
+ (unless (desktop-restoring-frameset-p)
;; Bury the *Messages* buffer to not reshow it when burying
;; the buffer we switched to above.
(when (buffer-live-p (get-buffer "*Messages*"))
@@ -1743,14 +1277,6 @@
;; Create a buffer, load its file, set its mode, ...;
;; called from Desktop file only.
-;; Just to silence the byte compiler.
-
-(defvar desktop-first-buffer) ; Dynamically bound in `desktop-read'
-
-;; Bound locally in `desktop-read'.
-(defvar desktop-buffer-ok-count)
-(defvar desktop-buffer-fail-count)
-
(defun desktop-create-buffer
(file-version
buffer-filename
=== added file 'lisp/frameset.el'
--- a/lisp/frameset.el 1970-01-01 00:00:00 +0000
+++ b/lisp/frameset.el 2013-08-02 04:33:58 +0000
@@ -0,0 +1,675 @@
+;;; frameset.el --- save and restore frame and window setup -*-
lexical-binding: t -*-
+
+;; Copyright (C) 2013 Free Software Foundation, Inc.
+
+;; Author: Juanma Barranquero <address@hidden>
+;; Keywords: convenience
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software: you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; This file provides a set of operations to save a frameset (the state
+;; of all or a subset of the existing frames and windows), both
+;; in-session and persistently, and restore it at some point in the
+;; future.
+;;
+;; It should be noted that restoring the frames' windows depends on
+;; the buffers they are displaying, but this package does not provide
+;; any way to save and restore sets of buffers (see desktop.el for
+;; that). So, it's up to the user of frameset.el to make sure that
+;; any relevant buffer is loaded before trying to restore a frameset.
+;; When a window is restored and a buffer is missing, the window will
+;; be deleted unless it is the last one in the frame, in which case
+;; some previous buffer will be shown instead.
+
+;;; Code:
+
+(require 'cl-lib)
+
+
+;; Framesets have two fields:
+;; - properties: a property list to store both frameset-specific and
+;; user-defined serializable data. Currently defined properties
+;; include:
+;; :version ID - Identifies the version of the frameset struct;
+;; this is the only property always present and
+;; must not be modified.
+;; :app APPINFO - Freeform. Can be used by applications and
+;; packages to indicate the intended (but by no
+;; means exclusive) use of the frameset. For
+;; example, currently desktop.el sets :app to
+;; `(desktop . ,desktop-file-version).
+;; :name NAME - The name of the frameset instance; a string.
+;; :desc TEXT - A description for user consumption (to choose
+;; among framesets, etc.); a string.
+;; - states: an alist of items (FRAME-PARAMETERS . WINDOW-STATE) in
+;; no particular order. Each item represents a frame to be
+;; restored.
+
+(cl-defstruct (frameset (:type list) :named
+ (:copier nil)
+ (:predicate nil))
+ properties ;; property list
+ states) ;; list of conses (frame-state . window-state)
+
+(defun copy-frameset (frameset)
+ "Return a copy of FRAMESET.
+This is a deep copy done with `copy-tree'."
+ (copy-tree frameset t))
+
+;;;autoload
+(defun frameset-p (frameset)
+ "If FRAMESET is a frameset, return its :version.
+Else return nil."
+ (and (eq (car-safe frameset) 'frameset)
+ (plist-get (cl-second frameset) :version)))
+
+
+;; Filtering
+
+(defvar frameset-filter-alist
+ '((background-color . frameset-filter-sanitize-color)
+ (buffer-list . t)
+ (buffer-predicate . t)
+ (buried-buffer-list . t)
+ (font . frameset-filter-save-parm)
+ (foreground-color . frameset-filter-sanitize-color)
+ (fullscreen . frameset-filter-save-parm)
+ (GUI:font . frameset-filter-restore-parm)
+ (GUI:fullscreen . frameset-filter-restore-parm)
+ (GUI:height . frameset-filter-restore-parm)
+ (GUI:width . frameset-filter-restore-parm)
+ (height . frameset-filter-save-parm)
+ (left . frameset-filter-iconified)
+ (minibuffer . frameset-filter-minibuffer)
+ (top . frameset-filter-iconified)
+ (width . frameset-filter-save-parm))
+ "Alist of frame parameters and filtering functions.
+
+Each element is a cons (PARAM . ACTION), where PARAM is a parameter
+name (a symbol identifying a frame parameter), and ACTION can be:
+
+ t The parameter is always removed from the parameter list.
+ :save The parameter is removed when saving the frame.
+ :restore The parameter is removed when restoring the frame.
+ FILTER A filter function.
+
+FILTER can be a symbol FILTER-FUN, or a list (FILTER-FUN ARGS...).
+It will be called with four arguments CURRENT, FILTERED, PARAMETERS
+and SAVING, plus any additional ARGS:
+
+ CURRENT A cons (PARAM . VALUE), where PARAM is the one being
+ filtered and VALUE is its current value.
+ FILTERED The alist of parameters filtered so far.
+ PARAMETERS The complete alist of parameters being filtered,
+ SAVING Non-nil if filtering before saving state, nil otherwise.
+
+The FILTER-FUN function must return:
+ nil CURRENT is removed from the list.
+ t CURRENT is left as is.
+ (PARAM' . VALUE') Replace CURRENT with this.
+
+Frame parameters not on this list are passed intact.")
+
+(defvar frameset--target-display nil
+ ;; Either (minibuffer . VALUE) or nil.
+ ;; This refers to the current frame config being processed inside
+ ;; `frame--restore-frames' and its auxiliary functions (like filtering).
+ ;; If nil, there is no need to change the display.
+ ;; If non-nil, display parameter to use when creating the frame.
+ "Internal use only.")
+
+(defun frameset-switch-to-gui-p (parameters)
+ "True when switching to a graphic display.
+Return t if PARAMETERS describes a text-only terminal and
+the target is a graphic display; otherwise return nil.
+Only meaningful when called from a filtering function in
+`frameset-filter-alist'."
+ (and frameset--target-display ; we're switching
+ (null (cdr (assq 'display parameters))) ; from a tty
+ (cdr frameset--target-display))) ; to a GUI display
+
+(defun frameset-switch-to-tty-p (parameters)
+ "True when switching to a text-only terminal.
+Return t if PARAMETERS describes a graphic display and
+the target is a text-only terminal; otherwise return nil.
+Only meaningful when called from a filtering function in
+`frameset-filter-alist'."
+ (and frameset--target-display ; we're switching
+ (cdr (assq 'display parameters)) ; from a GUI display
+ (null (cdr frameset--target-display)))) ; to a tty
+
+(defun frameset-filter-sanitize-color (current _filtered parameters saving)
+ "When switching to a GUI frame, remove \"unspecified\" colors.
+Useful as a filter function for tty-specific parameters."
+ (or saving
+ (not (frameset-switch-to-gui-p parameters))
+ (not (stringp (cdr current)))
+ (not (string-match-p "^unspecified-[fb]g$" (cdr current)))))
+
+(defun frameset-filter-minibuffer (current _filtered _parameters saving)
+ "Convert (minibuffer . #<window>) parameter to (minibuffer . t)."
+ (or (not saving)
+ (if (windowp (cdr current))
+ '(minibuffer . t)
+ t)))
+
+(defun frameset-filter-save-parm (current _filtered parameters saving
+ &optional prefix)
+ "When switching to a tty frame, save parameter P as PREFIX:P.
+The parameter can be later restored with `frameset-filter-restore-parm'.
+PREFIX defaults to `GUI'."
+ (unless prefix (setq prefix 'GUI))
+ (cond (saving t)
+ ((frameset-switch-to-tty-p parameters)
+ (let ((prefix:p (intern (format "%s:%s" prefix (car current)))))
+ (if (assq prefix:p parameters)
+ nil
+ (cons prefix:p (cdr current)))))
+ ((frameset-switch-to-gui-p parameters)
+ (not (assq (intern (format "%s:%s" prefix (car current))) parameters)))
+ (t t)))
+
+(defun frameset-filter-restore-parm (current filtered parameters saving)
+ "When switching to a GUI frame, restore PREFIX:P parameter as P.
+CURRENT must be of the form (PREFIX:P . value)."
+ (or saving
+ (not (frameset-switch-to-gui-p parameters))
+ (let* ((prefix:p (symbol-name (car current)))
+ (p (intern (substring prefix:p
+ (1+ (string-match-p ":" prefix:p)))))
+ (val (cdr current))
+ (found (assq p filtered)))
+ (if (not found)
+ (cons p val)
+ (setcdr found val)
+ nil))))
+
+(defun frameset-filter-iconified (_current _filtered parameters saving)
+ "Remove CURRENT when saving an iconified frame.
+This is used for positions parameters `left' and `top', which are
+meaningless in an iconified frame, so the frame is restored in a
+default position."
+ (not (and saving (eq (cdr (assq 'visibility parameters)) 'icon))))
+
+(defun frameset-keep-original-display-p (force-display)
+ "True if saved frames' displays should be honored."
+ (cond ((daemonp) t)
+ ((eq system-type 'windows-nt) nil)
+ (t (null force-display))))
+
+(defun frameset-filter-params (parameters filter-alist saving)
+ "Filter parameter list PARAMETERS and return a filtered list.
+FILTER-ALIST is an alist of parameter filters, in the format of
+`frameset-filter-alist' (which see).
+SAVING is non-nil while filtering parameters to save a frameset,
+nil while the filtering is done to restore it."
+ (let ((filtered nil))
+ (dolist (current parameters)
+ (pcase (cdr (assq (car current) filter-alist))
+ (`nil
+ (push current filtered))
+ (`t
+ nil)
+ (:save
+ (unless saving (push current filtered)))
+ (:restore
+ (when saving (push current filtered)))
+ ((or `(,fun . ,args) (and fun (pred fboundp)))
+ (let ((this (apply fun filtered current parameters saving args)))
+ (when this
+ (push (if (eq this t) current this) filtered))))
+ (other
+ (delay-warning 'frameset (format "Unknown filter %S" other) :error))))
+ ;; Set the display parameter after filtering, so that filter functions
+ ;; have access to its original value.
+ (when frameset--target-display
+ (let ((display (assq 'display filtered)))
+ (if display
+ (setcdr display (cdr frameset--target-display))
+ (push frameset--target-display filtered))))
+ filtered))
+
+
+;; Saving framesets
+
+(defun frameset--set-id (frame)
+ "Set FRAME's `frameset-id' if not yet set.
+Internal use only."
+ (unless (frame-parameter frame 'frameset-id)
+ (set-frame-parameter frame
+ 'frameset-id
+ (mapconcat (lambda (n) (format "%04X" n))
+ (cl-loop repeat 4 collect (random 65536))
+ "-"))))
+
+(defun frameset--process-minibuffer-frames (frame-list)
+ "Process FRAME-LIST and record minibuffer relationships.
+FRAME-LIST is a list of frames."
+ ;; Record frames with their own minibuffer
+ (dolist (frame (minibuffer-frame-list))
+ (when (memq frame frame-list)
+ (frameset--set-id frame)
+ ;; For minibuffer-owning frames, frameset--mini is a cons
+ ;; (t . DEFAULT?), where DEFAULT? is a boolean indicating whether
+ ;; the frame is the one pointed out by `default-minibuffer-frame'.
+ (set-frame-parameter frame
+ 'frameset--mini
+ (cons t (eq frame default-minibuffer-frame)))))
+ ;; Now link minibufferless frames with their minibuffer frames
+ (dolist (frame frame-list)
+ (unless (frame-parameter frame 'frameset--mini)
+ (frameset--set-id frame)
+ (let* ((mb-frame (window-frame (minibuffer-window frame)))
+ (id (and mb-frame (frame-parameter mb-frame 'frameset-id))))
+ (if (null id)
+ (error "Minibuffer frame %S for %S is excluded" mb-frame frame)
+ ;; For minibufferless frames, frameset--mini is a cons
+ ;; (nil . FRAME-ID), where FRAME-ID is the frameset-id of
+ ;; the frame containing its minibuffer window.
+ (set-frame-parameter frame
+ 'frameset--mini
+ (cons nil id)))))))
+
+;;;autoload
+(cl-defun frameset-save (frame-list &key filters predicate properties)
+ "Return the frameset of FRAME-LIST, a list of frames.
+If nil, FRAME-LIST defaults to all live frames.
+FILTERS is an alist of parameter filters; defaults to `frameset-filter-alist'.
+PREDICATE is a predicate function, which must return non-nil for frames that
+should be saved; it defaults to saving all frames from FRAME-LIST.
+PROPERTIES is a user-defined property list to add to the frameset."
+ (let ((frames (cl-delete-if-not #'frame-live-p
+ (cl-remove-if-not (or predicate #'framep)
+ (or frame-list
(frame-list))))))
+ (frameset--process-minibuffer-frames frames)
+ (make-frameset :properties (append '(:version 1) properties)
+ :states (mapcar
+ (lambda (frame)
+ (cons
+ (frameset-filter-params (frame-parameters frame)
+ (or filters
+
frameset-filter-alist)
+ t)
+ (window-state-get (frame-root-window frame) t)))
+ frames))))
+
+
+;; Restoring framesets
+
+(defvar frameset--reuse-list nil
+ "Internal use only.")
+
+(defun frameset--compute-pos (value left/top right/bottom)
+ (pcase value
+ (`(+ ,val) (+ left/top val))
+ (`(- ,val) (+ right/bottom val))
+ (val val)))
+
+(defun frameset--move-onscreen (frame force-onscreen)
+ "If FRAME is offscreen, move it back onscreen and, if necessary, resize it.
+For the description of FORCE-ONSCREEN, see `frameset-restore'.
+When forced onscreen, frames wider than the monitor's workarea are converted
+to fullwidth, and frames taller than the workarea are converted to fullheight.
+NOTE: This only works for non-iconified frames. Internal use only."
+ (pcase-let* ((`(,left ,top ,width ,height) (cl-cdadr
(frame-monitor-attributes frame)))
+ (right (+ left width -1))
+ (bottom (+ top height -1))
+ (fr-left (frameset--compute-pos (frame-parameter frame 'left)
left right))
+ (fr-top (frameset--compute-pos (frame-parameter frame 'top) top
bottom))
+ (ch-width (frame-char-width frame))
+ (ch-height (frame-char-height frame))
+ (fr-width (max (frame-pixel-width frame) (* ch-width
(frame-width frame))))
+ (fr-height (max (frame-pixel-height frame) (* ch-height
(frame-height frame))))
+ (fr-right (+ fr-left fr-width -1))
+ (fr-bottom (+ fr-top fr-height -1)))
+ (when (pcase force-onscreen
+ ;; Any corner is outside the screen.
+ (`all (or (< fr-bottom top) (> fr-bottom bottom)
+ (< fr-left left) (> fr-left right)
+ (< fr-right left) (> fr-right right)
+ (< fr-top top) (> fr-top bottom)))
+ ;; Displaced to the left, right, above or below the screen.
+ (`t (or (> fr-left right)
+ (< fr-right left)
+ (> fr-top bottom)
+ (< fr-bottom top)))
+ ;; Fully inside, no need to do anything.
+ (_ nil))
+ (let ((fullwidth (> fr-width width))
+ (fullheight (> fr-height height))
+ (params nil))
+ ;; Position frame horizontally.
+ (cond (fullwidth
+ (push `(left . ,left) params))
+ ((> fr-right right)
+ (push `(left . ,(+ left (- width fr-width))) params))
+ ((< fr-left left)
+ (push `(left . ,left) params)))
+ ;; Position frame vertically.
+ (cond (fullheight
+ (push `(top . ,top) params))
+ ((> fr-bottom bottom)
+ (push `(top . ,(+ top (- height fr-height))) params))
+ ((< fr-top top)
+ (push `(top . ,top) params)))
+ ;; Compute fullscreen state, if required.
+ (when (or fullwidth fullheight)
+ (push (cons 'fullscreen
+ (cond ((not fullwidth) 'fullheight)
+ ((not fullheight) 'fullwidth)
+ (t 'maximized)))
+ params))
+ ;; Finally, move the frame back onscreen.
+ (when params
+ (modify-frame-parameters frame params))))))
+
+(defun frameset--find-frame (predicate display &rest args)
+ "Find a frame in `frameset--reuse-list' satisfying PREDICATE.
+Look through available frames whose display property matches DISPLAY
+and return the first one for which (PREDICATE frame ARGS) returns t.
+If PREDICATE is nil, it is always satisfied. Internal use only."
+ (cl-find-if (lambda (frame)
+ (and (equal (frame-parameter frame 'display) display)
+ (or (null predicate)
+ (apply predicate frame args))))
+ frameset--reuse-list))
+
+(defun frameset--reuse-frame (display frame-cfg)
+ "Look for an existing frame to reuse.
+DISPLAY is the display where the frame will be shown, and FRAME-CFG
+is the parameter list of the frame being restored. Internal use only."
+ (let ((frame nil)
+ mini)
+ ;; There are no fancy heuristics there. We could implement some
+ ;; based on frame size and/or position, etc., but it is not clear
+ ;; that any "gain" (in the sense of reduced flickering, etc.) is
+ ;; worth the added complexity. In fact, the code below mainly
+ ;; tries to work nicely when M-x desktop-read is used after a
+ ;; desktop session has already been loaded. The other main use
+ ;; case, which is the initial desktop-read upon starting Emacs,
+ ;; will usually have only one frame, and should already work.
+ (cond ((null display)
+ ;; When the target is tty, every existing frame is reusable.
+ (setq frame (frameset--find-frame nil display)))
+ ((car (setq mini (cdr (assq 'frameset--mini frame-cfg))))
+ ;; If the frame has its own minibuffer, let's see whether
+ ;; that frame has already been loaded (which can happen after
+ ;; M-x desktop-read).
+ (setq frame (frameset--find-frame
+ (lambda (f id)
+ (string= (frame-parameter f 'frameset-id) id))
+ display (cdr mini)))
+ ;; If it has not been loaded, and it is not a minibuffer-only frame,
+ ;; let's look for an existing non-minibuffer-only frame to reuse.
+ (unless (or frame (eq (cdr (assq 'minibuffer frame-cfg)) 'only))
+ (setq frame (frameset--find-frame
+ (lambda (f)
+ (let ((w (frame-parameter f 'minibuffer)))
+ (and (window-live-p w)
+ (window-minibuffer-p w)
+ (eq (window-frame w) f))))
+ display))))
+ (mini
+ ;; For minibufferless frames, check whether they already exist,
+ ;; and that they are linked to the right minibuffer frame.
+ (setq frame (frameset--find-frame
+ (lambda (f id mini-id)
+ (and (string= (frame-parameter f 'frameset-id) id)
+ (string= (frame-parameter (window-frame
(minibuffer-window f))
+ 'frameset-id)
+ mini-id)))
+ display (cdr (assq 'frameset-id frame-cfg)) (cdr
mini))))
+ (t
+ ;; Default to just finding a frame in the same display.
+ (setq frame (frameset--find-frame nil display))))
+ ;; If found, remove from the list.
+ (when frame
+ (setq frameset--reuse-list (delq frame frameset--reuse-list)))
+ frame))
+
+(defun frameset--get-frame (frame-cfg window-cfg filters force-onscreen)
+ "Set up and return a frame according to its saved state.
+That means either reusing an existing frame or creating one anew.
+FRAME-CFG is the frame's parameter list; WINDOW-CFG is its window state.
+For the meaning of FORCE-ONSCREEN, see `frameset-restore'."
+ (let* ((fullscreen (cdr (assq 'fullscreen frame-cfg)))
+ (lines (assq 'tool-bar-lines frame-cfg))
+ (filtered-cfg (frameset-filter-params frame-cfg filters nil))
+ (display (cdr (assq 'display filtered-cfg))) ;; post-filtering
+ alt-cfg frame)
+
+ ;; This works around bug#14795 (or feature#14795, if not a bug :-)
+ (setq filtered-cfg (assq-delete-all 'tool-bar-lines filtered-cfg))
+ (push '(tool-bar-lines . 0) filtered-cfg)
+
+ (when fullscreen
+ ;; Currently Emacs has the limitation that it does not record the size
+ ;; and position of a frame before maximizing it, so we cannot save &
+ ;; restore that info. Instead, when restoring, we resort to creating
+ ;; invisible "fullscreen" frames of default size and then maximizing them
+ ;; (and making them visible) which at least is somewhat user-friendly
+ ;; when these frames are later de-maximized.
+ (let ((width (and (eq fullscreen 'fullheight) (cdr (assq 'width
filtered-cfg))))
+ (height (and (eq fullscreen 'fullwidth) (cdr (assq 'height
filtered-cfg))))
+ (visible (assq 'visibility filtered-cfg)))
+ (setq filtered-cfg (cl-delete-if (lambda (p)
+ (memq p '(visibility fullscreen
width height)))
+ filtered-cfg :key #'car))
+ (when width
+ (setq filtered-cfg (append `((user-size . t) (width . ,width))
+ filtered-cfg)))
+ (when height
+ (setq filtered-cfg (append `((user-size . t) (height . ,height))
+ filtered-cfg)))
+ ;; These are parameters to apply after creating/setting the frame.
+ (push visible alt-cfg)
+ (push (cons 'fullscreen fullscreen) alt-cfg)))
+
+ ;; Time to find or create a frame an apply the big bunch of parameters.
+ ;; If a frame needs to be created and it falls partially or fully
offscreen,
+ ;; sometimes it gets "pushed back" onscreen; however, moving it afterwards
is
+ ;; allowed. So we create the frame as invisible and then reapply the full
+ ;; parameter list (including position and size parameters).
+ (setq frame (or (and frameset--reuse-list
+ (frameset--reuse-frame display filtered-cfg))
+ (make-frame-on-display display
+ (cons '(visibility)
+ (cl-loop
+ for param in '(left top width
height minibuffer)
+ collect (assq param
filtered-cfg))))))
+ (modify-frame-parameters frame
+ (if (eq (frame-parameter frame 'fullscreen)
fullscreen)
+ ;; Workaround for bug#14949
+ (assq-delete-all 'fullscreen filtered-cfg)
+ filtered-cfg))
+
+ ;; If requested, force frames to be onscreen.
+ (when (and force-onscreen
+ ;; FIXME: iconified frames should be checked too,
+ ;; but it is impossible without deiconifying them.
+ (not (eq (frame-parameter frame 'visibility) 'icon)))
+ (frameset--move-onscreen frame force-onscreen))
+
+ ;; Let's give the finishing touches (visibility, tool-bar, maximization).
+ (when lines (push lines alt-cfg))
+ (when alt-cfg (modify-frame-parameters frame alt-cfg))
+ ;; Now restore window state.
+ (window-state-put window-cfg (frame-root-window frame) 'safe)
+ frame))
+
+(defun frameset--sort-states (state1 state2)
+ "Predicate to sort frame states in a suitable order to be created.
+It sorts minibuffer-owning frames before minibufferless ones."
+ (pcase-let ((`(,hasmini1 ,id-def1) (assq 'frameset--mini (car state1)))
+ (`(,hasmini2 ,id-def2) (assq 'frameset--mini (car state2))))
+ (cond ((eq id-def1 t) t)
+ ((eq id-def2 t) nil)
+ ((not (eq hasmini1 hasmini2)) (eq hasmini1 t))
+ ((eq hasmini1 nil) (string< id-def1 id-def2))
+ (t t))))
+
+(defun frameset-sort-frames-for-deletion (frame1 _frame2)
+ "Predicate to sort live frames for deletion.
+Minibufferless frames must go first to avoid errors when attempting
+to delete a frame whose minibuffer window is used by another frame."
+ (not (frame-parameter frame1 'minibuffer)))
+
+;;;autoload
+(cl-defun frameset-restore (frameset &key filters reuse-frames force-display
force-onscreen)
+ "Restore a FRAMESET into the current display(s).
+
+FILTERS is a list of parameter filters; defaults to `frameset-filter-alist'.
+
+REUSE-FRAMES describes how to reuse existing frames while restoring a frameset:
+ t Reuse any existing frame if possible; delete leftover frames.
+ nil Restore frameset in new frames and delete existing frames.
+ keep Restore frameset in new frames and keep the existing ones.
+ LIST A list of frames to reuse; only these will be reused, if possible,
+ and any leftover one will be deleted; other frames not on this
+ list will be kept.
+
+FORCE-DISPLAY can be:
+ t Frames will be restored in the current display.
+ nil Frames will be restored, if possible, in their original displays.
+ delete Frames in other displays will be deleted instead of restored.
+
+FORCE-ONSCREEN can be:
+ all Force onscreen any frame fully or partially offscreen.
+ t Force onscreen only those frames that are fully offscreen.
+ nil Do not force any frame back onscreen.
+
+All keywords default to nil."
+
+ (cl-assert (frameset-p frameset))
+
+ (let* ((delete-saved (eq force-display 'delete))
+ (forcing (not (frameset-keep-original-display-p force-display)))
+ (target (and forcing (cons 'display (frame-parameter nil 'display))))
+ other-frames)
+
+ ;; frameset--reuse-list is a list of frames potentially reusable. Later we
+ ;; will decide which ones can be reused, and how to deal with any leftover.
+ (pcase reuse-frames
+ ((or `nil `keep)
+ (setq frameset--reuse-list nil
+ other-frames (frame-list)))
+ ((pred consp)
+ (setq frameset--reuse-list (copy-sequence reuse-frames)
+ other-frames (cl-delete-if (lambda (frame)
+ (memq frame frameset--reuse-list))
+ (frame-list))))
+ (_
+ (setq frameset--reuse-list (frame-list)
+ other-frames nil)))
+
+ ;; Sort saved states to guarantee that minibufferless frames will be
created
+ ;; after the frames that contain their minibuffer windows.
+ (dolist (state (sort (copy-sequence (frameset-states frameset))
+ #'frameset--sort-states))
+ (condition-case-unless-debug err
+ (pcase-let* ((`(,frame-cfg . ,window-cfg) state)
+ ((and d-mini `(,hasmini . ,mb-id))
+ (cdr (assq 'frameset--mini frame-cfg)))
+ (default (and (booleanp mb-id) mb-id))
+ (frame nil) (to-tty nil))
+ ;; Only set target if forcing displays and the target display is
different.
+ (if (or (not forcing)
+ (equal target (or (assq 'display frame-cfg) '(display .
nil))))
+ (setq frameset--target-display nil)
+ (setq frameset--target-display target
+ to-tty (null (cdr target))))
+ ;; If keeping non-reusable frames, and the frame-id of one of them
+ ;; matches the frame-id of a frame being restored (because, for
example,
+ ;; the frameset has already been read in the same session), remove
the
+ ;; frame-id from the non-reusable frame, which is not useful
anymore.
+ (when (and other-frames
+ (or (eq reuse-frames 'keep) (consp reuse-frames)))
+ (let ((dup (cl-find (cdr (assq 'frameset-frame-id frame-cfg))
+ other-frames
+ :key (lambda (frame)
+ (frame-parameter frame
'frameset-frame-id))
+ :test #'string=)))
+ (when dup
+ (set-frame-parameter dup 'frameset-frame-id nil))))
+ ;; Time to restore frames and set up their minibuffers as they were.
+ ;; We only skip a frame (thus deleting it) if either:
+ ;; - we're switching displays, and the user chose the option to
delete, or
+ ;; - we're switching to tty, and the frame to restore is
minibuffer-only.
+ (unless (and frameset--target-display
+ (or delete-saved
+ (and to-tty
+ (eq (cdr (assq 'minibuffer frame-cfg))
'only))))
+
+ ;; Restore minibuffers. Some of this stuff could be done in a
filter
+ ;; function, but it would be messy because restoring minibuffers
affects
+ ;; global state; it's best to do it here than add a bunch of
global
+ ;; variables to pass info back-and-forth to/from the filter
function.
+ (cond
+ ((null d-mini)) ;; No frameset--mini. Process as normal frame.
+ (to-tty) ;; Ignore minibuffer stuff and process as normal frame.
+ (hasmini ;; Frame has minibuffer (or it is minibuffer-only).
+ (when (eq (cdr (assq 'minibuffer frame-cfg)) 'only)
+ (setq frame-cfg (append '((tool-bar-lines . 0)
(menu-bar-lines . 0))
+ frame-cfg))))
+ (t ;; Frame depends on other frame's minibuffer window.
+ (let* ((mb-frame (or (cl-find-if
+ (lambda (f)
+ (string= (frame-parameter f
'frameset-id)
+ mb-id))
+ (frame-list))
+ (error "Minibuffer frame %S not found"
mb-id)))
+ (mb-param (assq 'minibuffer frame-cfg))
+ (mb-window (minibuffer-window mb-frame)))
+ (unless (and (window-live-p mb-window)
+ (window-minibuffer-p mb-window))
+ (error "Not a minibuffer window %s" mb-window))
+ (if mb-param
+ (setcdr mb-param mb-window)
+ (push (cons 'minibuffer mb-window) frame-cfg))))))
+ ;; OK, we're ready at last to create (or reuse) a frame and
+ ;; restore the window config.
+ (setq frame (frameset--get-frame frame-cfg window-cfg
+ (or filters frameset-filter-alist)
+ force-onscreen))
+ ;; Set default-minibuffer if required.
+ (when default (setq default-minibuffer-frame frame)))
+ (error
+ (delay-warning 'frameset (error-message-string err) :error))))
+
+ ;; In case we try to delete the initial frame, we want to make sure that
+ ;; other frames are already visible (discussed in thread for bug#14841).
+ (sit-for 0 t)
+
+ ;; Delete remaining frames, but do not fail if some resist being deleted.
+ (unless (eq reuse-frames 'keep)
+ (dolist (frame (sort (nconc (if (listp reuse-frames) nil other-frames)
+ frameset--reuse-list)
+ #'frameset-sort-frames-for-deletion))
+ (condition-case err
+ (delete-frame frame)
+ (error
+ (delay-warning 'frameset (error-message-string err))))))
+ (setq frameset--reuse-list nil)
+
+ ;; Make sure there's at least one visible frame.
+ (unless (or (daemonp) (visible-frame-list))
+ (make-frame-visible (car (frame-list))))))
+
+(provide 'frameset)
+
+;;; frameset.el ends here
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] trunk r113648: lisp/desktop.el: Move code related to saving frames to frameset.el.,
Juanma Barranquero <=