Re: Freezing frameset-restore

[Juanma Barranquero]

On Sat, Mar 8, 2014 at 5:31 AM, Stefan Monnier <address@hidden> wrote:

> The fact that it's bad already or that there's worse out there is no excuse.

I wasn't saying that as an excuse, just pointing out that I don't find
it terribly complex.

> Right (I'd expect that function to take the whole list, BTW, but
> if mapc can be used, it's not critical).

Oh, I see. mapc can be used, but if you're going to add error checking
(and I want to), it's not as clean as (mapc #'delete-frame
(frameset-restore fs)). I've changed the function to process the list
instead of individual items, and do error-checking. Now it defaults to
an action-map of '(((:ignored :rejected) . delete-frame)), but it can
be passed another action-map if desired.

> I don't see why sorting would be needed.

If the action is to delete, frames must be sorted so minibufferless
frames are deleted first; otherwise, we could try to delete a frame
whose minibuffer window is still used by another frame. Yes, I do
think that life would be easier if minibufferless frames didn't exist,
but obviously they have their fans (hi, Drew!).

> Clearly, the returned list does not need to give an action for
> all frames.  Only for those which we did consider. So we don't need to
> call `frames-list' just so as to build the return value.

I'm not sure what do you mean here by "those which we did consider"
(there are several possible interpretations: candidates, frames
included/not included in LIST passed to REUSE-FRAMES, etc.), but in
any case, I suspect that I strongly disagree. For example, you could
pass REUSE-FRAMES = :none, which wouldn't "consider" any existing
frame at all, and yet want to delete all previously-existing frames.

And even in our scarce two uses cases, already one of them
(frameset--jump-to-register) does need a cleanup other than
delete-frame, because its default action (copied from
frame-configuration-to-register) is to iconify.

> I think it's cleaner.

Here's the code (untabified, so not 'bzr patch'able).

    J



2014-03-08  Juanma Barranquero  <address@hidden>

        * frameset.el: Separate frame-list cleaning from reusing.
        (frameset--action-map): New variable.
        (frameset--restore-frame): Cache frame action.
        (frameset-restore): Redesign REUSE-FRAMES arg by removing cleanup
        options and adding new PRED option.  Return alist of frames and
        actions carried on them.
        (frameset-restore-cleanup): New function.
        (frameset--jump-to-register): Use it.

        * desktop.el (desktop-restore-frameset): Use frameset-restore-cleanup.




=== modified file 'lisp/frameset.el'
--- lisp/frameset.el    2014-03-05 16:22:47 +0000
+++ lisp/frameset.el    2014-03-08 05:43:12 +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,20 @@
        (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
-                                          (cons '(visibility)
-
(frameset--initial-params filtered-cfg)))))
+    ;; 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)))
+    (if frame
+       (puthash frame :reused frameset--action-map)
+      ;; 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))))
+      (puthash frame :created frameset--action-map))
+
     (modify-frame-parameters frame
                             (if (eq (frame-parameter frame
'fullscreen) fullscreen)
                                 ;; Workaround for bug#14949
@@ -1050,13 +1059,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 +1086,67 @@
           - 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 (make-hash-table :test #'eq :weakness 'value))

     ;; 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
+                                      (puthash 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)
+             (puthash 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)
+           (puthash 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 +1183,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 +1230,66 @@
     ;; 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))))))
+    ;; Compute the frame-action list.
+    (dolist (frame (sort (frame-list) #'frameset-minibufferless-first-p))
+      ;; We are generating the list in reverse order.  Will nreverse later.
+      (push (cons frame (gethash frame frameset--action-map)) cleanup))
+
+    ;; 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 (car (frame-list))))))
-
+      (make-frame-visible (car (frame-list))))
+
+    ;; Minibufferless frames must go first to avoid errors when attempting
+    ;; to delete a frame whose minibuffer window is used by another frame.
+    (nreverse 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 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)))

=== modified file 'lisp/desktop.el'
--- lisp/desktop.el     2014-02-22 02:10:49 +0000
+++ lisp/desktop.el     2014-03-08 05:22:21 +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'.