Re: Freezing frameset-restore

[Juanma Barranquero]

A variant of the last patch.

frameset-restore still returns an action-map for all frames, but it
builds it on the fly while processing the frames, so it avoids
recomputing it at the end and calling again frame-list unnecessarily.

    J



=== modified file 'lisp/desktop.el'
--- lisp/desktop.el     2014-02-22 02:10:49 +0000
+++ lisp/desktop.el     2014-03-08 22:31:50 +0000
@@ -1057,10 +1057,14 @@
 This function depends on the value of `desktop-saved-frameset'
 being set (usually, by reading it from the desktop)."
   (when (desktop-restoring-frameset-p)
-    (frameset-restore desktop-saved-frameset
-                     :reuse-frames desktop-restore-reuses-frames
-                     :force-display desktop-restore-in-current-display
-                     :force-onscreen desktop-restore-forces-onscreen)))
+    (let* ((reuse desktop-restore-reuses-frames)
+          (cleanup-list (frameset-restore
+                         desktop-saved-frameset
+                         :reuse-frames (if (eq reuse t) :all :none)
+                         :force-display desktop-restore-in-current-display
+                         :force-onscreen desktop-restore-forces-onscreen)))
+      (unless (eq reuse :keep)
+       (frameset-restore-cleanup cleanup-list)))))

 ;; Just to silence the byte compiler.
 ;; Dynamically bound in `desktop-read'.

=== modified file 'lisp/frameset.el'
--- lisp/frameset.el    2014-03-08 22:26:20 +0000
+++ lisp/frameset.el    2014-03-08 23:20:07 +0000
@@ -791,6 +791,11 @@
 Its value is only meaningful during execution of `frameset-restore'.
 Internal use only.")

+(defvar frameset--action-map nil
+  "Map of frames to actions.
+Its value is only meaningful during execution of `frameset-restore'.
+Internal use only.")
+
 (defun frameset-compute-pos (value left/top right/bottom)
   "Return an absolute positioning value for a frame.
 VALUE is the value of a positional frame parameter (`left' or `top').
@@ -982,16 +987,23 @@
        (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 alist (including position and size parameters).
-    (setq frame (or (and frameset--reuse-list
-                        (frameset--reuse-frame display filtered-cfg))
-                   (make-frame-on-display display
+    ;; Time to find or create a frame and apply the big bunch of parameters.
+    (setq frame (and frameset--reuse-list
+                    (frameset--reuse-frame display filtered-cfg)))
+    (let (action)
+      (if frame
+         (setq action :reused)
+       ;; 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 alist (including position and size parameters).
+       (setq frame (make-frame-on-display display
                                           (cons '(visibility)
-
(frameset--initial-params filtered-cfg)))))
+
(frameset--initial-params filtered-cfg)))
+             action :created))
+      (setq frameset--action-map (cl-acons frame action
+                                          (assq-delete-all frame
frameset--action-map))))
+
     (modify-frame-parameters frame
                             (if (eq (frame-parameter frame
'fullscreen) fullscreen)
                                 ;; Workaround for bug#14949
@@ -1050,13 +1062,13 @@
 FILTERS is an alist of parameter filters; if nil, the value of
 `frameset-filter-alist' is used instead.

-REUSE-FRAMES selects the policy to use to reuse frames when restoring:
-  t        Reuse existing frames if possible, and delete those not reused.
-  nil      Restore frameset in new frames and delete existing frames.
-  :keep    Restore frameset in new frames and keep the existing ones.
+REUSE-FRAMES selects the policy to reuse frames when restoring:
+  :all     All existing frames can be reused.  This is the default.
+  :none    No existing frame can be reused.
+  :match   Only frames with matching frame ids can be reused.
   LIST     A list of frames to reuse; only these are reused (if possible).
-            Remaining frames in this list are deleted; other frames not
-            included on the list are left untouched.
+  PRED     A predicate function; it receives as argument a live frame,
+             and must return non-nil to allow reusing it, nil otherwise.

 FORCE-DISPLAY can be:
   t        Frames are restored in the current display.
@@ -1077,31 +1089,68 @@
           - a list (LEFT TOP WIDTH HEIGHT), describing the workarea.
           It must return non-nil to force the frame onscreen, nil otherwise.

+All keyword parameters default to nil.
+
 Note the timing and scope of the operations described above: REUSE-FRAMES
 affects existing frames; PREDICATE, FILTERS and FORCE-DISPLAY affect the frame
 being restored before that happens; and FORCE-ONSCREEN affects the frame once
 it has been restored.

-All keyword parameters default to nil."
+Returns an alist ((FRAMEn . ACTIONn)...) mapping all live frames to the
+actions carried on them during restoration.  ACTION is one of these:
+  :rejected   Frame existed, but was not a candidate for reuse.
+  :ignored    Frame existed, was a candidate, but wasn't reused.
+  :reused     Frame existed, was a candidate, and restored upon.
+  :created    Frame didn't exist, was created and restored upon.
+
+Function `frameset-restore-cleanup' can be useful to process this list."

   (cl-assert (frameset-valid-p frameset))

-  (let (other-frames)
+  (let ((frames (frame-list))
+       (non-candidates nil)
+       cleanup)
+
+    (setq frameset--action-map nil)

     ;; 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)
+      ((or :all `nil)
+       (setq frameset--reuse-list frames))
+      (:none
        (setq frameset--reuse-list nil
-            other-frames (frame-list)))
+            non-candidates t))
+      (:match
+       (setq frameset--reuse-list
+            (cl-loop for (state) in (frameset-states frameset)
+                     when (frameset-frame-with-id (frameset-cfg-id
state) frames)
+                     collect it)
+            non-candidates t))
+      ((pred functionp)
+       (setq frameset--reuse-list (cl-remove-if
+                                  (lambda (frame)
+                                    (if (funcall reuse-frames frame)
+                                        nil
+                                      (push (cons frame :rejected)
+                                            frameset--action-map)))
+                                  frames)))
       ((pred consp)
        (setq frameset--reuse-list (copy-sequence reuse-frames)
-            other-frames (cl-delete-if (lambda (frame)
-                                         (memq frame frameset--reuse-list))
-                                       (frame-list))))
+            non-candidates t))
       (_
-       (setq frameset--reuse-list (frame-list)
-            other-frames nil)))
+       (error "Invalid arg :reuse-frames %s" reuse-frames)))
+
+    (when non-candidates
+      ;; If we didn't mark non-candidate frames on the fly, do it now.
+      (mapc (lambda (frame)
+             (push (cons frame :rejected) frameset--action-map))
+           (cl-set-difference frames frameset--reuse-list)))
+
+    ;; Mark candidates as :ignored; they will be reassigned later, if chosen.
+    (mapc (lambda (frame)
+           (push (cons frame :ignored) frameset--action-map))
+         frameset--reuse-list)

     ;; Sort saved states to guarantee that minibufferless frames will
be created
     ;; after the frames that contain their minibuffer windows.
@@ -1138,10 +1187,8 @@
                  ;; existing frame whose id matches a frame
configuration in the
                  ;; frameset.  Once the frame config is properly
restored, we can
                  ;; reset the old frame's id to nil.
-                 (setq duplicate (and other-frames
-                                      (or (eq reuse-frames :keep)
(consp reuse-frames))
-                                      (frameset-frame-with-id
(frameset-cfg-id frame-cfg)
-                                                              other-frames)))
+                 (setq duplicate (frameset-frame-with-id
(frameset-cfg-id frame-cfg)
+                                                         frames))
                  ;; 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
@@ -1187,48 +1234,67 @@
     ;; 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)
-                          ;; Minibufferless frames must go first to avoid
-                          ;; errors when attempting to delete a frame whose
-                          ;; minibuffer window is used by another frame.
-                          #'frameset-minibufferless-first-p))
-       (condition-case err
-           (delete-frame frame)
-         (error
-          (delay-warning 'frameset (error-message-string err))))))
+    ;; Prepare the pre-computed frame-action map
+    (setq cleanup (cl-sort frameset--action-map
+                          ;; Minibufferless frames must go first to
avoid errors
+                          ;; when attempting to delete a frame whose minibuffer
+                          ;; window is used by another frame.
+                          #'frameset-minibufferless-first-p
+                          :key #'car))
+
+    ;; Clean temporary caches
     (setq frameset--reuse-list nil
+         frameset--action-map nil
          frameset--target-display nil)

     ;; Make sure there's at least one visible frame.
     (unless (or (daemonp) (visible-frame-list))
-      (make-frame-visible (selected-frame)))))
-
+      (make-frame-visible (selected-frame)))
+
+    cleanup))
+
+(defun frameset-restore-cleanup (frame-action-list &optional action-map)
+  "Clean up the frames in FRAME-ACTION-LIST according to ACTION-MAP.
+FRAME-ACTION-LIST is an alist of conses (FRAME . ACTION) as returned
+by `frameset-restore' (which see).  Optional arg ACTION-MAP is an alist
+\((ACTIONn . FUNCTIONn)...) mapping actions to their cleanup functions.
+ACTION can be an action, or a list of actions.  Each FUNCTION, if called,
+gets a single argument FRAME, and its return value is ignored.
+ACTION-MAP defaults to deleting all :ignored and :rejected frames."
+  (unless action-map
+    (setq action-map '(((:ignored :rejected) . delete-frame))))
+  (dolist (frame-action frame-action-list)
+    (condition-case-unless-debug nil
+       (let* ((action (cdr frame-action))
+              (found (cl-assoc-if (lambda (item)
+                                    (if (consp item)
+                                        (memq action item)
+                                      (eq action item)))
+                                  action-map)))
+         (when found
+           (funcall (cdr found) (car frame-action))))
+      (error
+       (delay-warning 'frameset
+                     (format "Error cleaning up frame %s" (car frame-action))
+                     :warning)))))

 ;; Register support

 (defun frameset--jump-to-register (data)
   "Restore frameset from DATA stored in register.
 Called from `jump-to-register'.  Internal use only."
-  (let ((fs (aref data 0))
-       reuse-frames iconify-list)
-    (if current-prefix-arg
-       ;; Reuse all frames and delete any left unused
-       (setq reuse-frames t)
-      ;; Reuse matching frames and leave others to be iconified
-      (setq iconify-list (frame-list))
-      (dolist (state (frameset-states fs))
-       (let ((frame (frameset-frame-with-id (frameset-cfg-id (car state))
-                                            iconify-list)))
-         (when frame
-           (push frame reuse-frames)
-           (setq iconify-list (delq frame iconify-list))))))
-    (frameset-restore fs
-                     :filters frameset-session-filter-alist
-                     :reuse-frames reuse-frames)
-    (mapc #'iconify-frame iconify-list))
+  (frameset-restore-cleanup
+   (frameset-restore (aref data 0)
+                    :filters frameset-session-filter-alist
+                    :reuse-frames (if current-prefix-arg nil :match))
+   (if current-prefix-arg
+       ;; delete frames
+       nil
+     ;; iconify frames
+     '((:rejected . iconify-frame)
+       ;; In the unexpected case that a frame was a candidate
(matching frame id)
+       ;; and yet not restored, remove it because it is in fact a duplicate.
+       (:ignored . delete-frame))))

   ;; Restore selected frame, buffer and point.
   (let ((frame (frameset-frame-with-id (aref data 1)))