bug#58634: Long delay with blank screen whilst loading desktop at emacs startup

[Alan Mackenzie <acm@muc.de>]

Hello, Eli.

On Sat, Oct 22, 2022 at 16:11:06 +0300, Eli Zaretskii wrote:
> > Date: Sat, 22 Oct 2022 12:20:18 +0000
> > Cc: juri@linkov.net, 58634@debbugs.gnu.org
> > From: Alan Mackenzie <acm@muc.de>

> > Hello, Eli.

> > On Sat, Oct 22, 2022 at 09:26:14 +0300, Eli Zaretskii wrote:
> > > > Date: Fri, 21 Oct 2022 20:11:12 +0000
> > > > Cc: juri@linkov.net, 58634@debbugs.gnu.org
> > > > From: Alan Mackenzie <acm@muc.de>

> > > > > I'm even okay with adding a hook after each buffer is restored, if
> > > > > that will make you happy.  I just don't want these messages (or
> > > > > anything similar) show by default, because no one wants them badly
> > > > > enough.

> > I want them.  Stefan Kangas wants them.  We don't know how many other
> > people want them, even amongst Emacs developers.  If you don't want the
> > messages enabled by default, why not include the facility disabled by
> > default, so that users can enable it when they do want it?

> A hook I proposed is a more general facility, and can satisfy this
> need as well.  It looks to me as a better solution.

OK, I've implemented a solution with a hook.  First version of the patch
is below.

> > > If you are unhappy even with the additional hook proposal (you didn't
> > > say), then I guess we have nothing more to discuss here that could be
> > > useful.

> > The additional hook is a red herring.  To be fully useful, it would need
> > to be passed the current filename and the total number of buffers being
> > restored.

> Since it's a hook called when restoring a buffer, it should be called
> with the buffer name.  The total number of buffers is AFAIR known only
> after everything is processed, and is stored in the
> desktop-buffer-ok-count.  What else is missing?

The total number of buffers can be (and in my patch is) counted in
desktop-save and saved in .emacs.desktop.  It is reinstated in variable
desktop-buffer-count during desktop-read.

In the patch below, I've patterned the new progress messages after the
existing desktop-lazy messages.  Though I don't suppose the lazy loading
facility will be used too much nowadays, given how fast SSDs and
processors are.  All these messages are now output from the hook function.

(The patch is best viewed with git diff -b.)



diff --git a/lisp/desktop.el b/lisp/desktop.el
index ef73bc596d..71f34aa95d 100644
--- a/lisp/desktop.el
+++ b/lisp/desktop.el
@@ -319,6 +319,7 @@ desktop-save-hook
 
 (defcustom desktop-globals-to-save
   '(desktop-missing-file-warning
+    desktop-buffer-count
     tags-file-name
     tags-table-list
     search-ring
@@ -383,6 +384,11 @@ desktop-locals-to-save
   :type '(repeat symbol)
   :group 'desktop)
 
+(defcustom desktop-echo-progress t
+  "If non-nil, progress messages are displayed on loading the desktop."
+  :type 'boolean
+  :group 'desktop)
+
 (defcustom desktop-buffers-not-to-save "\\` "
   "Regexp identifying buffers that are to be excluded from saving.
 This is in effect only for buffers that don't visit files.
@@ -1086,6 +1092,9 @@ desktop-save-frameset
 			    :name (concat user-login-name "@" (system-name))
 			    :predicate #'desktop--check-dont-save))))
 
+(defvar desktop-buffer-count nil
+  "Number of buffers recorded in the desktop file.")
+
 ;;;###autoload
 (defun desktop-save (dirname &optional release only-if-changed version)
   "Save the state of Emacs in a desktop file in directory DIRNAME.
@@ -1108,7 +1117,7 @@ desktop-save
 
 To upgrade a version 206 file to version 208, call this command
 explicitly with a prefix argument: \\[universal-argument] \\[desktop-save].
-If you are upgrading from Emacs 24 or older, we recommend to do
+If you are upgrading from Emacs 24 or older, we recommend doing
 this once you decide you no longer need compatibility with versions
 of Emacs before 25.1.
 
@@ -1176,69 +1185,77 @@ desktop-save
                 desktop-io-file-version)))
 
 	(with-temp-buffer
-	  (insert
-	   ";; -*- mode: emacs-lisp; lexical-binding:t; coding: utf-8-emacs; -*-\n"
-	   desktop-header
-	   ";; Created " (current-time-string) "\n"
-	   ";; Desktop file format version " (format "%d" desktop-io-file-version) "\n"
-	   ";; Emacs version " emacs-version "\n")
-	  (save-excursion (run-hooks 'desktop-save-hook))
-	  (goto-char (point-max))
-	  (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-frameset)
-	  (unless (memq 'desktop-saved-frameset desktop-globals-to-save)
-	    (desktop-outvar 'desktop-saved-frameset))
-	  (mapc #'desktop-outvar 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 "
-	     (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
-	     " kill-ring))\n"))
-
-	  (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
-	  (dolist (l (mapcar #'desktop-buffer-info (buffer-list)))
-	    (let ((base (pop l)))
-	      (when (apply #'desktop-save-buffer-p l)
-		(insert "("
-			(if (or (not (integerp eager))
-				(if (zerop eager)
-				    nil
-				  (setq eager (1- eager))))
-			    "desktop-create-buffer"
-			  "desktop-append-buffer-args")
-			" "
-			(format "%d" desktop-io-file-version))
-		;; If there's a non-empty base name, we save it instead of the buffer name
-		(when (and base (not (string= base "")))
-		  (setcar (nthcdr 1 l) base))
-		(dolist (e l)
-		  (insert "\n  " (desktop-value-to-string e)))
-		(insert ")\n\n"))))
-
-	  (setq default-directory desktop-dirname)
-	  ;; When auto-saving, avoid writing if nothing has changed since the last write.
-	  (let* ((beg (and only-if-changed
-			   (save-excursion
-			     (goto-char (point-min))
-			     ;; Don't check the header with changing timestamp
-			     (and (search-forward "Global section" nil t)
-				  ;; Also skip the timestamp in desktop-saved-frameset
-				  ;; if it's saved in the first non-header line
-				  (search-forward "desktop-saved-frameset"
-						  (line-beginning-position 3) t)
-				  ;; This is saved after the timestamp
-				  (search-forward (format "%S" desktop--app-id) nil t))
-			     (point))))
-		 (checksum (and beg (md5 (current-buffer) beg (point-max) 'utf-8-emacs))))
-	    (unless (and checksum (equal checksum desktop-file-checksum))
-	      (let ((coding-system-for-write 'utf-8-emacs))
-		(write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
-	      (setq desktop-file-checksum checksum)
-	      ;; We remember when it was modified (which is presumably just now).
-	      (desktop--get-file-modtime))))))))
+          (let ((desktop-buffer-count 0) global-pos)
+            (insert
+	     ";; -*- mode: emacs-lisp; lexical-binding:t; coding: utf-8-emacs; -*-\n"
+	     desktop-header
+	     ";; Created " (current-time-string) "\n"
+	     ";; Desktop file format version " (format "%d" desktop-io-file-version) "\n"
+	     ";; Emacs version " emacs-version "\n")
+	    (save-excursion (run-hooks 'desktop-save-hook))
+	    (goto-char (point-max))
+	    (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-frameset)
+            (setq global-pos (point)) ; Don't write the global section
+                                        ; till we've counted the buffers.
+
+	    (insert "\n;; Buffer section -- buffers listed in same order as in buffer list:\n")
+	    (dolist (l (mapcar #'desktop-buffer-info (buffer-list)))
+	      (let ((base (pop l)))
+	        (when (apply #'desktop-save-buffer-p l)
+                  (setq desktop-buffer-count (1+ desktop-buffer-count))
+		  (insert "("
+			  (if (or (not (integerp eager))
+				  (if (zerop eager)
+				      nil
+				    (setq eager (1- eager))))
+			      "desktop-create-buffer"
+			    "desktop-append-buffer-args")
+			  " "
+			  (format "%d" desktop-io-file-version))
+		  ;; If there's a non-empty base name, we save it instead of the buffer name
+		  (when (and base (not (string= base "")))
+		    (setcar (nthcdr 1 l) base))
+		  (dolist (e l)
+		    (insert "\n  " (desktop-value-to-string e)))
+		  (insert ")\n\n"))))
+
+            (goto-char global-pos)
+	    (unless (memq 'desktop-saved-frameset desktop-globals-to-save)
+	      (desktop-outvar 'desktop-saved-frameset))
+            (unless (memq 'desktop-buffer-count desktop-globals-to-save)
+              (desktop-outvar 'desktop-buffer-count))
+	    (mapc #'desktop-outvar 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 "
+	       (int-to-string (- (length kill-ring) (length kill-ring-yank-pointer)))
+	       " kill-ring))\n"))
+
+	    (setq default-directory desktop-dirname)
+	    ;; When auto-saving, avoid writing if nothing has changed since the last write.
+	    (let* ((beg (and only-if-changed
+			     (save-excursion
+			       (goto-char (point-min))
+			       ;; Don't check the header with changing timestamp
+			       (and (search-forward "Global section" nil t)
+				    ;; Also skip the timestamp in desktop-saved-frameset
+				    ;; if it's saved in the first non-header line
+				    (search-forward "desktop-saved-frameset"
+						    (line-beginning-position 3) t)
+				    ;; This is saved after the timestamp
+				    (search-forward (format "%S" desktop--app-id) nil t))
+			       (point))))
+		   (checksum (and beg (md5 (current-buffer) beg (point-max) 'utf-8-emacs))))
+	      (unless (and checksum (equal checksum desktop-file-checksum))
+	        (let ((coding-system-for-write 'utf-8-emacs))
+		  (write-region (point-min) (point-max) (desktop-full-file-name) nil 'nomessage))
+	        (setq desktop-file-checksum checksum)
+	        ;; We remember when it was modified (which is presumably just now).
+	        (desktop--get-file-modtime)))))))))
 
 ;; ----------------------------------------------------------------------------
 ;;;###autoload
@@ -1293,6 +1310,36 @@ desktop-first-buffer
 (defvar desktop-buffer-ok-count)
 (defvar desktop-buffer-fail-count)
 
+(defun desktop-progress-message (buffer-name &optional success)
+  "Display a message about the buffer being restored by desktop.
+BUFFER-NAME, a string, is the name of the buffer.  SUCCESS is
+nil (absent) when we haven't yet restored the buffer, `t' when
+the buffer has been successfully restored, `fail' otherwise."
+  (message "") ; Make sure we have just one line in the echo area.
+  (if (boundp 'desktop-buffer-ok-count)
+      ;; in the "normal" restoration.
+      (when (not success)
+        (message
+         "Desktop opening %-30s (%s remaining)"
+         buffer-name
+         (if desktop-buffer-count
+             (- desktop-buffer-count
+                desktop-buffer-ok-count
+                desktop-buffer-fail-count 1)
+           "???")))
+    ;; In lazy restoration.
+    (message
+     "Desktop lazily opening %s%s"
+     buffer-name
+     (if (boundp 'desktop-buffer-args-list)
+         (format " (%s remaining)...%s"
+                 (length desktop-buffer-args-list)
+                 (cond
+                  ((null success) "")
+                  ((eq success t) "done")
+                  (t "failed")))
+       ""))))
+
 ;;;###autoload
 (defun desktop-read (&optional dirname ask)
   "Read and process the desktop file in directory DIRNAME.
@@ -1358,11 +1405,19 @@ desktop-read
                         ;; buffer-local, and puts there stuff which
                         ;; doesn't include our timer.
                         (default-value
-                          'window-configuration-change-hook)))
+                         'window-configuration-change-hook)))
 	    (desktop-auto-save-disable)
 	    ;; Evaluate desktop buffer and remember when it was modified.
 	    (desktop--get-file-modtime)
+            ;; Enable progress reporting.....
+            (when desktop-echo-progress
+              (add-hook 'desktop-open-buffer-functions
+                        'desktop-progress-message))
 	    (load (desktop-full-file-name) t t t)
+            ;; .... and disable it again.
+            (when desktop-echo-progress
+              (remove-hook 'desktop-open-buffer-functions
+                           'desktop-progress-message))
 	    ;; If it wasn't already, mark it as in-use, to bother other
 	    ;; desktop instances.
 	    (unless (eq (emacs-pid) owner)
@@ -1398,6 +1453,7 @@ desktop-read
 			 (format ", %d to restore lazily"
 				 (length desktop-buffer-args-list))
 		       ""))
+            (sit-for 3)
 	    (unless (desktop-restoring-frameset-p)
 	      ;; Bury the *Messages* buffer to not reshow it when burying
 	      ;; the buffer we switched to above.
@@ -1544,6 +1600,16 @@ desktop-load-file
           (with-demoted-errors "Require error in desktop-load-file: %S"
               (require (intern (match-string 1 name)) nil t))))))
 
+(defvar desktop-open-buffer-functions nil
+  "Abnormal hook called before and after creating a buffer's file in desktop.
+When called before creating the buffer, it is given one argument,
+the name of the buffer being restored.  When called after
+attempting to create the buffer, it is additionally given a
+second argument with value `t' when the creation was successful,
+`fail' otherwise.
+
+It's return value has no significance.")
+
 ;; ----------------------------------------------------------------------------
 ;; Create a buffer, load its file, set its mode, ...;
 ;; called from Desktop file only.
@@ -1575,6 +1641,7 @@ desktop-create-buffer
 	(desktop-buffer-read-only   buffer-readonly)
 	(desktop-buffer-misc	    buffer-misc)
 	(desktop-buffer-locals	    buffer-locals))
+    (run-hook-with-args 'desktop-open-buffer-functions desktop-buffer-name)
     ;; To make desktop files with relative file names possible, we cannot
     ;; allow `default-directory' to change. Therefore we save current buffer.
     (save-current-buffer
@@ -1595,9 +1662,15 @@ desktop-create-buffer
 			 (error-message-string err))
 		(when desktop-missing-file-warning (sit-for 1))
 		nil))))
-	(if (bufferp result)
-	    (setq desktop-buffer-ok-count (1+ desktop-buffer-ok-count))
-	  (setq desktop-buffer-fail-count (1+ desktop-buffer-fail-count))
+        (run-hook-with-args 'desktop-open-buffer-functions
+                            desktop-buffer-name
+                            (if (bufferp result) t 'fail))
+
+        (if (bufferp result)
+	    (when (boundp 'desktop-buffer-ok-count)
+              (setq desktop-buffer-ok-count (1+ desktop-buffer-ok-count)))
+          (when (boundp 'desktop-buffer-fail-count)
+	    (setq desktop-buffer-fail-count (1+ desktop-buffer-fail-count)))
 	  (setq result nil))
 	;; Restore buffer list order with new buffer at end. Don't change
 	;; the order for old desktop files (old desktop module behavior).
@@ -1698,22 +1771,18 @@ desktop-append-buffer-args
 (defun desktop-lazy-create-buffer ()
   "Pop args from `desktop-buffer-args-list', create buffer and bury it."
   (when desktop-buffer-args-list
-    (let* ((remaining (length desktop-buffer-args-list))
-           (args (pop desktop-buffer-args-list))
-           (buffer-name (nth 2 args))
-           (msg (format "Desktop lazily opening %s (%s remaining)..."
-                            buffer-name remaining)))
+    (let* ((args (pop desktop-buffer-args-list))
+           (buffer-name (nth 2 args)))
       (when desktop-lazy-verbose
-        (message "%s" msg))
-      (let ((desktop-first-buffer nil)
-            (desktop-buffer-ok-count 0)
-            (desktop-buffer-fail-count 0))
+        (add-hook 'desktop-open-buffer-functions 'desktop-progress-message))
+      (let* ((desktop-first-buffer nil))
         (apply #'desktop-create-buffer args)
+        (when desktop-lazy-verbose
+          (remove-hook 'desktop-open-buffer-functions
+                       'desktop-progress-message))
         (run-hooks 'desktop-delay-hook)
         (setq desktop-delay-hook nil)
-        (bury-buffer (get-buffer buffer-name))
-        (when desktop-lazy-verbose
-          (message "%s%s" msg (if (> desktop-buffer-ok-count 0) "done" "failed")))))))
+        (bury-buffer (get-buffer buffer-name))))))
 
 (defun desktop-idle-create-buffers ()
   "Create buffers until the user does something, then stop.



-- 
Alan Mackenzie (Nuremberg, Germany).