Rewrite doctor; move warn! blocks out in doctor.el files

This commit is contained in:
Henrik Lissner 2018-03-12 13:16:16 -04:00
parent 5c36519dab
commit 74c8b1d113
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
16 changed files with 193 additions and 147 deletions

View file

@ -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)
(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,7 +190,6 @@
"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 "
@ -199,7 +202,7 @@
"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!"))))
"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,7 +225,7 @@
(let ((tls-checktrust t)
(gnutls-verify-error t))
(dolist (url '("https://elpa.gnu.org" "https://melpa.org"))
(check! (condition-case-unless-debug e
(when! (condition-case-unless-debug e
(if (let ((inhibit-message t)) (url-retrieve-synchronously url))
(ignore (success! "Validated %s" url))
'empty)
@ -236,7 +239,7 @@
(explain! (pp-to-string it))))))
(dolist (url '("https://self-signed.badssl.com"
"https://wrong.host.badssl.com/"))
(check! (condition-case-unless-debug e
(when! (condition-case-unless-debug e
(if (let ((inhibit-message t)) (url-retrieve-synchronously url))
t
'empty)
@ -248,15 +251,14 @@
(_
(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."))))
"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!"))

View file

@ -35,11 +35,6 @@
(strike . 9))
"List of styles.")
(defvar doom-demote-warnings nil
"If non-nil, Doom module warnings (the ones that pop up when you're missing a
dependency) will only log a message in *Messages* instead of opening a
*Warnings* window.")
;;;###autoload
(defun doom-ansi-apply (code message &rest args)
"Apply the ansi CODE to formatted MESSAGE with ARGS."
@ -85,26 +80,6 @@ interactive session."
(pop-to-buffer buf)
(goto-char (point-max)))))
;;;###autoload
(defmacro warn! (message &rest args)
"Output a colored warning for the current module in the *Messages* buffer."
(let ((load-file-name (or load-file-name byte-compile-current-file)))
(if (cl-loop for dir in doom-modules-dirs
if (file-in-directory-p load-file-name dir)
return t)
`(cl-destructuring-bind (cat . mod)
(doom-module-from-path ,load-file-name)
(if doom-demote-warnings
(message "WARNING (%s %s) %s" cat mod (format ,message ,@args))
(delay-warning (format "%s %s" cat mod) (format ,message ,@args)
:warning)))
`(if doom-demote-warnings
(message "WARNING (%s) %s"
(file-relative-name load-file-name doom-emacs-dir)
(format ,message ,@args))
(delay-warning (file-relative-name load-file-name doom-emacs-dir)
(format ,message ,@args) :warning)))))
;;;###autoload
(defmacro log! (message &rest args)
"Output a debug message if `doom-debug-mode' is non-nil. Otherwise, ignore this."

View file

@ -136,8 +136,6 @@ compilation database is present in the project.")
(irony-mode +1)))
(add-hook! (c-mode c++-mode objc-mode) #'+cc|init-irony-mode)
:config
(unless (file-directory-p irony-server-install-prefix)
(warn! "Irony server isn't installed. Run M-x irony-install-server"))
;; Initialize compilation database, if present. Otherwise, fall back on
;; `+cc-default-compiler-options'.
(add-hook 'irony-mode-hook #'+cc|irony-init-compile-options))
@ -205,8 +203,6 @@ compilation database is present in the project.")
:when (featurep! :completion company)
:after glsl-mode
:config
(unless (executable-find "glslangValidator")
(warn! "Couldn't find glslangValidator. Code completion is disabled"))
(set! :company-backend 'glsl-mode '(company-glsl)))
@ -228,10 +224,6 @@ compilation database is present in the project.")
;; ...and don't auto-jump to first match before making a selection.
rtags-jump-to-first-match nil)
(let ((bins (cl-remove-if #'executable-find '("rdm" "rc"))))
(when (/= (length bins) 0)
(warn! "Couldn't find the rtag client and/or server programs %s. Disabling rtags support" bins)))
(set! :lookup '(c-mode c++-mode)
:definition #'rtags-find-symbol-at-point
:references #'rtags-find-references-at-point)

16
modules/lang/cc/doctor.el Normal file
View file

@ -0,0 +1,16 @@
;;; lang/cc/doctor.el -*- lexical-binding: t; -*-
;; rtags
(let ((bins (cl-remove-if #'executable-find '("rdm" "rc"))))
(when (/= (length bins) 0)
(warn! "Couldn't find the rtag client and/or server programs %s. Disabling rtags support" bins)))
;; irony server
(require 'irony)
(unless (file-directory-p irony-server-install-prefix)
(warn! "Irony server isn't installed. Run M-x irony-install-server"))
(when (featurep! :completion company)
;; glslangValidator
(unless (executable-find "glslangValidator")
(warn! "Couldn't find glslangValidator. GLSL code completion is disabled")))

View file

@ -19,7 +19,4 @@
(def-package! inf-crystal
:commands (inf-crystal crystal-switch-to-inf)
:config
(unless (executable-find "icr")
(warn! "Couldn't find icr. REPL will not work")))
:commands (inf-crystal crystal-switch-to-inf))

View file

@ -0,0 +1,4 @@
;;; lang/crystal/doctor.el -*- lexical-binding: t; -*-
(unless (executable-find "icr")
(warn! "Couldn't find icr. REPL will not work"))

View file

@ -78,25 +78,17 @@
:commands (go-guru-describe go-guru-freevars go-guru-implements go-guru-peers
go-guru-referrers go-guru-definition go-guru-pointsto
go-guru-callstack go-guru-whicherrs go-guru-callers go-guru-callees
go-guru-expand-region)
:config
(unless (executable-find "guru")
(warn! "Couldn't find guru. Refactoring commands (go-guru-*) won't work")))
go-guru-expand-region))
(def-package! gorepl-mode
:commands (gorepl-run gorepl-run-load-current-file)
:config
(unless (executable-find "gore")
(warn! "Couldn't find gore. REPL will not work")))
:commands (gorepl-run gorepl-run-load-current-file))
(def-package! company-go
:init (setq command-go-gocode-command "gocode")
:when (featurep! :completion company)
:init (setq command-go-gocode-command "gocode")
:after go-mode
:config
(setq company-go-show-annotation t)
(set! :company-backend 'go-mode '(company-go))
(unless (executable-find command-go-gocode-command)
(warn! "Couldn't find gocode. Code completion won't work")))
(set! :company-backend 'go-mode '(company-go)))

12
modules/lang/go/doctor.el Normal file
View file

@ -0,0 +1,12 @@
;;; lang/go/doctor.el -*- lexical-binding: t; -*-
(unless (executable-find "guru")
(warn! "Couldn't find guru. Refactoring commands (go-guru-*) won't work"))
(unless (executable-find "gore")
(warn! "Couldn't find gore. REPL will not work"))
(when (and (featurep! :completion company)
(require 'company-go nil t))
(unless (executable-find command-go-gocode-command)
(warn! "Couldn't find gocode. Code completion won't work")))

View file

@ -5,9 +5,6 @@
:after haskell-mode
:hook (haskell-mode . dante-mode)
:config
(unless (executable-find "cabal")
(warn! "Couldn't find cabal, haskell-mode may have issues"))
(add-hook 'haskell-mode-hook #'interactive-haskell-mode)
(add-hook 'dante-mode-hook #'flycheck-mode))
@ -18,8 +15,5 @@
:init
(add-hook 'haskell-mode-hook #'ghc-comp-init)
:config
(unless (executable-find "ghc-mod")
(warn! "Couldn't find ghc-mod on PATH. Code completion is disabled."))
(setq company-ghc-show-info 'oneline)
(set! :company-backend 'haskell-mode #'company-ghc))

View file

@ -5,12 +5,7 @@
:after haskell-mode
:config
(add-hook 'haskell-mode-hook #'+haskell|init-intero)
(unless (executable-find "stack")
(warn! "Couldn't find stack. Intero has been disabled."))
(add-hook! 'intero-mode-hook #'(flycheck-mode eldoc-mode))
(set! :lookup 'haskell-mode :definition #'intero-goto-definition))

View file

@ -0,0 +1,13 @@
;;; lang/haskell/doctor.el -*- lexical-binding: t; -*-
(when (featurep! +dante)
(unless (executable-find "cabal")
(warn! "Couldn't find cabal, haskell-mode may have issues"))
(unless (executable-find "ghc-mod")
(warn! "Couldn't find ghc-mod on PATH. Code completion will not work")))
(when (featurep! +intero)
(unless (executable-find "stack")
(warn! "Couldn't find stack. Intero will not work")))

View file

@ -6,12 +6,7 @@
(setq plantuml-jar-path (concat doom-etc-dir "plantuml.jar")
org-plantuml-jar-path plantuml-jar-path)
:config
(set! :popup "^\\*PLANTUML" '((size . 0.4)) '((select) (transient . 0)))
(unless (executable-find "java")
(warn! "Couldn't find java. Disabling plantuml preview."))
(unless (file-exists-p plantuml-jar-path)
(warn! "Couldn't find plantuml.jar. Install it witInstall it with-x +plantuml/install.")))
(set! :popup "^\\*PLANTUML" '((size . 0.4)) '((select) (transient . 0))))
(def-package! flycheck-plantuml

View file

@ -0,0 +1,9 @@
;;; lang/plantuml/doctor.el -*- lexical-binding: t; -*-
(when (require 'plantuml-mode nil t)
;; java
(unless (executable-find "java")
(warn! "Couldn't find java. PlantUML preview or syntax checking won't work"))
;; plantuml.jar
(unless (file-exists-p plantuml-jar-path)
(warn! "Couldn't find plantuml.jar. Install it with-x +plantuml/install")))

View file

@ -19,11 +19,6 @@
(def-package! racer
:after rust-mode
:config
(unless (file-exists-p racer-cmd)
(warn! "Couldn't find racer binary. Code completion won't work"))
(unless (file-directory-p racer-rust-src-path)
(warn! "Couldn't find rust source. Code completion won't work"))
(add-hook! 'rust-mode-hook #'(eldoc-mode racer-mode))
(set! :lookup 'rust-mode
:definition #'racer-find-definition

View file

@ -0,0 +1,9 @@
;;; lang/rust/doctor.el -*- lexical-binding: t; -*-
(when (require 'racer nil t)
;; racer
(unless (file-exists-p racer-cmd)
(warn! "Couldn't find the racer binary at `racer-cmd'"))
;; rust source code (rustup component add rust-src)
(unless (file-directory-p racer-rust-src-path)
(warn! "Couldn't find Rust's source code at RUST_SRC_PATH or `racer-rust-src-path'.")))

View file

@ -0,0 +1,4 @@
;;; ui/posframe/doctor.el -*- lexical-binding: t; -*-
(when (version< emacs-version "26")
(error! "This module doesn't work in Emacs %s (minimum: Emacs 26)" emacs-version))