From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: Alan Mackenzie Newsgroups: gmane.emacs.bugs Subject: bug#58634: Long delay with blank screen whilst loading desktop at emacs startup Date: Sun, 23 Oct 2022 15:22:05 +0000 Message-ID: References: <83zgdpuq3b.fsf@gnu.org> <83r0z1uju2.fsf@gnu.org> <83lep9ugyi.fsf@gnu.org> <83h6zwv0ft.fsf@gnu.org> <83tu3wt34l.fsf@gnu.org> Mime-Version: 1.0 Content-Type: text/plain; charset=us-ascii Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="18183"; mail-complaints-to="usenet@ciao.gmane.io" Cc: acm@muc.de, 58634@debbugs.gnu.org, juri@linkov.net To: Eli Zaretskii Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Oct 24 08:28:05 2022 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1omqwM-0004TD-9v for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 24 Oct 2022 08:28:02 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1ommqh-00022a-2w for geb-bug-gnu-emacs@m.gmane-mx.org; Sun, 23 Oct 2022 22:05:55 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1omcoY-0004xY-JO for bug-gnu-emacs@gnu.org; Sun, 23 Oct 2022 11:23:08 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1omcoY-0002HI-C0 for bug-gnu-emacs@gnu.org; Sun, 23 Oct 2022 11:23:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1omcoY-0004YO-5j for bug-gnu-emacs@gnu.org; Sun, 23 Oct 2022 11:23:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: Alan Mackenzie Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Sun, 23 Oct 2022 15:23:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 58634 X-GNU-PR-Package: emacs Original-Received: via spool by 58634-submit@debbugs.gnu.org id=B58634.166653853717439 (code B ref 58634); Sun, 23 Oct 2022 15:23:02 +0000 Original-Received: (at 58634) by debbugs.gnu.org; 23 Oct 2022 15:22:17 +0000 Original-Received: from localhost ([127.0.0.1]:46365 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1omcno-0004XC-No for submit@debbugs.gnu.org; Sun, 23 Oct 2022 11:22:17 -0400 Original-Received: from mx3.muc.de ([193.149.48.5]:47772) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1omcnk-0004Wv-7W for 58634@debbugs.gnu.org; Sun, 23 Oct 2022 11:22:15 -0400 Original-Received: (qmail 30944 invoked by uid 3782); 23 Oct 2022 17:22:06 +0200 Original-Received: from acm.muc.de (p2e5d5154.dip0.t-ipconnect.de [46.93.81.84]) (using STARTTLS) by colin.muc.de (tmda-ofmipd) with ESMTP; Sun, 23 Oct 2022 17:22:05 +0200 Original-Received: (qmail 28109 invoked by uid 1000); 23 Oct 2022 15:22:05 -0000 Content-Disposition: inline In-Reply-To: <83tu3wt34l.fsf@gnu.org> X-Submission-Agent: TMDA/1.3.x (Ph3nix) X-Primary-Address: acm@muc.de X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: "bug-gnu-emacs" Xref: news.gmane.io gmane.emacs.bugs:246093 Archived-At: 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 > > 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 > > > > > 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).