From b7bd27d22b453d6d7a1411d00ca40faae8261716 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 11 Sep 2022 21:12:58 +0200 Subject: [PATCH] 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 --- bin/doom | 6 +- lisp/cli/packages.el | 2 +- lisp/doom-cli.el | 237 ++++++++++++++++++++----------------------- lisp/lib/print.el | 151 +++++++++++++++++++-------- 4 files changed, 226 insertions(+), 170 deletions(-) diff --git a/bin/doom b/bin/doom index 920d092ba..be2602309 100755 --- a/bin/doom +++ b/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 diff --git a/lisp/cli/packages.el b/lisp/cli/packages.el index ef9dc8e22..c2f78c577 100644 --- a/lisp/cli/packages.el +++ b/lisp/cli/packages.el @@ -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." diff --git a/lisp/doom-cli.el b/lisp/doom-cli.el index b59ed6280..7061382a3 100644 --- a/lisp/doom-cli.el +++ b/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) diff --git a/lisp/lib/print.el b/lisp/lib/print.el index e155b60c4..66149ffcf 100644 --- a/lisp/lib/print.el +++ b/lisp/lib/print.el @@ -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))