diff --git a/bin/doom b/bin/doom index 9178f630e..9d7cf21fe 100755 --- a/bin/doom +++ b/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 diff --git a/bin/doom-doctor b/bin/doom-doctor index 626742601..b9dcc0a2f 100755 --- a/bin/doom-doctor +++ b/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 -;; library (e.g. avoid cl/cl-lib, subr-x, map, seq, etc). +;; no assumptions about what's available in the standard library (e.g. avoid +;; 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) - (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)))) +;;; Helpers (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))) -(message "uname -msrv:\n%s\n" (indented 2 (sh "uname -msrv"))) + (msg! "Compiled with:\n%s" (indent 2 system-configuration-features))) +(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 - (`empty (error! "Couldn't reach %s" url)) - (`timeout (error! "Timed out trying to contact %s" ex)) - (_ - (error! "Failed to validate %s" url) - (explain! (pp-to-string it)))))) + (`nil nil) + (`empty (error! "Couldn't reach %s" url)) + (`timeout (error! "Timed out trying to contact %s" ex)) + (_ + (error! "Failed to validate %s" url) + (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 - (`empty (error! "Couldn't reach %s" url)) - (`timeout (error! "Timed out trying to contact %s" ex)) - (_ - (error! "Validated %s (this shouldn't happen!)" url))))))) + (`nil nil) + (`empty (error! "Couldn't reach %s" url)) + (`timeout (error! "Timed out trying to contact %s" ex)) + (_ + (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") -(dolist (msg (list (list doom-errors "error" 31) - (list doom-warnings "warning" 33))) +;;; Final report + +(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!") - (car msg) (nth 1 msg))))) + (msg! (color (nth 2 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)) diff --git a/core/autoload/message.el b/core/autoload/message.el index 340e98954..b460b4340 100644 --- a/core/autoload/message.el +++ b/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)))) - (if noninteractive - (format "\e[%dm%s\e[%dm" - (cadr (assq style doom-ansi-alist)) - text 0) - (require 'term) ; piggyback on term's color faces - (propertize - text 'face - (append (get-text-property 0 'face text) - (cond ((>= code 40) - `(:background ,(caddr (assq style doom-ansi-alist)))) - ((>= code 30) - `(:foreground ,(face-foreground (caddr (assq style doom-ansi-alist))))) - ((cddr (assq style doom-ansi-alist))))))))) + (let ((code (car (cdr (assq style doom-ansi-alist))))) + (pcase doom-message-backend + (`ansi + (format "\e[%dm%s\e[%dm" + (car (cdr (assq style doom-ansi-alist))) + (apply #'format text args) 0)) + (`text-properties + (require 'term) ; piggyback on term's color faces + (propertize + (apply #'format text args) 'face + (append (get-text-property 0 'face text) + (cond ((>= code 40) + `(:background ,(caddr (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)) diff --git a/core/doctor.el b/core/doctor.el index 8ac64af99..296dfae64 100644 --- a/core/doctor.el +++ b/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") - (file-directory-p "~/.doom.d")) +(when (and (file-equal-p doom-private-dir "~/.config/doom") + (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" diff --git a/core/test/test-autoload-message.el b/core/test/test-autoload-message.el index 30c20eaa9..a7d90c122 100644 --- a/core/test/test-autoload-message.el +++ b/core/test/test-autoload-message.el @@ -3,8 +3,9 @@ (describe "core/autoload/message" (describe "format!" - :var (noninteractive) - (before-all (setq noninteractive t)) + :var (doom-message-backend) + (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" - (let (noninteractive) + (it "supports text properties in interactive sessions" + (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)))))