refactor(cli,lib): print levels & output redirection
This refactors how Doom captures and redirects its output (to stdout and stderr) into a more general with-output-to! macro, and: - Simplifies the "print level" system. The various doom-print-*-level variables have been removed. - Adds a new print level: notice, which will be the default level for all standard output (from print!, doom-print, prin[ct1], etc). - Adds a with-output-to! macro for capturing and redirecting output to multiple streams (without suppressing it from stdout). It can also be nested. - Changes the following about doom-print: - Default :format changed to nil (was t) - Default :level changed to t (was `doom-print-level`) - No longer no-ops if OUTPUT is only whitespace
This commit is contained in:
Henrik Lissner
parent
6cac7b05b6
commit
b7bd27d22b
4 changed files with 226 additions and 170 deletions
6
bin/doom
6
bin/doom
|
|
@ -169,7 +169,8 @@ SEE ALSO:
|
|||
|
||||
(defcli! :before
|
||||
((force? ("-!" "--force") "Suppress prompts by auto-accepting their consequences")
|
||||
(debug? ("-D" "--debug") "Enable verbose output")
|
||||
(debug? ("-D" "--debug") "Enable debug output")
|
||||
(verbose? ("-v" "--verbose") "Enable verbose output")
|
||||
(doomdir ("--doomdir" dir) "Use Doom config living in `DIR' (e.g. ~/.doom.d)")
|
||||
(emacsdir ("--emacsdir" dir) "Use Doom install living in `DIR' (e.g. ~/.emacs.d)")
|
||||
(pager ("--pager" cmd) "Pager command to use for large output")
|
||||
|
|
@ -196,6 +197,9 @@ SEE ALSO:
|
|||
.doomrc file in the current project tree."
|
||||
(when bench?
|
||||
(setq doom-cli-benchmark-threshold 'always))
|
||||
(unless init-file-debug ; debug-mode implies verbose
|
||||
(when verbose?
|
||||
(setq doom-print-minimum-level 'info)))
|
||||
(when color?
|
||||
(setq doom-print-backend (if (eq color? :yes) 'ansi)))
|
||||
(when pager
|
||||
|
|
|
|||
|
|
@ -796,7 +796,7 @@ However, in batch mode, print to stdout instead of stderr."
|
|||
(setq msg (match-string 1 msg))))
|
||||
(and (string-match-p "^\\(Cloning\\|\\(Reb\\|B\\)uilding\\) " msg)
|
||||
(not (string-suffix-p "...done" msg))
|
||||
(doom-print (concat "> " msg)))))
|
||||
(doom-print (concat "> " msg) :format t))))
|
||||
|
||||
(defadvice! doom-cli--straight-ignore-gitconfig-a (fn &rest args)
|
||||
"Prevent user and system git configuration from interfering with git calls."
|
||||
|
|
|
|||
237
lisp/doom-cli.el
237
lisp/doom-cli.el
|
|
@ -1064,6 +1064,18 @@ considered as well."
|
|||
(path backtrace-file))))))))
|
||||
(exit! 255)))
|
||||
|
||||
(defmacro doom-cli-redirect-output (context &rest body)
|
||||
"Redirect output from BODY to the appropriate log buffers in CONTEXT."
|
||||
(declare (indent 1))
|
||||
(let ((contextsym (make-symbol "doomctxt")))
|
||||
`(let* ((,contextsym ,context)
|
||||
;; Emit more user-friendly backtraces
|
||||
(debugger (doom-rpartial #'doom-cli-debugger ,contextsym))
|
||||
(debug-on-error t))
|
||||
(with-output-to! `((>= notice ,(doom-cli-context-stdout ,contextsym))
|
||||
(t . ,(doom-cli-context-stderr ,contextsym)))
|
||||
,@body))))
|
||||
|
||||
(defun doom-cli--output-file (type context)
|
||||
"Return a log file path for TYPE and CONTEXT.
|
||||
|
||||
|
|
@ -1073,15 +1085,6 @@ See `doom-cli-log-file-format' for details."
|
|||
(doom-cli-context-sid context)
|
||||
type))
|
||||
|
||||
(defun doom-cli--output (out &optional context)
|
||||
"A `standard-output' function which mirrors output to log buffers."
|
||||
(let ((str (char-to-string out)))
|
||||
(dolist (buffer (list (doom-cli-context-stdout context)
|
||||
(doom-cli-context-stderr context)))
|
||||
(when (bufferp buffer)
|
||||
(princ str buffer)))
|
||||
(send-string-to-terminal str)))
|
||||
|
||||
(defun doom-cli--output-write-logs-h (context)
|
||||
"Write all log buffers to their appropriate files."
|
||||
(when (/= doom-cli--exit-code 254)
|
||||
|
|
@ -1109,39 +1112,28 @@ Will also output it to stdout if requested (CLI sets :benchmark to t) or the
|
|||
command takes >5s to run. If :benchmark is explicitly set to nil (or
|
||||
`doom-cli-benchmark-threshold' is nil), under no condition should a benchmark be
|
||||
shown."
|
||||
(doom-log "cli: %s (GCs: %d, elapsed: %.6fs)"
|
||||
(if (= doom-cli--exit-code 254) "Restarted" "Finished")
|
||||
gcs-done gc-elapsed)
|
||||
(when-let* ((init-time (doom-cli-context-init-time context))
|
||||
(cli (doom-cli-get context))
|
||||
(duration (float-time (time-subtract (current-time) init-time)))
|
||||
(hours (/ (truncate duration) 60 60))
|
||||
(minutes (- (/ (truncate duration) 60) (* hours 60)))
|
||||
(seconds (- duration (* hours 60 60) (* minutes 60)))
|
||||
(standard-output (doom-rpartial #'doom-cli--output context)))
|
||||
(when (and (/= doom-cli--exit-code 254)
|
||||
(or (eq (doom-cli-prop cli :benchmark) t)
|
||||
(eq doom-cli-benchmark-threshold 'always)
|
||||
(and (eq (doom-cli-prop cli :benchmark :null) :null)
|
||||
(not (doom-cli-context-pipe-p context 'out t))
|
||||
(> duration (or doom-cli-benchmark-threshold
|
||||
most-positive-fixnum)))))
|
||||
(print! (success "Finished in %s")
|
||||
(join (list (unless (zerop hours) (format "%dh" hours))
|
||||
(unless (zerop minutes) (format "%dm" minutes))
|
||||
(format (if (> duration 60) "%ds" "%.5fs")
|
||||
seconds)))))))
|
||||
|
||||
(defun doom-cli--redirect-output-a (context message &rest args)
|
||||
":override advice for `message' to mirror output to log buffers"
|
||||
(when message
|
||||
(let ((output (apply #'doom-print--format message args)))
|
||||
;; One for the terminal, if the log level is high enough.
|
||||
(doom-print output :format nil :level doom-print-message-level :stream t)
|
||||
;; And one for the logs...
|
||||
(when (doom-cli-context-p context)
|
||||
(doom-print output :format nil :stream (doom-cli-context-stderr context) :level t)))
|
||||
message))
|
||||
(doom-cli-redirect-output context
|
||||
(doom-log "cli: %s (GCs: %d, elapsed: %.6fs)"
|
||||
(if (= doom-cli--exit-code 254) "Restarted" "Finished")
|
||||
gcs-done gc-elapsed)
|
||||
(when-let* ((init-time (doom-cli-context-init-time context))
|
||||
(cli (doom-cli-get context))
|
||||
(duration (float-time (time-subtract (current-time) init-time)))
|
||||
(hours (/ (truncate duration) 60 60))
|
||||
(minutes (- (/ (truncate duration) 60) (* hours 60)))
|
||||
(seconds (- duration (* hours 60 60) (* minutes 60))))
|
||||
(when (and (/= doom-cli--exit-code 254)
|
||||
(or (eq (doom-cli-prop cli :benchmark) t)
|
||||
(eq doom-cli-benchmark-threshold 'always)
|
||||
(and (eq (doom-cli-prop cli :benchmark :null) :null)
|
||||
(not (doom-cli-context-pipe-p context 'out t))
|
||||
(> duration (or doom-cli-benchmark-threshold
|
||||
most-positive-fixnum)))))
|
||||
(print! (success "Finished in %s")
|
||||
(join (list (unless (zerop hours) (format "%dh" hours))
|
||||
(unless (zerop minutes) (format "%dm" minutes))
|
||||
(format (if (> duration 60) "%ds" "%.5fs")
|
||||
seconds))))))))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -1893,90 +1885,85 @@ Once done, this function kills Emacs gracefully and writes output to log files
|
|||
errors to `doom-cli-error-file')."
|
||||
(when doom-cli--context
|
||||
(error "Cannot nest `run!' calls"))
|
||||
(letf! ((args (flatten-list args))
|
||||
(context (make-doom-cli-context :prefix prefix :whole args))
|
||||
(doom-cli--context context)
|
||||
(write-logs-fn (doom-partial #'doom-cli--output-write-logs-h context))
|
||||
(show-benchmark-fn (doom-partial #'doom-cli--output-benchmark-h context))
|
||||
;; Write more user-friendly backtraces
|
||||
(debugger (doom-rpartial #'doom-cli-debugger context))
|
||||
(debug-on-error t)
|
||||
;; Clone output to stdout/stderr buffers for logging.
|
||||
(standard-output (doom-rpartial #'doom-cli--output context))
|
||||
(#'message (doom-partial #'doom-cli--redirect-output-a context)))
|
||||
(let* ((args (flatten-list args))
|
||||
(context (make-doom-cli-context :prefix prefix :whole args))
|
||||
(doom-cli--context context)
|
||||
(write-logs-fn (doom-partial #'doom-cli--output-write-logs-h context))
|
||||
(show-benchmark-fn (doom-partial #'doom-cli--output-benchmark-h context)))
|
||||
;; Clone output to stdout/stderr buffers for logging.
|
||||
(doom-log "run!: %s %s" prefix (combine-and-quote-strings args))
|
||||
(add-hook 'kill-emacs-hook show-benchmark-fn 94)
|
||||
(add-hook 'kill-emacs-hook write-logs-fn 95)
|
||||
(when (doom-cli-context-pipe-p context :out t)
|
||||
(setq doom-print-backend nil))
|
||||
(when (doom-cli-context-pipe-p context :in)
|
||||
(with-current-buffer (doom-cli-context-stdin context)
|
||||
(while (if-let (in (ignore-errors (read-from-minibuffer "")))
|
||||
(insert in "\n")
|
||||
(ignore-errors (delete-char -1))))))
|
||||
(doom-cli--exit
|
||||
(condition-case e
|
||||
(let* ((args (cons (if (getenv "__DOOMDUMP") :dump prefix) args))
|
||||
(context (doom-cli-context-restore (getenv "__DOOMCONTEXT") context))
|
||||
(context (doom-cli-context-parse args context)))
|
||||
(run-hook-with-args 'doom-cli-before-run-functions context)
|
||||
(let ((result (doom-cli-context-execute context)))
|
||||
(run-hook-with-args 'doom-cli-after-run-functions context result))
|
||||
0)
|
||||
(doom-cli-wrong-number-of-arguments-error
|
||||
(pcase-let ((`(,command ,flag ,args ,min ,max) (cdr e)))
|
||||
(print! (red "Error: %S expected %s argument%s, but got %d")
|
||||
(or flag (doom-cli-command-string
|
||||
(if (keywordp (car command))
|
||||
command
|
||||
(cdr command))))
|
||||
(if (or (= min max)
|
||||
(= max most-positive-fixnum))
|
||||
min
|
||||
(format "%d-%d" min max))
|
||||
(if (or (= min 0) (> min 1)) "s" "")
|
||||
(length args))
|
||||
(doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e))
|
||||
5)
|
||||
(doom-cli-unrecognized-option-error
|
||||
(print! (red "Error: unknown option %s") (cadr e))
|
||||
(doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e)
|
||||
5)
|
||||
(doom-cli-invalid-option-error
|
||||
(pcase-let ((`(,types ,option ,value ,errors) (cdr e)))
|
||||
(print! (red "Error: %s received invalid value %S")
|
||||
(string-join (doom-cli-option-switches option) "/")
|
||||
value)
|
||||
(print! (bold "\nValidation errors:"))
|
||||
(dolist (err errors) (print! (item "%s." (fill err)))))
|
||||
(doom-cli-call `(:help "--postamble" ,@(cdr (doom-cli--command context))) context e)
|
||||
5)
|
||||
(doom-cli-command-not-found-error
|
||||
(let* ((command (cdr e))
|
||||
(cli (doom-cli-get command)))
|
||||
(cond ((null cli)
|
||||
(print! (red "Error: unrecognized command '%s'")
|
||||
(doom-cli-command-string (or (cdr command) command)))
|
||||
(doom-cli-call `(:help "--similar" "--postamble" ,@(cdr command)) context e))
|
||||
((null (doom-cli-fn cli))
|
||||
(print! (red "Error: a subcommand is required"))
|
||||
(doom-cli-call `(:help "--subcommands" "--postamble" ,@(cdr command)) context e))))
|
||||
4)
|
||||
(doom-cli-invalid-prefix-error
|
||||
(let ((prefix (cadr e)))
|
||||
(print! (red "Error: `run!' called with invalid prefix %S") prefix)
|
||||
(if-let (suggested (cl-loop for cli being the hash-value of doom-cli--table
|
||||
unless (doom-cli-type cli)
|
||||
return (car (doom-cli-command cli))))
|
||||
(print! "Did you mean %S?" suggested)
|
||||
(print! "There are no commands defined under %S." prefix)))
|
||||
4)
|
||||
(user-error
|
||||
(print! (red "Error: %s") (cadr e))
|
||||
(print! "\nAborting...")
|
||||
3))
|
||||
context)))
|
||||
(doom-cli-redirect-output context
|
||||
(doom-log "run!: %s %s" prefix (combine-and-quote-strings args))
|
||||
(add-hook 'kill-emacs-hook show-benchmark-fn 94)
|
||||
(add-hook 'kill-emacs-hook write-logs-fn 95)
|
||||
(when (doom-cli-context-pipe-p context :out t)
|
||||
(setq doom-print-backend nil))
|
||||
(when (doom-cli-context-pipe-p context :in)
|
||||
(with-current-buffer (doom-cli-context-stdin context)
|
||||
(while (if-let (in (ignore-errors (read-from-minibuffer "")))
|
||||
(insert in "\n")
|
||||
(ignore-errors (delete-char -1))))))
|
||||
(doom-cli--exit
|
||||
(condition-case e
|
||||
(let* ((args (cons (if (getenv "__DOOMDUMP") :dump prefix) args))
|
||||
(context (doom-cli-context-restore (getenv "__DOOMCONTEXT") context))
|
||||
(context (doom-cli-context-parse args context)))
|
||||
(run-hook-with-args 'doom-cli-before-run-functions context)
|
||||
(let ((result (doom-cli-context-execute context)))
|
||||
(run-hook-with-args 'doom-cli-after-run-functions context result))
|
||||
0)
|
||||
(doom-cli-wrong-number-of-arguments-error
|
||||
(pcase-let ((`(,command ,flag ,args ,min ,max) (cdr e)))
|
||||
(print! (red "Error: %S expected %s argument%s, but got %d")
|
||||
(or flag (doom-cli-command-string
|
||||
(if (keywordp (car command))
|
||||
command
|
||||
(cdr command))))
|
||||
(if (or (= min max)
|
||||
(= max most-positive-fixnum))
|
||||
min
|
||||
(format "%d-%d" min max))
|
||||
(if (or (= min 0) (> min 1)) "s" "")
|
||||
(length args))
|
||||
(doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e))
|
||||
5)
|
||||
(doom-cli-unrecognized-option-error
|
||||
(print! (red "Error: unknown option %s") (cadr e))
|
||||
(doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e)
|
||||
5)
|
||||
(doom-cli-invalid-option-error
|
||||
(pcase-let ((`(,types ,option ,value ,errors) (cdr e)))
|
||||
(print! (red "Error: %s received invalid value %S")
|
||||
(string-join (doom-cli-option-switches option) "/")
|
||||
value)
|
||||
(print! (bold "\nValidation errors:"))
|
||||
(dolist (err errors) (print! (item "%s." (fill err)))))
|
||||
(doom-cli-call `(:help "--postamble" ,@(cdr (doom-cli--command context))) context e)
|
||||
5)
|
||||
(doom-cli-command-not-found-error
|
||||
(let* ((command (cdr e))
|
||||
(cli (doom-cli-get command)))
|
||||
(cond ((null cli)
|
||||
(print! (red "Error: unrecognized command '%s'")
|
||||
(doom-cli-command-string (or (cdr command) command)))
|
||||
(doom-cli-call `(:help "--similar" "--postamble" ,@(cdr command)) context e))
|
||||
((null (doom-cli-fn cli))
|
||||
(print! (red "Error: a subcommand is required"))
|
||||
(doom-cli-call `(:help "--subcommands" "--postamble" ,@(cdr command)) context e))))
|
||||
4)
|
||||
(doom-cli-invalid-prefix-error
|
||||
(let ((prefix (cadr e)))
|
||||
(print! (red "Error: `run!' called with invalid prefix %S") prefix)
|
||||
(if-let (suggested (cl-loop for cli being the hash-value of doom-cli--table
|
||||
unless (doom-cli-type cli)
|
||||
return (car (doom-cli-command cli))))
|
||||
(print! "Did you mean %S?" suggested)
|
||||
(print! "There are no commands defined under %S." prefix)))
|
||||
4)
|
||||
(user-error
|
||||
(print! (red "Error: %s") (cadr e))
|
||||
(print! "\nAborting...")
|
||||
3))
|
||||
context))))
|
||||
|
||||
(defalias 'sh! #'doom-call-process)
|
||||
|
||||
|
|
|
|||
|
|
@ -116,23 +116,20 @@ Any of these classes can be called like functions from within `format!' and
|
|||
|
||||
Accepts `ansi' and `text-properties'. `nil' means don't render styles at all.")
|
||||
|
||||
(defvar doom-print-level 'info
|
||||
"The default level of messages to print.")
|
||||
(defvar doom-print-level 'notice
|
||||
"The current, default logging level.")
|
||||
|
||||
(defvar doom-print-logging-level 'debug
|
||||
"The default logging level used by `doom-log'/`doom-print'.")
|
||||
(defvar doom-print-minimum-level 'notice
|
||||
"The minimum logging level for a message to be output.")
|
||||
|
||||
(defvar doom-print-message-level (if noninteractive 'debug 'info)
|
||||
"The default logging level used by `message'.")
|
||||
|
||||
(defvar doom-print--levels
|
||||
'(debug ; the system is thinking out loud
|
||||
info ; a FYI; to keep you posted
|
||||
warning ; a dismissable issue that may have reprecussions later
|
||||
error)) ; functionality has been disabled/broken by misbehavior
|
||||
|
||||
(dotimes (i (length doom-print--levels))
|
||||
(put (nth i doom-print--levels) 'level i))
|
||||
;; Record print levels in these symbols for easy, quasi-read-only access later.
|
||||
(let ((levels '(debug ; the system is thinking out loud
|
||||
info ; less details about important progress
|
||||
notice ; important details about important progress
|
||||
warning ; a dismissable issue that may have reprecussions later
|
||||
error))) ; something has gone terribly wrong
|
||||
(dotimes (i (length levels))
|
||||
(put (nth i levels) 'print-level i)))
|
||||
|
||||
|
||||
;;
|
||||
|
|
@ -141,52 +138,57 @@ Accepts `ansi' and `text-properties'. `nil' means don't render styles at all.")
|
|||
;;;###autoload
|
||||
(cl-defun doom-print
|
||||
(output &key
|
||||
(format t)
|
||||
(format nil)
|
||||
(level doom-print-level)
|
||||
(newline t)
|
||||
(stream standard-output)
|
||||
(level doom-print-level))
|
||||
(stream standard-output))
|
||||
"Print OUTPUT to stdout.
|
||||
|
||||
Unlike `message', this:
|
||||
- Respects `standard-output'.
|
||||
- Respects `doom-print-indent' (if FORMAT)
|
||||
- Respects the value of `standard-output'.
|
||||
- Indents according to `doom-print-indent' (if FORMAT is non-nil).
|
||||
- Prints to stdout instead of stderr in batch mode.
|
||||
- Respects more ANSI codes (only in batch mode).
|
||||
- Recognizes more terminal escape codes (only in batch mode).
|
||||
- No-ops if OUTPUT is nil or an empty/blank string.
|
||||
|
||||
Returns OUTPUT."
|
||||
(cl-check-type output (or null string))
|
||||
(when (and (stringp output)
|
||||
(not (string-blank-p output))
|
||||
(or (eq level t)
|
||||
(>= (get level 'level)
|
||||
(get doom-print-level 'level))))
|
||||
(let ((output (if format
|
||||
(doom-print--format "%s" output)
|
||||
output)))
|
||||
(princ output stream)
|
||||
(if newline (terpri stream))
|
||||
output)))
|
||||
(if (listp level)
|
||||
(memq doom-print-minimum-level level)
|
||||
(>= (get level 'print-level)
|
||||
(get doom-print-minimum-level 'print-level)))))
|
||||
(when format
|
||||
(setq output (doom-print--format "%s" output)))
|
||||
(princ output stream)
|
||||
(if newline (terpri stream))
|
||||
output))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro format! (message &rest args)
|
||||
"An alternative to `format' that understands (color ...) and converts them
|
||||
into faces or ANSI codes depending on the type of sesssion we're in."
|
||||
"An alternative to `format' that understands `print!'s style syntax."
|
||||
`(doom-print--format ,@(doom-print--apply `(,message ,@args))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group! (&rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
`(print-group-if! t ,@body))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print-group-if! (condition &rest body)
|
||||
"Indents any `print!' or `format!' output within BODY."
|
||||
(declare (indent 1))
|
||||
`(let ((doom-print-indent
|
||||
(+ (if ,condition doom-print-indent-increment 0)
|
||||
doom-print-indent)))
|
||||
,@body))
|
||||
(declare (indent defun))
|
||||
(cl-destructuring-bind (&key if indent level verbose title
|
||||
;; TODO: Implement these
|
||||
_benchmark)
|
||||
(cl-loop for (key val) on body by #'cddr
|
||||
while (keywordp key)
|
||||
collect (pop body)
|
||||
collect (pop body))
|
||||
(if verbose (setq level ''info))
|
||||
`(progn
|
||||
,@(if title `((print! (start ,title))))
|
||||
(let ((doom-print-level (or ,level doom-print-level))
|
||||
(doom-print-indent
|
||||
(+ (if ,(or if t) (or ,indent doom-print-indent-increment) 0)
|
||||
doom-print-indent)))
|
||||
,@body))))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro print! (message &rest args)
|
||||
|
|
@ -201,7 +203,7 @@ Can be colored using (color ...) blocks:
|
|||
(print! (green \"Great %s!\") \"success\")
|
||||
|
||||
Uses faces in interactive sessions and ANSI codes otherwise."
|
||||
`(doom-print (format! ,message ,@args) :format nil))
|
||||
`(doom-print (format! ,message ,@args)))
|
||||
|
||||
;;;###autoload
|
||||
(defmacro insert! (&rest args)
|
||||
|
|
@ -216,10 +218,73 @@ Each argument in ARGS can be a list, as if they were arguments to `format!':
|
|||
collect `(format! ,@arg)
|
||||
else collect arg)))
|
||||
|
||||
(defvar doom-print--output-depth 0)
|
||||
;;;###autoload
|
||||
(defmacro with-output-to! (streamspec &rest body)
|
||||
"Capture all output within BODY according to STREAMSPEC.
|
||||
|
||||
STREAMSPEC is a list of log specifications, indicating where to write output
|
||||
based on the print level of the message. For example:
|
||||
|
||||
`((>= notice ,(get-buffer-create \"*stdout*\"))
|
||||
(= error ,(get-buffer-create \"*errors*\"))
|
||||
(t . ,(get-buffer-create \"*debug*\")))"
|
||||
(declare (indent 1))
|
||||
(let ((sym (make-symbol "streamspec")))
|
||||
`(letf! ((,sym ,streamspec)
|
||||
(standard-output (doom-print--redirect-standard-output ,sym t))
|
||||
(#'message (doom-print--redirect-message ,sym (if noninteractive 'debug 'notice)))
|
||||
(doom-print--output-depth (1+ doom-print--output-depth)))
|
||||
,@body)))
|
||||
|
||||
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-print--redirect-streams (streamspec level)
|
||||
(if (or (eq streamspec t)
|
||||
(bufferp streamspec)
|
||||
(functionp streamspec)
|
||||
(markerp streamspec))
|
||||
(list (cons t streamspec))
|
||||
(cl-loop for (car . spec) in streamspec
|
||||
if (eq car t)
|
||||
collect (cons t spec)
|
||||
else
|
||||
collect (cons (or (eq level t)
|
||||
(doom-partial
|
||||
car
|
||||
(get level 'print-level)
|
||||
(get (car spec) 'print-level)))
|
||||
(cadr spec)))))
|
||||
|
||||
(defun doom-print--redirect-standard-output (streamspec level)
|
||||
(let ((old standard-output)
|
||||
(streams (doom-print--redirect-streams streamspec level)))
|
||||
(lambda (ch)
|
||||
(let ((str (char-to-string ch)))
|
||||
(dolist (stream streams)
|
||||
(when (or (eq (car stream) t)
|
||||
(funcall (car stream)))
|
||||
(doom-print str :newline nil :stream (cdr stream))))
|
||||
(doom-print str :newline nil :stream t :level level)))))
|
||||
|
||||
(defun doom-print--redirect-message (streamspec level)
|
||||
(let ((old (symbol-function #'message))
|
||||
(streams (doom-print--redirect-streams streamspec level)))
|
||||
(lambda (message &rest args)
|
||||
(when message
|
||||
(let ((output (apply #'doom-print--format message args)))
|
||||
(if (= doom-print--output-depth 0)
|
||||
(doom-print output :level level :stream t)
|
||||
(let ((doom-print--output-depth (1- doom-print--output-depth)))
|
||||
(funcall old "%s" output)))
|
||||
(dolist (stream streams)
|
||||
(when (or (eq (car stream) t)
|
||||
(funcall (car stream)))
|
||||
(doom-print output :stream (cdr stream)))))
|
||||
message))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-print--format (message &rest args)
|
||||
(if (or (null message) (string-blank-p message))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue