mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2025-01-05 11:45:45 +00:00
Code Issues Releases Activity

Ensure early startup warnings are visible at the end. (Bug#20792)

Browse Source 
* 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.
This commit is contained in:
Glenn Morris 2015-06-12 19:26:21 -07:00
parent 147c3915a5
commit 1fabab62f8
2 changed files with 99 additions and 99 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

166
lisp/emacs-lisp/warnings.el
View File

@ -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.

32
lisp/startup.el
View File

@ -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*")