Rewrite doom-doctor

- Use message library instead of reinventing the wheel
- Fix -d/--debug support for `bin/doom doctor`
- Add indent and autofill support to print! and format!
- Add doom-message-backend for forcing format! to use a specific backend
- Phase out anaphoric when! macro in doctor scripts, it was hardly used

bin/doom

@@ -4,7 +4,8 @@
 ":"; VERSION=$($EMACS --version | head -n1)
 ":"; [[ $VERSION == *\ 2[0-2].[0-1].[0-9] ]] && { echo "You're running $VERSION"; echo "That version is too old to run Doom. Check your PATH"; echo; exit 2; }
 ":"; DOOMBASE=$(dirname "${BASH_SOURCE:-${(%):-%x}}")/..
-":"; [[ $1 == doc || $1 == doctor ]] && { cd "$DOOMBASE"; exec $EMACS --script bin/doom-doctor; exit 0; }
+":"; [[ $1 == -d || $1 == --debug ]] && { shift; export DEBUG=1; }
+":"; [[ $1 == doc || $1 == doctor ]] && { cd "$DOOMBASE"; shift; exec $EMACS --script bin/doom-doctor "$@"; exit 0; }
 ":"; [[ $1 == run ]] && { cd "$DOOMBASE"; shift; exec $EMACS -q --no-splash -l bin/doom "$@"; exit 0; }
 ":"; exec $EMACS --script "$0" -- $@
 ":"; exit 0

bin/doom-doctor

@@ -10,8 +10,8 @@
 ;;
 ;; Doom modules may optionally have a doctor.el file to run their own heuristics
 ;; in. Doctor scripts may run in versions of Emacs as old as Emacs 23, so make
-;; no assumptions about the standard library limited to very basic standard
+;; no assumptions about what's available in the standard library (e.g. avoid
-;; library (e.g. avoid cl/cl-lib, subr-x, map, seq, etc).
+;; cl/cl-lib, subr-x, map, seq, etc).
 
 
 ;; Ensure Doom doctor always runs out of the current Emacs directory (optionally
@@ -28,69 +28,53 @@
   (setq debug-on-error t))
 
 (require 'pp)
+(load (expand-file-name "core/autoload/message" user-emacs-directory) nil t)
 
 
-;;; Helpers
 (defvar doom-init-p nil)
 (defvar doom-warnings 0)
 (defvar doom-errors 0)
-(defmacro when! (cond &rest body)
-  (declare (indent defun))
-  `(let ((it ,cond))
-     (when it ,@body)))
 
-(defun indented (spc msg)
-  (declare (indent defun))
-  (with-temp-buffer
-    (insert msg)
-    (let ((fill-column 80))
-      (fill-region (point-min) (point-max))
-      (indent-rigidly (point-min) (point-max) spc))
-    (when (> spc 2)
-      (goto-char (point-min))
-      (beginning-of-line-text)
-      (delete-char -2)
-      (insert "> "))
-    (buffer-string)))
 
-(defun autofill (&rest msgs)
+;;; Helpers
-  (declare (indent defun))
-  (let ((fill-column 70))
-    (with-temp-buffer
-      (dolist (line msgs)
-        (when line
-          (insert line)))
-      (fill-region (point-min) (point-max))
-      (buffer-string))))
 
 (defun sh (cmd)
   (string-trim-right (shell-command-to-string cmd)))
 
-(defun color (code msg &rest args)
-  (format "\e[%dm%s\e[%dm" code (apply #'format msg args) 0))
-
-(defvar indent 0)
-(defvar prefix "")
-(defmacro msg! (msg &rest args)
-  `(message
-    (indented indent
-              (format (concat prefix ,msg)
-                      ,@args))))
-(defmacro error!   (&rest args) `(progn (msg! (color 31 ,@args)) (setq doom-errors (+ doom-errors 1))))
-(defmacro warn!    (&rest args) `(progn (msg! (color 33 ,@args)) (setq doom-warnings (+ doom-warnings 1))))
-(defmacro success! (&rest args) `(msg! (color 32 ,@args)))
-(defmacro section! (&rest args)
-  `(msg! (color 1 (color 34 ,@args))))
-
-(defmacro explain! (&rest args)
-  `(message (indented (+ indent 2) (autofill ,@args))))
-
 (defun elc-check-dir (dir)
   (dolist (file (directory-files-recursively dir "\\.elc$"))
     (when (file-newer-than-file-p (concat (file-name-sans-extension file) ".el")
                                   file)
       (warn! "%s is out-of-date" (abbreviate-file-name file)))))
 
+(defmacro assert! (condition message &rest args)
+  `(unless ,condition
+     (error! ,message ,@args)))
+
+
+;;; Logging
+
+(defvar indent 0)
+(defvar prefix "")
+
+(defmacro msg! (msg &rest args)
+  `(print!
+    (indent indent
+            (format (concat prefix ,msg)
+                    ,@args))))
+
+(defmacro error!   (&rest args)
+  `(progn (msg! (red ,@args))
+          (setq doom-errors (+ doom-errors 1))))
+(defmacro warn!    (&rest args)
+  `(progn (msg! (yellow ,@args))
+          (setq doom-warnings (+ doom-warnings 1))))
+(defmacro success! (&rest args) `(msg! (green ,@args)))
+(defmacro section! (&rest args) `(msg! (bold (blue ,@args))))
+
+(defmacro explain! (&rest args)
+  `(msg! (indent (+ indent 2) (autofill ,@args))))
+
 
 ;;; Polyfills
 ;; early versions of emacs won't have this
@@ -99,7 +83,7 @@
     (save-match-data
       (string-match regexp string &optional start))))
 
-;; subr-x may not exist in the current version of Emacs
+;; subr-x don't exist in older versions of Emacs
 (unless (fboundp 'string-trim-right)
   (defsubst string-trim-right (string &optional regexp)
     (if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string)
@@ -107,9 +91,10 @@
       string)))
 
 
-;; --- start a'doctorin' --------------------------------------
+;;
+;;; Basic diagnostics
 
-(msg! (color 1 "Doom Doctor"))
+(msg! (bold "Doom Doctor"))
 (msg! "Emacs v%s" emacs-version)
 (msg! "Doom v%s (%s)"
       (or (let ((core-file (expand-file-name "core/core.el" user-emacs-directory)))
@@ -129,16 +114,17 @@
       (getenv "SHELL")
       (if (equal (getenv "SHELL") (sh "echo $SHELL"))
           ""
-        (color 31 " (mismatch)")))
+        (red " (mismatch)")))
 (when (boundp 'system-configuration-features)
-  (message "Compiled with:\n%s" (indented 2 system-configuration-features)))
+  (msg! "Compiled with:\n%s" (indent 2 system-configuration-features)))
-(message "uname -msrv:\n%s\n" (indented 2 (sh "uname -msrv")))
+(msg! "uname -msrv:\n%s\n" (indent 2 (sh "uname -msrv")))
 
 
-;; --- is emacs set up properly? ------------------------------
+;;
+;;; Check if Emacs is set up correctly
 
 (section! "Checking Emacs")
-(let ((indent 4))
+(let ((indent 2))
   (section! "Checking your Emacs version is 25.3 or newer...")
   (when (version< emacs-version "25.3")
     (error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs"))
@@ -160,6 +146,13 @@
                 "It is recommended that you reinstall your plugins or recompile them with"
                 "`bin/doom compile :plugins'.")))
 
+  (section! "Checking for Emacs config conflicts...")
+  (when (file-exists-p "~/.emacs")
+    (warn! "Detected an ~/.emacs file, which may prevent Doom from loading")
+    (explain! "If Emacs finds an ~/.emacs file, it will ignore ~/.emacs.d, where Doom is "
+              "typically installed. If you're seeing a vanilla Emacs splash screen, this "
+              "may explain why. If you use Chemacs, you may ignore this warning."))
+
   (section! "Checking for private config conflicts...")
   (let ((xdg-dir (concat (or (getenv "XDG_CONFIG_HOME")
                              "~/.config")
@@ -178,10 +171,11 @@
   (elc-check-dir user-emacs-directory))
 
 
-;; --- is the environment set up properly? --------------------
+;;
+;;; Check if system environment is set up correctly
 
 (section! "Checking your system...")
-(let ((indent 4))
+(let ((indent 2))
   ;; on windows?
   (when (memq system-type '(windows-nt ms-dos cygwin))
     (warn! "Warning: Windows detected")
@@ -268,30 +262,30 @@
          (let ((tls-checktrust t)
                (gnutls-verify-error t))
            (dolist (url '("https://elpa.gnu.org" "https://melpa.org"))
-             (when! (condition-case-unless-debug e
+             (pcase (condition-case-unless-debug e
                         (unless (let ((inhibit-message t)) (url-retrieve-synchronously url))
                           'empty)
                       ('timed-out 'timeout)
                       ('error e))
-                    (pcase it
+               (`nil nil)
-                      (`empty (error! "Couldn't reach %s" url))
+               (`empty (error! "Couldn't reach %s" url))
-                      (`timeout (error! "Timed out trying to contact %s" ex))
+               (`timeout (error! "Timed out trying to contact %s" ex))
-                      (_
+               (_
-                       (error! "Failed to validate %s" url)
+                (error! "Failed to validate %s" url)
-                       (explain! (pp-to-string it))))))
+                (explain! (pp-to-string it)))))
            (dolist (url '("https://self-signed.badssl.com"
                           "https://wrong.host.badssl.com/"))
-             (when! (condition-case-unless-debug e
+             (pcase (condition-case-unless-debug e
                         (if (let ((inhibit-message t)) (url-retrieve-synchronously url))
                             t
                           'empty)
                       ('timed-out 'timeout)
                       ('error))
-                    (pcase it
+               (`nil nil)
-                      (`empty (error! "Couldn't reach %s" url))
+               (`empty (error! "Couldn't reach %s" url))
-                      (`timeout (error! "Timed out trying to contact %s" ex))
+               (`timeout (error! "Timed out trying to contact %s" ex))
-                      (_
+               (_
-                       (error! "Validated %s (this shouldn't happen!)" url)))))))
+                (error! "Validated %s (this shouldn't happen!)" url))))))
 
         ((error! "Nope!")))
 
@@ -315,17 +309,19 @@
        "prevent you from installing & updating packages."))))
 
 
-;; --- is Doom Emacs set up correctly? ------------------------
+;;
+;;; Check if Doom Emacs is set up correctly
 
 (condition-case-unless-debug ex
     (let ((after-init-time (current-time))
+          (doom-message-backend 'ansi)
           noninteractive)
       (section! "Checking DOOM Emacs...")
       (load (concat user-emacs-directory "core/core.el") nil t)
       (unless (file-directory-p doom-private-dir)
         (error "No DOOMDIR was found, did you run `doom quickstart` yet?"))
 
-      (let ((indent 4))
+      (let ((indent 2))
         ;; Make sure everything is loaded
         (require 'core-cli)
         (require 'core-keybinds)
@@ -362,7 +358,7 @@
             (advice-add #'require :around #'doom*shut-up)
             (maphash
              (lambda (key plist)
-               (let ((prefix (format "%s" (color 1 "(%s %s) " (car key) (cdr key)))))
+               (let ((prefix (format! (bold "(%s %s) " (car key) (cdr key)))))
                  (condition-case-unless-debug ex
                      (let ((doctor-file   (doom-module-path (car key) (cdr key) "doctor.el"))
                            (packages-file (doom-module-path (car key) (cdr key) "packages.el")))
@@ -386,13 +382,19 @@
           (or (cdr-safe ex) (car ex)))
    (setq doom-modules nil)))
 
+
 ;;
-(message "\n")
+;;; Final report
-(dolist (msg (list (list doom-errors "error" 31)
+
-                   (list doom-warnings "warning" 33)))
+(message "")
+(dolist (msg (list (list doom-errors "error" 'red)
+                   (list doom-warnings "warning" 'yellow)))
   (when (> (car msg) 0)
-    (message (color (nth 2 msg) (if (= (car msg) 1) "There is %d %s!" "There are %d %ss!")
+    (msg! (color (nth 2 msg)
-                    (car msg) (nth 1 msg)))))
+                 (if (= (car msg) 1)
+                     "There is %d %s!"
+                   "There are %d %ss!")
+                 (car msg) (nth 1 msg)))))
 
 (when (and (zerop doom-errors)
            (zerop doom-warnings))

core/autoload/message.el

@@ -31,27 +31,60 @@
     (on-white   47 term-color-white))
   "TODO")
 
+(defvar doom-message-backend
+  (if noninteractive 'ansi 'text-properties)
+  "Determines whether to print colors with ANSI codes or with text properties.
+
+Accepts 'ansi and 'text-properties. nil means don't render colors.")
+
 ;;;###autoload
-(defun doom-color-apply (style text)
+(defun doom-message-indent (width text &rest args)
+  (with-temp-buffer
+    (insert (apply #'format text args))
+    (let ((fill-column 80))
+      (fill-region (point-min) (point-max))
+      (indent-rigidly (point-min) (point-max) width))
+    (when (> width 2)
+      (goto-char (point-min))
+      (beginning-of-line-text)
+      (delete-char -2)
+      (insert "> "))
+    (buffer-string)))
+
+;;;###autoload
+(defun doom-message-autofill (&rest msgs)
+  (with-temp-buffer
+    (let ((fill-column 70))
+      (dolist (line msgs)
+        (when line
+          (insert line)))
+      (fill-region (point-min) (point-max))
+      (buffer-string))))
+
+;;;###autoload
+(defun doom-color-apply (style text &rest args)
   "Apply CODE to formatted MESSAGE with ARGS. CODE is derived from any of
 `doom-message-fg', `doom-message-bg' or `doom-message-fx'.
 
 In a noninteractive session, this wraps the result in ansi color codes.
 Otherwise, it maps colors to a term-color-* face."
-  (let ((code (cadr (assq style doom-ansi-alist))))
+  (let ((code (car (cdr (assq style doom-ansi-alist)))))
-    (if noninteractive
+    (pcase doom-message-backend
-        (format "\e[%dm%s\e[%dm"
+      (`ansi
-                (cadr (assq style doom-ansi-alist))
+       (format "\e[%dm%s\e[%dm"
-                text 0)
+               (car (cdr (assq style doom-ansi-alist)))
-      (require 'term)  ; piggyback on term's color faces
+               (apply #'format text args) 0))
-      (propertize
+      (`text-properties
-       text 'face
+       (require 'term)  ; piggyback on term's color faces
-       (append (get-text-property 0 'face text)
+       (propertize
-               (cond ((>= code 40)
+        (apply #'format text args) 'face
-                      `(:background ,(caddr (assq style doom-ansi-alist))))
+        (append (get-text-property 0 'face text)
-                     ((>= code 30)
+                (cond ((>= code 40)
-                      `(:foreground ,(face-foreground (caddr (assq style doom-ansi-alist)))))
+                       `(:background ,(caddr (assq style doom-ansi-alist))))
-                     ((cddr (assq style doom-ansi-alist)))))))))
+                      ((>= code 30)
+                       `(:foreground ,(face-foreground (caddr (assq style doom-ansi-alist)))))
+                      ((cddr (assq style doom-ansi-alist)))))))
+      (_ (apply #'format text args)))))
 
 (defun doom--short-color-replace (forms)
   "Replace color-name functions with calls to `doom-color-apply'."
@@ -64,6 +97,10 @@ Otherwise, it maps colors to a term-color-* face."
                        ((eq (car forms) 'color)
                         (pop forms)
                         `(doom-color-apply ,(car forms)))
+                       ((memq (car forms) '(indent autofill))
+                        (let ((fn (pop forms)))
+                          `(,(intern (format "doom-message-%s" fn))
+                            ,(car forms))))
                        ((list (car forms))))
                  (doom--short-color-replace (cdr forms))
                  nil))

core/doctor.el

@@ -18,19 +18,19 @@
              (/ size 1024))
       (explain! "Consider deleting it from your system (manually)"))))
 
-(when! (not (executable-find doom-projectile-fd-binary))
+(when (not (executable-find doom-projectile-fd-binary))
   (warn! "Couldn't find the `fd' binary; project file searches will be slightly slower"))
 
 (let ((default-directory "~"))
   (require 'projectile)
-  (when! (cl-find-if #'projectile-file-exists-p projectile-project-root-files-bottom-up)
+  (when (cl-find-if #'projectile-file-exists-p projectile-project-root-files-bottom-up)
     (warn! "Your $HOME is recognized as a project root")
     (explain! "Doom will disable bottom-up root search, which may reduce the accuracy of project\n"
               "detection.")))
 
 ;; There should only be one
-(when! (and (file-equal-p doom-private-dir "~/.config/doom")
+(when (and (file-equal-p doom-private-dir "~/.config/doom")
-            (file-directory-p "~/.doom.d"))
+           (file-directory-p "~/.doom.d"))
   (warn! "Both %S and '~/.doom.d' exist on your system"
          (abbreviate-file-name doom-private-dir))
   (explain! "Doom will only load one of these (~/.config/doom takes precedence). Since\n"

core/test/test-autoload-message.el

@@ -3,8 +3,9 @@
 
 (describe "core/autoload/message"
   (describe "format!"
-    :var (noninteractive)
+    :var (doom-message-backend)
-    (before-all (setq noninteractive t))
+    (before-all
+      (setq doom-message-backend 'ansi))
 
     (it "should be a drop-in replacement for `format'"
       (expect (format! "Hello %s" "World")
@@ -14,8 +15,8 @@
       (expect (format! (red "Hello %s") "World")
               :to-equal "Hello World"))
 
-    (it "supports faces in interactive sessions"
+    (it "supports text properties in interactive sessions"
-      (let (noninteractive)
+      (let ((doom-message-backend 'text-properties))
         (expect (get-text-property 0 'face (format! (red "Hello %s") "World"))
                 :to-equal (list :foreground (face-foreground 'term-color-red)))))