Major refactor of the Doctor

- Reorganize tests into logical groups
- Report Doom initialization with more granularity
- Make better use of whitespace and indentation in output
- Use backquotes for quoting symbols in pcase (for backward
  compatibility)
- Initialize Doom completely and manually (less maintanence headache and
  more certain to work across Doom updates).
This commit is contained in:
Henrik Lissner 2019-04-19 13:31:27 -04:00
parent 25a86c18c8
commit 0caf0abcbb
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395

View file

@ -8,10 +8,11 @@
;; that uses a series of simple heuristics to diagnose common issues on your ;; that uses a series of simple heuristics to diagnose common issues on your
;; system. Issues that could intefere with Doom Emacs. ;; system. Issues that could intefere with Doom Emacs.
;; ;;
;; Doom module may optionally have a doctor.el file to run their own heuristics ;; 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 you ;; in. Doctor scripts may run in versions of Emacs as old as Emacs 23, so make
;; are limited to very basic standard library calls (e.g. avoid cl, subr-x, and ;; no assumptions about the standard library limited to very basic standard
;; any Doom dependencies). ;; library (e.g. avoid cl/cl-lib, subr-x, map, seq, etc).
;; Ensure Doom doctor always runs out of the current Emacs directory (optionally ;; Ensure Doom doctor always runs out of the current Emacs directory (optionally
;; specified by the EMACSDIR envvar) ;; specified by the EMACSDIR envvar)
@ -28,7 +29,8 @@
(require 'pp) (require 'pp)
;;
;;; Helpers
(defvar doom-init-p nil) (defvar doom-init-p nil)
(defvar doom-warnings 0) (defvar doom-warnings 0)
(defvar doom-errors 0) (defvar doom-errors 0)
@ -83,6 +85,13 @@
(defmacro explain! (&rest args) (defmacro explain! (&rest args)
`(message (indented (+ indent 2) (autofill ,@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)))))
;;; Polyfills ;;; Polyfills
;; early versions of emacs won't have this ;; early versions of emacs won't have this
(unless (fboundp 'string-match-p) (unless (fboundp 'string-match-p)
@ -103,14 +112,14 @@
(msg! (color 1 "Doom Doctor")) (msg! (color 1 "Doom Doctor"))
(msg! "Emacs v%s" emacs-version) (msg! "Emacs v%s" emacs-version)
(msg! "Doom v%s (%s)" (msg! "Doom v%s (%s)"
(or (and (file-exists-p (expand-file-name "core/core.el" user-emacs-directory)) (or (let ((core-file (expand-file-name "core/core.el" user-emacs-directory)))
(with-temp-buffer (and (file-exists-p core-file)
(insert-file-contents-literally (with-temp-buffer
(expand-file-name "core/core.el" user-emacs-directory)) (insert-file-contents-literally core-file)
(goto-char (point-min)) (goto-char (point-min))
(when (re-search-forward "doom-version") (when (re-search-forward "doom-version" nil t)
(forward-char) (forward-char)
(sexp-at-point)))) (sexp-at-point)))))
"???") "???")
(if (and (executable-find "git") (if (and (executable-find "git")
(file-directory-p (expand-file-name ".git" user-emacs-directory))) (file-directory-p (expand-file-name ".git" user-emacs-directory)))
@ -125,217 +134,255 @@
(message "Compiled with:\n%s" (indented 2 system-configuration-features))) (message "Compiled with:\n%s" (indented 2 system-configuration-features)))
(message "uname -msrv:\n%s\n" (indented 2 (sh "uname -msrv"))) (message "uname -msrv:\n%s\n" (indented 2 (sh "uname -msrv")))
;; --- is emacs set up properly? ------------------------------ ;; --- is emacs set up properly? ------------------------------
(when (version< emacs-version "25.3") (section! "Checking Emacs")
(error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs")) (let ((indent 4))
(explain! (section! "Checking your Emacs version is 25.3 or newer...")
"DOOM only supports >= 25.3. Perhaps your PATH wasn't set up properly." (when (version< emacs-version "25.3")
(when (eq system-type 'darwin) (error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs"))
(concat "\nMacOS users should use homebrew (https://brew.sh) to install Emacs\n" (explain!
" brew install emacs --with-modules --with-imagemagick --with-cocoa")))) "DOOM only supports >= 25.3. Perhaps your PATH wasn't set up properly."
(when (eq system-type 'darwin)
(concat "\nMacOS users should use homebrew (https://brew.sh) to install Emacs\n"
" brew install emacs --with-modules --with-imagemagick --with-cocoa"))))
(let ((xdg-dir (concat (or (getenv "XDG_CONFIG_HOME") (section! "Checking if your version of Emacs has changed recently...")
"~/.config") (let ((version-file (expand-file-name ".local/emacs-version.el" user-emacs-directory))
"/doom/")) doom--last-emacs-version)
(doom-dir "~/.doom.d/")) (when (and (load version-file 'noerror 'nomessage 'nosuffix)
(when (and (file-directory-p xdg-dir) (not (equal emacs-version doom--last-emacs-version)))
(file-directory-p doom-dir)) (warn! "Your version of Emacs has changed from %S to %S. Recompile your packages!"
(warn! "Detected two private configs, in %s and %s" doom--last-emacs-version
(abbreviate-file-name xdg-dir) emacs-version)
doom-dir) (explain! "Byte-code compiled in one version of Emacs may not work in another version."
(explain! "The second directory will be ignored, as it has lower precedence."))) "It is recommended that you reinstall your plugins or recompile them with"
"`bin/doom compile :plugins'.")))
(section! "Checking for private config conflicts...")
(let ((xdg-dir (concat (or (getenv "XDG_CONFIG_HOME")
"~/.config")
"/doom/"))
(doom-dir (or (getenv "DOOMDIR")
"~/.doom.d/")))
(when (and (not (file-equal-p xdg-dir doom-dir))
(file-directory-p xdg-dir)
(file-directory-p doom-dir))
(warn! "Detected two private configs, in %s and %s"
(abbreviate-file-name xdg-dir)
doom-dir)
(explain! "The second directory will be ignored, as it has lower precedence.")))
(section! "Checking for stale elc files...")
(elc-check-dir user-emacs-directory))
;; --- is the environment set up properly? -------------------- ;; --- is the environment set up properly? --------------------
;; on windows? (section! "Checking your system...")
(section! "Checking your OS...") (let ((indent 4))
(when (memq system-type '(windows-nt ms-dos cygwin)) ;; on windows?
(warn! "Warning: Windows detected") (when (memq system-type '(windows-nt ms-dos cygwin))
(explain! "DOOM was designed for MacOS and Linux. Expect a bumpy ride!")) (warn! "Warning: Windows detected")
(explain! "DOOM was designed for MacOS and Linux. Expect a bumpy ride!"))
;; are all default fonts present? ;; are all default fonts present?
(section! "Checking your fonts...") (section! "Checking your fonts...")
(if (not (fboundp 'find-font)) (if (not (fboundp 'find-font))
(progn (progn
(warn! "Warning: unable to detect font") (warn! "Warning: unable to detect font")
(explain! "The `find-font' function is missing. This could indicate the incorrect " (explain! "The `find-font' function is missing. This could indicate the incorrect "
"version of Emacs is being used!")) "version of Emacs is being used!"))
;; all-the-icons fonts ;; all-the-icons fonts
(let ((font-dest (pcase system-type (let ((font-dest (pcase system-type
('gnu/linux (concat (or (getenv "XDG_DATA_HOME") (`gnu/linux (concat (or (getenv "XDG_DATA_HOME")
"~/.local/share") "~/.local/share")
"/fonts/")) "/fonts/"))
('darwin "~/Library/Fonts/")))) (`darwin "~/Library/Fonts/"))))
(when (and font-dest (require 'all-the-icons nil t)) (when (and font-dest (require 'all-the-icons nil t))
(dolist (font all-the-icons-font-names) (dolist (font all-the-icons-font-names)
(if (file-exists-p (expand-file-name font font-dest)) (if (file-exists-p (expand-file-name font font-dest))
(success! "Found font %s" font) (success! "Found font %s" font)
(warn! "Warning: couldn't find %s font in %s" (warn! "Warning: couldn't find %s font in %s"
font font-dest) font font-dest)
(explain! "You can install it by running `M-x all-the-icons-install-fonts' within Emacs.\n\n" (explain! "You can install it by running `M-x all-the-icons-install-fonts' within Emacs.\n\n"
"This could also mean you've installed them in non-standard locations, in which " "This could also mean you've installed them in non-standard locations, in which "
"case feel free to ignore this warning.")))))) "case feel free to ignore this warning."))))))
;; gnutls-cli & openssl ;; gnutls-cli & openssl
(section! "Checking gnutls/openssl...") (section! "Checking gnutls/openssl...")
(cond ((executable-find "gnutls-cli")) (cond ((executable-find "gnutls-cli"))
((executable-find "openssl") ((executable-find "openssl")
(let* ((output (sh "openssl ciphers -v")) (let* ((output (sh "openssl ciphers -v"))
(protocols (protocols
(let (protos) (let (protos)
(mapcar (lambda (row) (mapcar (lambda (row)
(add-to-list 'protos (cadr (split-string row " " t)))) (add-to-list 'protos (cadr (split-string row " " t))))
(split-string (sh "openssl ciphers -v") "\n")) (split-string (sh "openssl ciphers -v") "\n"))
(delq nil protos)))) (delq nil protos))))
(unless (or (member "TLSv1.1" protocols) (unless (or (member "TLSv1.1" protocols)
(member "TLSv1.2" protocols)) (member "TLSv1.2" protocols))
(let ((version (cadr (split-string (sh "openssl version") " " t)))) (let ((version (cadr (split-string (sh "openssl version") " " t))))
(warn! "Warning: couldn't find gnutls-cli, and OpenSSL is out-of-date (v%s)" version) (warn! "Warning: couldn't find gnutls-cli, and OpenSSL is out-of-date (v%s)" version)
(explain! (explain!
"This may not affect your Emacs experience, but there are security " "This may not affect your Emacs experience, but there are security "
"vulnerabilities in the SSL2/3 & TLS1.0 protocols. You should use " "vulnerabilities in the SSL2/3 & TLS1.0 protocols. You should use "
"TLS 1.1+, which wasn't introduced until OpenSSL v1.0.1.\n\n" "TLS 1.1+, which wasn't introduced until OpenSSL v1.0.1.\n\n"
"Please consider updating (or install gnutls-cli, which is preferred)."))))) "Please consider updating (or install gnutls-cli, which is preferred).")))))
(t (t
(error! "Important: couldn't find either gnutls-cli nor openssl") (error! "Important: couldn't find either gnutls-cli nor openssl")
(explain! (explain!
"You won't be able to install/update packages because Emacs won't be able to " "You won't be able to install/update packages because Emacs won't be able to "
"verify HTTPS ELPA sources. Install gnutls-cli or openssl v1.0.0+. If for some " "verify HTTPS ELPA sources. Install gnutls-cli or openssl v1.0.0+. If for some "
"reason you can't, you can bypass this verification with the INSECURE flag:\n\n" "reason you can't, you can bypass this verification with the INSECURE flag:\n\n"
" INSECURE=1 make install\n\n" " INSECURE=1 make install\n\n"
"Or change `package-archives' to use non-https sources.\n\n" "Or change `package-archives' to use non-https sources.\n\n"
"But remember that you're leaving your security in the hands of your " "But remember that you're leaving your security in the hands of your "
"network, provider, government, neckbearded mother-in-laws, geeky roommates, " "network, provider, government, neckbearded mother-in-laws, geeky roommates, "
"or just about anyone who knows more about computers than you do!"))) "or just about anyone who knows more about computers than you do!")))
;; are certificates validated properly? ;; are certificates validated properly?
(section! "Testing your root certificates...") (section! "Testing your root certificates...")
(cond ((not (ignore-errors (gnutls-available-p))) (cond ((not (ignore-errors (gnutls-available-p)))
(warn! "Warning: Emacs wasn't installed with gnutls support") (warn! "Warning: Emacs wasn't installed with gnutls support")
(explain! (explain!
"This may cause 'pecular error' errors with the Doom doctor, and is likely to " "This may cause 'pecular error' errors with the Doom doctor, and is likely to "
"interfere with package management. Your mileage may vary." "interfere with package management. Your mileage may vary."
(when (eq system-type 'darwin) (when (eq system-type 'darwin)
(concat "\nMacOS users are advised to install Emacs via homebrew with one of the following:\n" (concat "\nMacOS users are advised to install Emacs via homebrew with one of the following:\n"
" brew install emacs --with-gnutls" " brew install emacs --with-gnutls"
" or" " or"
" brew tap d12frosted/emacs-plus" " brew tap d12frosted/emacs-plus"
" brew install emacs-plus")))) " brew install emacs-plus"))))
((not (fboundp 'url-retrieve-synchronously)) ((not (fboundp 'url-retrieve-synchronously))
(error! "Can't find url-retrieve-synchronously function. Are you sure you're on Emacs 24+?")) (error! "Can't find url-retrieve-synchronously function. Are you sure you're on Emacs 24+?"))
((or (executable-find "gnutls-cli") ((or (executable-find "gnutls-cli")
(executable-find "openssl")) (executable-find "openssl"))
(let ((tls-checktrust t) (let ((tls-checktrust t)
(gnutls-verify-error t)) (gnutls-verify-error t))
(dolist (url '("https://elpa.gnu.org" "https://melpa.org")) (dolist (url '("https://elpa.gnu.org" "https://melpa.org"))
(when! (condition-case-unless-debug e (when! (condition-case-unless-debug e
(unless (let ((inhibit-message t)) (url-retrieve-synchronously url)) (unless (let ((inhibit-message t)) (url-retrieve-synchronously url))
'empty) 'empty)
('timed-out 'timeout) ('timed-out 'timeout)
('error e)) ('error e))
(pcase it (pcase it
(`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" (dolist (url '("https://self-signed.badssl.com"
"https://wrong.host.badssl.com/")) "https://wrong.host.badssl.com/"))
(when! (condition-case-unless-debug e (when! (condition-case-unless-debug e
(if (let ((inhibit-message t)) (url-retrieve-synchronously url)) (if (let ((inhibit-message t)) (url-retrieve-synchronously url))
t t
'empty) 'empty)
('timed-out 'timeout) ('timed-out 'timeout)
('error)) ('error))
(pcase it (pcase it
(`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!"))) ((error! "Nope!")))
;; which variant of tar is on your system? bsd or gnu tar? ;; which variant of tar is on your system? bsd or gnu tar?
(section! "Checking for GNU/BSD tar...") (section! "Checking for GNU/BSD tar...")
(let ((tar-bin (or (executable-find "gtar") (let ((tar-bin (or (executable-find "gtar")
(executable-find "tar")))) (executable-find "tar"))))
(if tar-bin (if tar-bin
(unless (string-match-p "(GNU tar)" (sh (format "%s --version" tar-bin))) (unless (string-match-p "(GNU tar)" (sh (format "%s --version" tar-bin)))
(warn! "Warning: BSD tar detected") (warn! "Warning: BSD tar detected")
(explain! (explain!
"QUELPA (through package-build) uses the system tar to build plugins, but it " "QUELPA (through package-build) uses the system tar to build plugins, but it "
"expects GNU tar. BSD tar *could* cause errors during package installation or " "expects GNU tar. BSD tar *could* cause errors during package installation or "
"updating from non-ELPA sources." "updating from non-ELPA sources."
(when (eq system-type 'darwin) (when (eq system-type 'darwin)
(concat "\nMacOS users can install gnu-tar via homebrew:\n" (concat "\nMacOS users can install gnu-tar via homebrew:\n"
" brew install gnu-tar")))) " brew install gnu-tar"))))
(error! "Important: Couldn't find tar") (error! "Important: Couldn't find tar")
(explain! (explain!
"This is required by package.el and QUELPA to build packages and will " "This is required by package.el and QUELPA to build packages and will "
"prevent you from installing & updating packages."))) "prevent you from installing & updating packages."))))
;; --- are your modules set up properly? ---------------------- ;; --- is Doom Emacs set up correctly? ------------------------
(condition-case-unless-debug ex (condition-case-unless-debug ex
(progn (let ((after-init-time (current-time))
(let ((inhibit-message t) noninteractive)
(after-init-time (current-time)) (section! "Checking DOOM Emacs...")
noninteractive) (load (concat user-emacs-directory "core/core.el") nil t)
(delq 'core features) (unless (file-directory-p doom-private-dir)
(load-file (concat user-emacs-directory "init.el")) (error "No DOOMDIR was found, did you run `doom quickstart` yet?"))
(require 'core-packages)
(doom-initialize-packages)
(success! "Attempt to load DOOM: success! Loaded v%s" doom-version))
(section! "Checking Doom core for irregularities...")
(let ((indent 4)) (let ((indent 4))
(load (expand-file-name "doctor.el" doom-core-dir) nil 'nomessage)) ;; Make sure everything is loaded
(require 'core-cli)
(require 'core-keybinds)
(require 'core-ui)
(require 'core-projects)
(require 'core-editor)
(require 'core-packages)
(success! "Loaded Doom Emacs %s" doom-version)
(section! "Checking for stale elc files...") ;; ...and initialized
(let ((elc-files (doom-files-in (list doom-emacs-dir doom-private-dir) (doom-initialize)
:match "\\.elc$" (success! "Initialized Doom Emacs" doom-version)
:depth 2)))
(dolist (file elc-files)
(when (file-newer-than-file-p (concat (file-name-sans-extension file) ".el")
file)
(warn! "%s is out-of-date" (abbreviate-file-name file)))))
(when (bound-and-true-p doom-modules) (doom-initialize-modules)
(section! "Checking your enabled modules...") (if (hash-table-p doom-modules)
(let ((indent 4)) (success! "Initialized %d modules" (hash-table-count doom-modules))
(advice-add #'require :around #'doom*shut-up) (warn! "Failed to load any modules. Do you have an private init.el?"))
(maphash
(lambda (key plist) (doom-initialize-packages)
(let ((prefix (format "%s" (color 1 "(%s %s) " (car key) (cdr key))))) (success! "Initialized %d packages" (length doom-packages))
(condition-case-unless-debug ex
(let ((doctor-file (doom-module-path (car key) (cdr key) "doctor.el")) (section! "Checking Doom core for irregularities...")
(packages-file (doom-module-path (car key) (cdr key) "packages.el"))) (let ((indent (+ indent 2)))
(cl-loop with doom--stage = 'packages (load (expand-file-name "doctor.el" doom-core-dir) nil 'nomessage))
for name in (let (doom-packages
doom-disabled-packages) (section! "Checking for stale elc files in your DOOMDIR...")
(load packages-file 'noerror 'nomessage) (when (file-directory-p doom-private-dir)
(mapcar #'car doom-packages)) (let ((indent (+ indent 2)))
unless (or (doom-package-prop name :disable) (elc-check-dir doom-private-dir)))
(doom-package-prop name :ignore t)
(package-built-in-p name) (when doom-modules
(package-installed-p name)) (section! "Checking your enabled modules...")
do (error! "%s is not installed" name)) (let ((indent (+ indent 2)))
(let ((doom--stage 'doctor)) (advice-add #'require :around #'doom*shut-up)
(load doctor-file 'noerror 'nomessage))) (maphash
(file-missing (error! "%s" (error-message-string ex))) (lambda (key plist)
(error (error! "Syntax error: %s" ex))))) (let ((prefix (format "%s" (color 1 "(%s %s) " (car key) (cdr key)))))
doom-modules)))) (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")))
(cl-loop with doom--stage = 'packages
for name in (let (doom-packages
doom-disabled-packages)
(load packages-file 'noerror 'nomessage)
(mapcar #'car doom-packages))
unless (or (doom-package-prop name :disable)
(doom-package-prop name :ignore t)
(package-built-in-p name)
(package-installed-p name))
do (error! "%s is not installed" name))
(let ((doom--stage 'doctor))
(load doctor-file 'noerror 'nomessage)))
(file-missing (error! "%s" (error-message-string ex)))
(error (error! "Syntax error: %s" ex)))))
doom-modules)))))
(error (error
(warn! "Attempt to load DOOM: failed\n %s\n" (warn! "Attempt to load DOOM failed\n %s\n"
(or (cdr-safe ex) (car ex))) (or (cdr-safe ex) (car ex)))
(setq doom-modules nil))) (setq doom-modules nil)))