[Emacs-diffs] master 1fabab6: Ensure early startup warnings are visible at the end. (Bug#20792)

[Glenn Morris]

branch: master
commit 1fabab62f841c67037c3fb27697ce18177c3d4a9
Author: Glenn Morris <address@hidden>
Commit: Glenn Morris <address@hidden>

    Ensure early startup warnings are visible at the end.  (Bug#20792)
    
    * lisp/emacs-lisp/warnings.el (display-warning):
    If startup isn't complete, delay the warning.
    
    * lisp/startup.el (normal-top-level, command-line):
    Let display-warning automatically handle the needed delays.
    Run delayed-warnings-hook.
---
 lisp/emacs-lisp/warnings.el |  166 ++++++++++++++++++++++---------------------
 lisp/startup.el             |   32 ++++-----
 2 files changed, 99 insertions(+), 99 deletions(-)

diff --git a/lisp/emacs-lisp/warnings.el b/lisp/emacs-lisp/warnings.el
index 3ab4026..44a9876 100644
--- a/lisp/emacs-lisp/warnings.el
+++ b/lisp/emacs-lisp/warnings.el
@@ -224,87 +224,91 @@ See the `warnings' custom group for user customization 
features.
 
 See also `warning-series', `warning-prefix-function' and
 `warning-fill-prefix' for additional programming features."
-  (unless level
-    (setq level :warning))
-  (unless buffer-name
-    (setq buffer-name "*Warnings*"))
-  (if (assq level warning-level-aliases)
-      (setq level (cdr (assq level warning-level-aliases))))
-  (or (< (warning-numeric-level level)
-         (warning-numeric-level warning-minimum-log-level))
-      (warning-suppress-p type warning-suppress-log-types)
-      (let* ((typename (if (consp type) (car type) type))
-             (old (get-buffer buffer-name))
-            (buffer (or old (get-buffer-create buffer-name)))
-            (level-info (assq level warning-levels))
-            start end)
-       (with-current-buffer buffer
-          ;; If we created the buffer, disable undo.
-          (unless old
-            (special-mode)
-            (setq buffer-read-only t)
-            (setq buffer-undo-list t))
-         (goto-char (point-max))
-         (when (and warning-series (symbolp warning-series))
-           (setq warning-series
-                 (prog1 (point-marker)
-                   (unless (eq warning-series t)
-                     (funcall warning-series)))))
-          (let ((inhibit-read-only t))
-           (unless (bolp)
-             (newline))
-           (setq start (point))
-           (if warning-prefix-function
-               (setq level-info (funcall warning-prefix-function
-                                         level level-info)))
-           (insert (format (nth 1 level-info)
-                           (format warning-type-format typename))
-                   message)
-           (newline)
-           (when (and warning-fill-prefix (not (string-match "\n" message)))
-             (let ((fill-prefix warning-fill-prefix)
-                   (fill-column 78))
-               (fill-region start (point))))
-           (setq end (point)))
-         (when (and (markerp warning-series)
-                    (eq (marker-buffer warning-series) buffer))
-           (goto-char warning-series)))
-       (if (nth 2 level-info)
-           (funcall (nth 2 level-info)))
-       (cond (noninteractive
-              ;; Noninteractively, take the text we inserted
-              ;; in the warnings buffer and print it.
-              ;; Do this unconditionally, since there is no way
-              ;; to view logged messages unless we output them.
-              (with-current-buffer buffer
-                (save-excursion
-                  ;; Don't include the final newline in the arg
-                  ;; to `message', because it adds a newline.
-                  (goto-char end)
-                  (if (bolp)
-                      (forward-char -1))
-                  (message "%s" (buffer-substring start (point))))))
-             ((and (daemonp) (null after-init-time))
-              ;; Warnings assigned during daemon initialization go into
-              ;; the messages buffer.
-              (message "%s"
-                       (with-current-buffer buffer
-                         (save-excursion
-                           (goto-char end)
-                           (if (bolp)
-                               (forward-char -1))
-                           (buffer-substring start (point))))))
-             (t
-              ;; Interactively, decide whether the warning merits
-              ;; immediate display.
-              (or (< (warning-numeric-level level)
-                     (warning-numeric-level warning-minimum-level))
-                  (warning-suppress-p type warning-suppress-types)
-                  (let ((window (display-buffer buffer)))
-                    (when (and (markerp warning-series)
-                               (eq (marker-buffer warning-series) buffer))
-                      (set-window-start window warning-series))
-                    (sit-for 0))))))))
+  (if (not (or after-init-time noninteractive (daemonp)))
+      ;; Ensure warnings that happen early in the startup sequence
+      ;; are visible when startup completes (bug#20792).
+      (delay-warning type message level buffer-name)
+    (unless level
+      (setq level :warning))
+    (unless buffer-name
+      (setq buffer-name "*Warnings*"))
+    (if (assq level warning-level-aliases)
+       (setq level (cdr (assq level warning-level-aliases))))
+    (or (< (warning-numeric-level level)
+          (warning-numeric-level warning-minimum-log-level))
+       (warning-suppress-p type warning-suppress-log-types)
+       (let* ((typename (if (consp type) (car type) type))
+              (old (get-buffer buffer-name))
+              (buffer (or old (get-buffer-create buffer-name)))
+              (level-info (assq level warning-levels))
+              start end)
+         (with-current-buffer buffer
+           ;; If we created the buffer, disable undo.
+           (unless old
+             (special-mode)
+             (setq buffer-read-only t)
+             (setq buffer-undo-list t))
+           (goto-char (point-max))
+           (when (and warning-series (symbolp warning-series))
+             (setq warning-series
+                   (prog1 (point-marker)
+                     (unless (eq warning-series t)
+                       (funcall warning-series)))))
+           (let ((inhibit-read-only t))
+             (unless (bolp)
+               (newline))
+             (setq start (point))
+             (if warning-prefix-function
+                 (setq level-info (funcall warning-prefix-function
+                                           level level-info)))
+             (insert (format (nth 1 level-info)
+                             (format warning-type-format typename))
+                     message)
+             (newline)
+             (when (and warning-fill-prefix (not (string-match "\n" message)))
+               (let ((fill-prefix warning-fill-prefix)
+                     (fill-column 78))
+                 (fill-region start (point))))
+             (setq end (point)))
+           (when (and (markerp warning-series)
+                      (eq (marker-buffer warning-series) buffer))
+             (goto-char warning-series)))
+         (if (nth 2 level-info)
+             (funcall (nth 2 level-info)))
+         (cond (noninteractive
+                ;; Noninteractively, take the text we inserted
+                ;; in the warnings buffer and print it.
+                ;; Do this unconditionally, since there is no way
+                ;; to view logged messages unless we output them.
+                (with-current-buffer buffer
+                  (save-excursion
+                    ;; Don't include the final newline in the arg
+                    ;; to `message', because it adds a newline.
+                    (goto-char end)
+                    (if (bolp)
+                        (forward-char -1))
+                    (message "%s" (buffer-substring start (point))))))
+               ((and (daemonp) (null after-init-time))
+                ;; Warnings assigned during daemon initialization go into
+                ;; the messages buffer.
+                (message "%s"
+                         (with-current-buffer buffer
+                           (save-excursion
+                             (goto-char end)
+                             (if (bolp)
+                                 (forward-char -1))
+                             (buffer-substring start (point))))))
+               (t
+                ;; Interactively, decide whether the warning merits
+                ;; immediate display.
+                (or (< (warning-numeric-level level)
+                       (warning-numeric-level warning-minimum-level))
+                    (warning-suppress-p type warning-suppress-types)
+                    (let ((window (display-buffer buffer)))
+                      (when (and (markerp warning-series)
+                                 (eq (marker-buffer warning-series) buffer))
+                        (set-window-start window warning-series))
+                      (sit-for 0)))))))))
 
 ;; Use \\<special-mode-map> so that help-enable-auto-load can do its thing.
 ;; Any keymap that is defined will do.
diff --git a/lisp/startup.el b/lisp/startup.el
index ec222b3..b389648 100644
--- a/lisp/startup.el
+++ b/lisp/startup.el
@@ -612,7 +612,7 @@ It is the default value of the variable `top-level'."
                        charset-map-path))))
     (if default-directory
        (setq default-directory (abbreviate-file-name default-directory))
-      (delay-warning 'initialization "Error setting default-directory"))
+      (display-warning 'initialization "Error setting default-directory"))
     (let ((old-face-font-rescale-alist face-font-rescale-alist))
       (unwind-protect
          (command-line)
@@ -1167,25 +1167,18 @@ please check its value")
                (funcall inner)
                (setq init-file-had-error nil))
            (error
-            ;; Postpone displaying the warning until all hooks
-            ;; in `after-init-hook' like `desktop-read' will finalize
-            ;; possible changes in the window configuration.
-            (add-hook
-             'after-init-hook
-             (lambda ()
-               (display-warning
-                'initialization
-                (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\
+            (display-warning
+             'initialization
+             (format "An error occurred while loading `%s':\n\n%s%s%s\n\n\
 To ensure normal operation, you should investigate and remove the
 cause of the error in your initialization file.  Start Emacs with
 the `--debug-init' option to view a complete error backtrace."
-                        user-init-file
-                        (get (car error) 'error-message)
-                        (if (cdr error) ": " "")
-                        (mapconcat (lambda (s) (prin1-to-string s t))
-                                   (cdr error) ", "))
-                :warning))
-             t)
+                     user-init-file
+                     (get (car error) 'error-message)
+                     (if (cdr error) ": " "")
+                     (mapconcat (lambda (s) (prin1-to-string s t))
+                                (cdr error) ", "))
+             :warning)
             (setq init-file-had-error t))))
 
       (if (and deactivate-mark transient-mark-mode)
@@ -1268,7 +1261,10 @@ the `--debug-init' option to view a complete error 
backtrace."
        (package-initialize))
 
   (setq after-init-time (current-time))
-  (run-hooks 'after-init-hook)
+  ;; Display any accumulated warnings after all functions in
+  ;; `after-init-hook' like `desktop-read' have finalized possible
+  ;; changes in the window configuration.
+  (run-hooks 'after-init-hook 'delayed-warnings-hook)
 
   ;; If *scratch* exists and init file didn't change its mode, initialize it.
   (if (get-buffer "*scratch*")