yogsototh/doom-emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions 1

Rewrite doom-doctor

Browse source 
- 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
This commit is contained in:
Henrik Lissner 2019-04-23 12:41:46 -04:00
parent 51a28249bd
commit 9bea168cc1
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
5 changed files with 144 additions and 103 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

3
bin/doom
View file

@ -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

160
bin/doom-doctor
View file

@ -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))

67
core/autoload/message.el
View file

@ -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))

8
core/doctor.el
View file

@ -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"

9
core/test/test-autoload-message.el
View file

@ -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)))))