Rewrite doctor; move warn! blocks out in doctor.el files
This commit is contained in:
Henrik Lissner
parent
5c36519dab
commit
74c8b1d113
16 changed files with 193 additions and 147 deletions
196
bin/doom-doctor
196
bin/doom-doctor
|
|
@ -7,14 +7,14 @@
|
|||
|
||||
;; In case it isn't defined (in really old versions of Emacs, like the one that
|
||||
;; ships with MacOS).
|
||||
(defvar user-emacs-directory (expand-file-name "~/.emacs.d/"))
|
||||
(defvar user-emacs-directory (expand-file-name "../" (file-name-directory load-file-name)))
|
||||
|
||||
(unless (equal (expand-file-name user-emacs-directory)
|
||||
(expand-file-name "~/.emacs.d/"))
|
||||
(error "Couldn't find ~/.emacs.d"))
|
||||
(unless (file-directory-p user-emacs-directory)
|
||||
(error "Couldn't find a Doom config!"))
|
||||
|
||||
(require 'pp)
|
||||
|
||||
;; subr-x may not exist in the current version of Emacs
|
||||
(defsubst string-trim-right (string &optional regexp)
|
||||
(if (string-match (concat "\\(?:" (or regexp "[ \t\n\r]+") "\\)\\'") string)
|
||||
(replace-match "" t t string)
|
||||
|
|
@ -23,18 +23,23 @@
|
|||
;;
|
||||
(defvar doom-init-p nil)
|
||||
(defvar doom-errors 0)
|
||||
(defmacro check! (cond &rest body)
|
||||
(defmacro when! (cond &rest body)
|
||||
(declare (indent defun))
|
||||
`(let ((it ,cond))
|
||||
(when it
|
||||
,@body
|
||||
(setq doom-errors (1+ doom-errors)))))
|
||||
(when it ,@body)))
|
||||
|
||||
(defun indented (spc msg)
|
||||
(declare (indent defun))
|
||||
(with-temp-buffer
|
||||
(insert msg)
|
||||
(indent-rigidly (point-min) (point-max) spc)
|
||||
(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)
|
||||
|
|
@ -69,12 +74,17 @@
|
|||
(defun color (code msg &rest args)
|
||||
(format "\e[%dm%s\e[%dm" code (apply #'format msg args) 0))
|
||||
|
||||
(defalias 'msg! #'message)
|
||||
(defmacro error! (&rest args) `(msg! (color 1 (color 31 ,@args))))
|
||||
(defmacro warn! (&rest args) `(msg! (color 1 (color 33 ,@args))))
|
||||
(defmacro success! (&rest args) `(msg! (color 1 (color 32 ,@args))))
|
||||
(defmacro section! (&rest args) `(msg! (color 34 ,@args)))
|
||||
(defmacro explain! (&rest args) `(msg! (indented 2 (autofill ,@args))))
|
||||
(defvar indent 0)
|
||||
(defmacro msg! (msg &rest args)
|
||||
`(message (indented indent (format ,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-errors (+ doom-errors 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))))
|
||||
|
||||
;;; Polyfills
|
||||
;; early versions of emacs won't have this
|
||||
|
|
@ -86,10 +96,21 @@
|
|||
|
||||
;; --- start a'doctorin' --------------------------------------
|
||||
|
||||
(msg! "%s\nRunning Emacs v%s, commit %s\n"
|
||||
(color 1 "DOOM Doctor")
|
||||
(color 1 emacs-version)
|
||||
(if (executable-find "git")
|
||||
(msg! "%s" (color 1 "DOOM Doctor"))
|
||||
(msg! "Emacs v%s" emacs-version)
|
||||
(msg! "Doom v%s"
|
||||
(or (and (file-exists-p (expand-file-name "core/core.el" user-emacs-directory))
|
||||
(with-temp-buffer
|
||||
(insert-file-contents-literally
|
||||
(expand-file-name "core/core.el" user-emacs-directory))
|
||||
(goto-char (point-min))
|
||||
(when (re-search-forward "doom-version")
|
||||
(forward-char)
|
||||
(sexp-at-point))))
|
||||
"???"))
|
||||
(msg! "Commit %s"
|
||||
(if (and (executable-find "git")
|
||||
(file-directory-p (expand-file-name ".git" user-emacs-directory)))
|
||||
(sh "git rev-parse HEAD")
|
||||
"n/a"))
|
||||
|
||||
|
|
@ -102,29 +123,12 @@
|
|||
(msg! "Compiled with:\n%s" (indented 2 (autofill system-configuration-features))))
|
||||
(msg! "uname -a:\n%s\n" (indented 2 (autofill (sh "uname -a"))))
|
||||
|
||||
(let (doom-core-packages doom-debug-mode)
|
||||
(condition-case ex
|
||||
(progn
|
||||
(let ((inhibit-message t)
|
||||
noninteractive)
|
||||
(load "~/.emacs.d/init.el" nil t))
|
||||
(doom-initialize-packages)
|
||||
(doom|finalize)
|
||||
(success! "Attempt to load DOOM: success! Loaded v%s" doom-version)
|
||||
(when (executable-find "git")
|
||||
(msg! "Revision %s\n"
|
||||
(ignore-errors
|
||||
(let ((default-directory user-emacs-directory))
|
||||
(sh "git rev-parse HEAD"))))))
|
||||
('error (warn! "Attempt to load DOOM: failed\n %s\n"
|
||||
(or (cdr-safe ex) (car ex))))))
|
||||
|
||||
(msg! "----\n")
|
||||
|
||||
;; --- is emacs set up properly? ------------------------------
|
||||
|
||||
(section! "test-emacs")
|
||||
(check! (version< emacs-version "25.1")
|
||||
(when (version< emacs-version "25.1")
|
||||
(error! "Important: Emacs %s detected [%s]" emacs-version (executable-find "emacs"))
|
||||
(explain!
|
||||
"DOOM only supports >= 25.1. Perhaps your PATH wasn't set up properly."
|
||||
|
|
@ -137,7 +141,7 @@
|
|||
|
||||
;; windows? windows
|
||||
(section! "test-windows")
|
||||
(check! (memq system-type '(windows-nt ms-dos cygwin))
|
||||
(when (memq system-type '(windows-nt ms-dos cygwin))
|
||||
(warn! "Warning: Windows detected")
|
||||
(explain! "DOOM was designed for MacOS and Linux. Expect a bumpy ride!"))
|
||||
|
||||
|
|
@ -175,8 +179,8 @@
|
|||
(add-to-list 'protos (cadr (split-string row " " t))))
|
||||
(split-string (sh "openssl ciphers -v") "\n"))
|
||||
(delq nil protos))))
|
||||
(check! (not (or (member "TLSv1.1" protocols)
|
||||
(member "TLSv1.2" protocols)))
|
||||
(unless (or (member "TLSv1.1" protocols)
|
||||
(member "TLSv1.2" protocols))
|
||||
(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)
|
||||
(explain!
|
||||
|
|
@ -186,20 +190,19 @@
|
|||
|
||||
"Please consider updating (or install gnutls-cli, which is preferred).")))))
|
||||
(t
|
||||
(check! t
|
||||
(error! "Important: couldn't find either gnutls-cli nor openssl")
|
||||
(explain!
|
||||
"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 "
|
||||
"reason you can't, you can bypass this verification with the INSECURE flag:\n\n"
|
||||
(error! "Important: couldn't find either gnutls-cli nor openssl")
|
||||
(explain!
|
||||
"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 "
|
||||
"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 "
|
||||
"network, provider, government, neckbearded mother-in-laws, geeky roommates, "
|
||||
"or just about anyone who knows more about computers than you do!"))))
|
||||
"But remember that you're leaving your security in the hands of your "
|
||||
"network, provider, government, neckbearded mother-in-laws, geeky roommates, "
|
||||
"or just about anyone who knows more about computers than you do!")))
|
||||
|
||||
(section! "test-tls")
|
||||
(cond ((not (string-match-p "\\_<GNUTLS\\_>" system-configuration-features))
|
||||
|
|
@ -222,12 +225,12 @@
|
|||
(let ((tls-checktrust t)
|
||||
(gnutls-verify-error t))
|
||||
(dolist (url '("https://elpa.gnu.org" "https://melpa.org"))
|
||||
(check! (condition-case-unless-debug e
|
||||
(if (let ((inhibit-message t)) (url-retrieve-synchronously url))
|
||||
(ignore (success! "Validated %s" url))
|
||||
'empty)
|
||||
('timed-out 'timeout)
|
||||
('error e))
|
||||
(when! (condition-case-unless-debug e
|
||||
(if (let ((inhibit-message t)) (url-retrieve-synchronously url))
|
||||
(ignore (success! "Validated %s" 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))
|
||||
|
|
@ -236,27 +239,26 @@
|
|||
(explain! (pp-to-string it))))))
|
||||
(dolist (url '("https://self-signed.badssl.com"
|
||||
"https://wrong.host.badssl.com/"))
|
||||
(check! (condition-case-unless-debug e
|
||||
(if (let ((inhibit-message t)) (url-retrieve-synchronously url))
|
||||
t
|
||||
'empty)
|
||||
('timed-out 'timeout)
|
||||
('error (ignore (success! "Successfully rejected %s" url))))
|
||||
(when! (condition-case-unless-debug e
|
||||
(if (let ((inhibit-message t)) (url-retrieve-synchronously url))
|
||||
t
|
||||
'empty)
|
||||
('timed-out 'timeout)
|
||||
('error (ignore (success! "Successfully rejected %s" url))))
|
||||
(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)))))))
|
||||
|
||||
(t
|
||||
(error! "Nope!")))
|
||||
((error! "Nope!")))
|
||||
|
||||
;; bsd vs gnu tar
|
||||
(section! "test-tar")
|
||||
(let ((tar-bin (or (executable-find "gtar")
|
||||
(executable-find "tar"))))
|
||||
(if tar-bin
|
||||
(check! (not (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")
|
||||
(explain!
|
||||
"QUELPA (through package-build) uses the system tar to build plugins, but it "
|
||||
|
|
@ -265,14 +267,56 @@
|
|||
(when (eq system-type 'darwin)
|
||||
(concat "\nMacOS users can install gnu-tar via homebrew:\n"
|
||||
" brew install gnu-tar"))))
|
||||
(check! t ; very unlikely
|
||||
(error! "Important: Couldn't find tar")
|
||||
(explain!
|
||||
"This is required by package.el and QUELPA to build packages and will "
|
||||
"prevent you from installing & updating packages."))))
|
||||
(error! "Important: Couldn't find tar")
|
||||
(explain!
|
||||
"This is required by package.el and QUELPA to build packages and will "
|
||||
"prevent you from installing & updating packages.")))
|
||||
|
||||
|
||||
;; --- are your modules set up properly? ----------------------
|
||||
|
||||
(message "\n----")
|
||||
(let (doom-core-packages doom-debug-mode)
|
||||
(condition-case ex
|
||||
(progn
|
||||
(let ((inhibit-message t)
|
||||
noninteractive)
|
||||
(load "~/.emacs.d/init.el" nil t))
|
||||
(doom-initialize-packages)
|
||||
(doom|finalize)
|
||||
(success! "Attempt to load DOOM: success! Loaded v%s" doom-version)
|
||||
(when (executable-find "git")
|
||||
(msg! "Revision %s\n"
|
||||
(ignore-errors
|
||||
(let ((default-directory user-emacs-directory))
|
||||
(sh "git rev-parse HEAD"))))))
|
||||
('error (warn! "Attempt to load DOOM: failed\n %s\n"
|
||||
(or (cdr-safe ex) (car ex))))))
|
||||
|
||||
(when (bound-and-true-p doom-modules)
|
||||
(section! "test-modules")
|
||||
(let ((indent 4))
|
||||
(maphash
|
||||
(lambda (key plist)
|
||||
(condition-case ex
|
||||
(let ((doctor-file (doom-module-expand-file (car key) (cdr key) "doctor.el"))
|
||||
(packages-file (doom-module-expand-file (car key) (cdr key) "packages.el"))
|
||||
doom-packages)
|
||||
(when (or (file-exists-p doctor-file)
|
||||
(file-exists-p packages-file))
|
||||
(let ((indent 2))
|
||||
(section! "test-module -> %s %s" (car key) (cdr key)))
|
||||
(load packages-file t t)
|
||||
(when (load packages-file t t)
|
||||
(dolist (package (cl-remove-if #'package-installed-p doom-packages :key #'car))
|
||||
(error! "%s is not installed" (car package))))
|
||||
(load doctor-file t t)))
|
||||
('error
|
||||
(error! "Syntax error: %s" ex))))
|
||||
doom-modules)))
|
||||
|
||||
;;
|
||||
(if (= doom-errors 0)
|
||||
(success! "Everything seems fine, happy Emacs'ing!")
|
||||
(message "\n----")
|
||||
(warn! "There were issues!"))
|
||||
(message "\n----")
|
||||
(if (> doom-errors 0)
|
||||
(warn! "There were %s issues!" doom-errors)
|
||||
(success! "Everything seems fine, happy Emacs'ing!"))
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue