Skip to content

Commit 0e79538

Browse files
doublepdoublep
committed
Reroute display-warning' messages through eldev-warn' or `eldev-error' as appropriate; this affects byte-compilation output.
1 parent 0a46a08 commit 0e79538

File tree

2 files changed

+76
-58
lines changed

2 files changed

+76
-58
lines changed

‎eldev-util.el‎

Lines changed: 18 additions & 6 deletions
Original file line numberDiff line numberDiff line change
@@ -318,6 +318,11 @@ See `eldev-output-reroute-messages'.")
318318
"Rerouted message destination.
319319
Should be either `:stderr' or `:stdout'.")
320320

321+
(defvar eldev-message-rerouting-wrapper nil
322+
"When set, send rerouted message through this function/macro.
323+
Typical values would be `eldev-warn', `eldev-trace' etc. Note
324+
that this overrides `eldev-message-rerouting-destination'.")
325+
321326
(defvar eldev--output-rerouted nil)
322327
(defvar eldev--real-stderr-output nil)
323328

@@ -524,12 +529,19 @@ to `eldev-message-rerouting-destination'. Can be termporarily
524529
disabled by setting `eldev-disable-message-rerouting' inside
525530
BODY."
526531
(declare (indent 0) (debug (body)))
527-
`(eldev-advised (#'message :around (unless (or eldev-disable-message-rerouting eldev--output-rerouted)
528-
(lambda (original &rest args)
529-
(unless (and (boundp 'inhibit-message) inhibit-message)
530-
(if eldev--real-stderr-output
531-
(apply original args)
532-
(apply #'eldev-output (or eldev-message-rerouting-destination :stderr) args))))))
532+
`(eldev-advised (#'message :around
533+
(unless (or eldev-disable-message-rerouting eldev--output-rerouted)
534+
(lambda (original &rest args)
535+
(unless (and (boundp 'inhibit-message) inhibit-message)
536+
(cond (eldev--real-stderr-output
537+
(apply original args))
538+
(eldev-message-rerouting-wrapper
539+
(if (functionp eldev-message-rerouting-wrapper)
540+
(apply eldev-message-rerouting-wrapper args)
541+
;; Assume a macro (`eldev-warn' or something like that).
542+
(eval `(,eldev-message-rerouting-wrapper ,@args) t)))
543+
(t
544+
(apply #'eldev-output (or eldev-message-rerouting-destination :stderr) args)))))))
533545
,@body))
534546

535547

‎eldev.el‎

Lines changed: 58 additions & 52 deletions
Original file line numberDiff line numberDiff line change
@@ -585,58 +585,64 @@ Used by Eldev startup script."
585585
(condition-case-unless-debug error
586586
(condition-case error
587587
(eldev-output-reroute-messages
588-
(let ((eldev-project-dir (or eldev-project-dir (expand-file-name default-directory)))
589-
;; Eldev uses a different default.
590-
(load-prefer-newer t))
591-
;; If `inhibit-message' is t when a signal is raised, Emacs won't
592-
;; print error stacktraces even if `debug-on-error' is t. Add a
593-
;; workaround.
594-
(eldev-advised (#'debug :around (lambda (original &rest arguments)
595-
(let ((inhibit-message nil))
596-
(apply original arguments))))
597-
(eldev-parse-options command-line nil t t)
598-
;; Since this is printed before `~/.eldev/config' is loaded it can
599-
;; ignore some settings from that file, e.g. colorizing mode.
600-
(eldev-trace "Started up on %s" (replace-regexp-in-string " +" " " (current-time-string)))
601-
(eldev-trace "Running on %s" (emacs-version))
602-
(eldev-trace "Project directory: `%s'" eldev-project-dir)
603-
(condition-case error
604-
(eldev--set-up)
605-
(eldev-too-old (setf eldev-too-old (cdr error))))
606-
(setf command-line (eldev-parse-options command-line nil t))
607-
(if command-line
608-
(progn
609-
(setf command (intern (car command-line)))
610-
(let* ((real-command (or (cdr (assq command eldev--command-aliases)) command))
611-
(handler (or (cdr (assq real-command eldev--commands)))))
612-
(if handler
613-
(let ((hook (eldev-get handler :command-hook)))
614-
(when (and eldev-too-old (not (eldev-get handler :works-on-old-eldev)))
615-
(signal 'eldev-too-old eldev-too-old))
616-
(setf command-line (if (eldev-get handler :custom-parsing)
617-
(cdr command-line)
618-
(eldev-parse-options (cdr command-line) real-command)))
619-
(if (eq real-command command)
620-
(eldev-verbose "Executing command `%s'..." command)
621-
(eldev-verbose "Executing command `%s' (alias for `%s')..." command real-command))
622-
(when eldev-executing-command-hook
623-
(eldev-trace "Executing `eldev-executing-command-hook'...")
624-
(run-hook-with-args 'eldev-executing-command-hook real-command))
625-
(when (symbol-value hook)
626-
(eldev-trace "Executing `%s'..." hook)
627-
(run-hooks hook))
628-
;; We want `message' output on stdout universally, but
629-
;; older Emacses are very verbose and having additional
630-
;; unexpected messages in our stdout would screw up
631-
;; tests. So we set the target to stdout only now.
632-
(let ((eldev-message-rerouting-destination :stdout))
633-
(apply handler command-line))
634-
(setf exit-code 0))
635-
(eldev-error "Unknown command `%s'" command)
636-
(eldev-print "Run `%s help' for a list of supported commands" (eldev-shell-command t)))))
637-
(eldev-usage)
638-
(eldev-print "Run `%s help' for more information" (eldev-shell-command t))
639-
(setf exit-code 0)))))
588+
(eldev-advised (#'display-warning :around (lambda (original type message &optional level &rest args)
589+
(let ((eldev-message-rerouting-wrapper (pcase level
590+
(:error #'eldev-error)
591+
(:debug #'eldev-verbose)
592+
(_ #'eldev-warn))))
593+
(apply original type message level args))))
594+
(let ((eldev-project-dir (or eldev-project-dir (expand-file-name default-directory)))
595+
;; Eldev uses a different default.
596+
(load-prefer-newer t))
597+
;; If `inhibit-message' is t when a signal is raised, Emacs won't
598+
;; print error stacktraces even if `debug-on-error' is t. Add a
599+
;; workaround.
600+
(eldev-advised (#'debug :around (lambda (original &rest arguments)
601+
(let ((inhibit-message nil))
602+
(apply original arguments))))
603+
(eldev-parse-options command-line nil t t)
604+
;; Since this is printed before `~/.eldev/config' is loaded it can
605+
;; ignore some settings from that file, e.g. colorizing mode.
606+
(eldev-trace "Started up on %s" (replace-regexp-in-string " +" " " (current-time-string)))
607+
(eldev-trace "Running on %s" (emacs-version))
608+
(eldev-trace "Project directory: `%s'" eldev-project-dir)
609+
(condition-case error
610+
(eldev--set-up)
611+
(eldev-too-old (setf eldev-too-old (cdr error))))
612+
(setf command-line (eldev-parse-options command-line nil t))
613+
(if command-line
614+
(progn
615+
(setf command (intern (car command-line)))
616+
(let* ((real-command (or (cdr (assq command eldev--command-aliases)) command))
617+
(handler (or (cdr (assq real-command eldev--commands)))))
618+
(if handler
619+
(let ((hook (eldev-get handler :command-hook)))
620+
(when (and eldev-too-old (not (eldev-get handler :works-on-old-eldev)))
621+
(signal 'eldev-too-old eldev-too-old))
622+
(setf command-line (if (eldev-get handler :custom-parsing)
623+
(cdr command-line)
624+
(eldev-parse-options (cdr command-line) real-command)))
625+
(if (eq real-command command)
626+
(eldev-verbose "Executing command `%s'..." command)
627+
(eldev-verbose "Executing command `%s' (alias for `%s')..." command real-command))
628+
(when eldev-executing-command-hook
629+
(eldev-trace "Executing `eldev-executing-command-hook'...")
630+
(run-hook-with-args 'eldev-executing-command-hook real-command))
631+
(when (symbol-value hook)
632+
(eldev-trace "Executing `%s'..." hook)
633+
(run-hooks hook))
634+
;; We want `message' output on stdout universally, but
635+
;; older Emacses are very verbose and having additional
636+
;; unexpected messages in our stdout would screw up
637+
;; tests. So we set the target to stdout only now.
638+
(let ((eldev-message-rerouting-destination :stdout))
639+
(apply handler command-line))
640+
(setf exit-code 0))
641+
(eldev-error "Unknown command `%s'" command)
642+
(eldev-print "Run `%s help' for a list of supported commands" (eldev-shell-command t)))))
643+
(eldev-usage)
644+
(eldev-print "Run `%s help' for more information" (eldev-shell-command t))
645+
(setf exit-code 0))))))
640646
(eldev-error (let* ((arguments (cdr error))
641647
hint
642648
hint-about-command)

0 commit comments

Comments
 (0)