mirror of
https://gitlab.com/dwt1/dotfiles.git
synced 2026-04-22 19:10:24 +10:00
Updating Doom Emacs.
This commit is contained in:
Derek Taylor
@@ -1,5 +1,37 @@
|
||||
;;; core/autoload/debug.el -*- lexical-binding: t; -*-
|
||||
|
||||
;;
|
||||
;;; Doom's debug mode
|
||||
|
||||
;;;###autoload
|
||||
(defvar doom-debug-variables
|
||||
'(doom-debug-p
|
||||
init-file-debug
|
||||
debug-on-error
|
||||
garbage-collection-messages
|
||||
use-package-verbose
|
||||
jka-compr-verbose
|
||||
lsp-log-io
|
||||
gcmh-verbose
|
||||
magit-refresh-verbose
|
||||
url-debug)
|
||||
"A list of variable to toggle on `doom-debug-mode'.")
|
||||
|
||||
;;;###autoload
|
||||
(define-minor-mode doom-debug-mode
|
||||
"Toggle `debug-on-error' and `doom-debug-p' for verbose logging."
|
||||
:init-value doom-debug-p
|
||||
:global t
|
||||
(let ((value
|
||||
(cond ((eq arg 'toggle) (not doom-debug-mode))
|
||||
((> (prefix-numeric-value arg) 0)))))
|
||||
(mapc (doom-rpartial #'set value) doom-debug-variables)
|
||||
(message "Debug mode %s" (if value "on" "off"))))
|
||||
|
||||
|
||||
;;
|
||||
;;; Hooks
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-run-all-startup-hooks-h ()
|
||||
"Run all startup Emacs hooks. Meant to be executed after starting Emacs with
|
||||
@@ -17,36 +49,44 @@
|
||||
;;
|
||||
;;; Helpers
|
||||
|
||||
(defun doom-template-insert (template)
|
||||
"TODO"
|
||||
(let ((file (expand-file-name (format "templates/%s" template) doom-core-dir)))
|
||||
(when (file-exists-p file)
|
||||
(insert-file-contents file))))
|
||||
(defsubst doom--collect-forms-in (file form)
|
||||
(when (file-readable-p file)
|
||||
(let (forms)
|
||||
(with-temp-buffer
|
||||
(insert-file-contents file)
|
||||
(let (emacs-lisp-mode) (emacs-lisp-mode))
|
||||
(while (re-search-forward (format "(%s " (regexp-quote form)) nil t)
|
||||
(let ((ppss (syntax-ppss)))
|
||||
(unless (or (nth 4 ppss)
|
||||
(nth 3 ppss))
|
||||
(save-excursion
|
||||
(goto-char (match-beginning 0))
|
||||
(push (sexp-at-point) forms)))))
|
||||
(nreverse forms)))))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom-info ()
|
||||
"Returns diagnostic information about the current Emacs session in markdown,
|
||||
ready to be pasted in a bug report on github."
|
||||
(require 'vc-git)
|
||||
(require 'core-packages)
|
||||
(let ((default-directory doom-emacs-dir)
|
||||
(doom-modules (doom-modules)))
|
||||
(cl-letf
|
||||
(((symbol-function 'sh)
|
||||
(lambda (&rest args)
|
||||
(cdr (apply #'doom-call-process args)))))
|
||||
(doom-modules (doom-module-list)))
|
||||
(letf! (defun sh (&rest args) (cdr (apply #'doom-call-process args)))
|
||||
`((emacs
|
||||
(version . ,emacs-version)
|
||||
(features ,@system-configuration-features)
|
||||
(build . ,(format-time-string "%b %d, %Y" emacs-build-time))
|
||||
(buildopts ,system-configuration-options)
|
||||
(windowsys . ,(if noninteractive 'batch window-system))
|
||||
(windowsys . ,(if doom-interactive-p window-system 'batch))
|
||||
(daemonp . ,(cond ((daemonp) 'daemon)
|
||||
((and (require 'server)
|
||||
(server-running-p))
|
||||
'server-running))))
|
||||
(doom
|
||||
(version . ,doom-version)
|
||||
(build . ,(sh "git" "log" "-1" "--format=%D %h %ci")))
|
||||
(build . ,(sh "git" "log" "-1" "--format=%D %h %ci"))
|
||||
(dir . ,(abbreviate-file-name (file-truename doom-private-dir))))
|
||||
(system
|
||||
(type . ,system-type)
|
||||
(config . ,system-configuration)
|
||||
@@ -79,14 +119,19 @@ ready to be pasted in a bug report on github."
|
||||
'("n/a")))
|
||||
(packages
|
||||
,@(or (condition-case e
|
||||
(cl-loop for (name . plist) in (doom-package-list)
|
||||
if (cl-find :private (plist-get plist :modules)
|
||||
:key #'car)
|
||||
collect
|
||||
(if-let (splist (doom-plist-delete (copy-sequence plist)
|
||||
:modules))
|
||||
(prin1-to-string (cons name splist))
|
||||
name))
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"package!"))
|
||||
(error (format "<%S>" e)))
|
||||
'("n/a")))
|
||||
(unpin
|
||||
,@(or (condition-case e
|
||||
(mapcan #'identity
|
||||
(mapcar
|
||||
#'cdr (doom--collect-forms-in
|
||||
(doom-path doom-private-dir "packages.el")
|
||||
"unpin!")))
|
||||
(error (format "<%S>" e)))
|
||||
'("n/a")))
|
||||
(elpa
|
||||
@@ -109,13 +154,13 @@ branch and commit."
|
||||
(interactive)
|
||||
(require 'vc-git)
|
||||
(let ((default-directory doom-core-dir))
|
||||
(print! "Doom v%s (Emacs v%s)\nBranch: %s\nCommit: %s\nBuild date: %s"
|
||||
(print! "Doom v%s (%s)\nEmacs v%s\nBranch: %s\nBuild date: %s"
|
||||
doom-version
|
||||
(or (vc-git-working-revision doom-core-dir)
|
||||
"n/a")
|
||||
emacs-version
|
||||
(or (vc-git--symbolic-ref doom-core-dir)
|
||||
"n/a")
|
||||
(or (vc-git-working-revision doom-core-dir)
|
||||
"n/a")
|
||||
(or (cdr (doom-call-process "git" "log" "-1" "--format=%ci"))
|
||||
"n/a"))))
|
||||
|
||||
@@ -127,22 +172,23 @@ markdown and copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
(let ((buffer (get-buffer-create "*doom-info*"))
|
||||
(info (doom-info)))
|
||||
(with-current-buffer buffer
|
||||
(unless (or noninteractive
|
||||
(eq major-mode 'markdown-mode)
|
||||
(not (fboundp 'markdown-mode)))
|
||||
(markdown-mode))
|
||||
(or (not doom-interactive-p)
|
||||
(eq major-mode 'markdown-mode)
|
||||
(not (fboundp 'markdown-mode))
|
||||
(markdown-mode))
|
||||
(erase-buffer)
|
||||
(if raw
|
||||
(progn
|
||||
(save-excursion
|
||||
(pp info (current-buffer)))
|
||||
(when (search-forward "(modules " nil t)
|
||||
(goto-char (match-beginning 0))
|
||||
(cl-destructuring-bind (beg . end)
|
||||
(bounds-of-thing-at-point 'sexp)
|
||||
(let ((sexp (prin1-to-string (sexp-at-point))))
|
||||
(delete-region beg end)
|
||||
(insert sexp)))))
|
||||
(dolist (sym '(modules packages))
|
||||
(when (re-search-forward (format "^ *\\((%s\\)" sym) nil t)
|
||||
(goto-char (match-beginning 1))
|
||||
(cl-destructuring-bind (beg . end)
|
||||
(bounds-of-thing-at-point 'sexp)
|
||||
(let ((sexp (prin1-to-string (sexp-at-point))))
|
||||
(delete-region beg end)
|
||||
(insert sexp))))))
|
||||
(insert "<details>\n\n```\n")
|
||||
(dolist (group info)
|
||||
(insert! "%-8s%-10s %s\n"
|
||||
@@ -153,7 +199,7 @@ markdown and copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
(insert! (indent 8 "%-10s %s\n")
|
||||
((car spec) (cdr spec)))))
|
||||
(insert "```\n</details>"))
|
||||
(if noninteractive
|
||||
(if (not doom-interactive-p)
|
||||
(print! (buffer-string))
|
||||
(switch-to-buffer buffer)
|
||||
(kill-new (buffer-string))
|
||||
@@ -161,15 +207,45 @@ markdown and copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/am-i-secure ()
|
||||
"Test to see if your root certificates are securely configured in emacs."
|
||||
"Test to see if your root certificates are securely configured in emacs.
|
||||
Some items are not supported by the `nsm.el' module."
|
||||
(declare (interactive-only t))
|
||||
(interactive)
|
||||
(unless (string-match-p "\\_<GNUTLS\\_>" system-configuration-features)
|
||||
(warn "gnutls support isn't built into Emacs, there may be problems"))
|
||||
(if-let* ((bad-hosts
|
||||
(cl-loop for bad
|
||||
in '("https://wrong.host.badssl.com/"
|
||||
"https://self-signed.badssl.com/")
|
||||
in '("https://expired.badssl.com/"
|
||||
"https://wrong.host.badssl.com/"
|
||||
"https://self-signed.badssl.com/"
|
||||
"https://untrusted-root.badssl.com/"
|
||||
;; "https://revoked.badssl.com/"
|
||||
;; "https://pinning-test.badssl.com/"
|
||||
"https://sha1-intermediate.badssl.com/"
|
||||
"https://rc4-md5.badssl.com/"
|
||||
"https://rc4.badssl.com/"
|
||||
"https://3des.badssl.com/"
|
||||
"https://null.badssl.com/"
|
||||
"https://sha1-intermediate.badssl.com/"
|
||||
;; "https://client-cert-missing.badssl.com/"
|
||||
"https://dh480.badssl.com/"
|
||||
"https://dh512.badssl.com/"
|
||||
"https://dh-small-subgroup.badssl.com/"
|
||||
"https://dh-composite.badssl.com/"
|
||||
"https://invalid-expected-sct.badssl.com/"
|
||||
;; "https://no-sct.badssl.com/"
|
||||
;; "https://mixed-script.badssl.com/"
|
||||
;; "https://very.badssl.com/"
|
||||
"https://subdomain.preloaded-hsts.badssl.com/"
|
||||
"https://superfish.badssl.com/"
|
||||
"https://edellroot.badssl.com/"
|
||||
"https://dsdtestprovider.badssl.com/"
|
||||
"https://preact-cli.badssl.com/"
|
||||
"https://webpack-dev-server.badssl.com/"
|
||||
"https://captive-portal.badssl.com/"
|
||||
"https://mitm-software.badssl.com/"
|
||||
"https://sha1-2016.badssl.com/"
|
||||
"https://sha1-2017.badssl.com/")
|
||||
if (condition-case _e
|
||||
(url-retrieve-synchronously bad)
|
||||
(error nil))
|
||||
@@ -193,48 +269,59 @@ markdown and copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
(file (make-temp-file "doom-sandbox-")))
|
||||
(require 'package)
|
||||
(with-temp-file file
|
||||
(insert
|
||||
(prin1-to-string
|
||||
(macroexp-progn
|
||||
(append `((setq noninteractive nil
|
||||
doom-debug-mode t
|
||||
load-path ',load-path
|
||||
package--init-file-ensured t
|
||||
package-user-dir ,package-user-dir
|
||||
package-archives ',package-archives
|
||||
user-emacs-directory ,doom-emacs-dir)
|
||||
(with-eval-after-load 'undo-tree
|
||||
;; undo-tree throws errors because `buffer-undo-tree' isn't
|
||||
;; corrrectly initialized
|
||||
(setq-default buffer-undo-tree (make-undo-tree))))
|
||||
(pcase mode
|
||||
(`vanilla-doom+ ; Doom core + modules - private config
|
||||
`((load-file ,(expand-file-name "core.el" doom-core-dir))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core)
|
||||
(add-hook 'window-setup-hook #'doom-display-benchmark-h)
|
||||
(setq doom-modules ',doom-modules)
|
||||
(maphash (lambda (key plist)
|
||||
(let ((doom--current-module key)
|
||||
(doom--current-flags (plist-get plist :flags)))
|
||||
(load! "init" (doom-module-locate-path (car key) (cdr key)) t)))
|
||||
doom-modules)
|
||||
(maphash (lambda (key plist)
|
||||
(let ((doom--current-module key)
|
||||
(doom--current-flags (plist-get plist :flags)))
|
||||
(load! "config" (doom-module-locate-path (car key) (cdr key)) t)))
|
||||
doom-modules)
|
||||
(run-hook-wrapped 'doom-init-modules-hook #'doom-try-run-hook)
|
||||
(doom-run-all-startup-hooks-h)))
|
||||
(`vanilla-doom ; only Doom core
|
||||
`((load-file ,(expand-file-name "core.el" doom-core-dir))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core)
|
||||
(doom-run-all-startup-hooks-h)))
|
||||
(`vanilla ; nothing loaded
|
||||
`((package-initialize)))))))
|
||||
"\n(unwind-protect (progn\n" contents "\n)\n"
|
||||
(format "(delete-file %S))" file)))
|
||||
(prin1 `(progn
|
||||
(setq noninteractive nil
|
||||
process-environment ',doom--initial-process-environment
|
||||
exec-path ',doom--initial-exec-path
|
||||
init-file-debug t
|
||||
load-path ',load-path
|
||||
package--init-file-ensured t
|
||||
package-user-dir ,package-user-dir
|
||||
package-archives ',package-archives
|
||||
user-emacs-directory ,doom-emacs-dir)
|
||||
(with-eval-after-load 'undo-tree
|
||||
;; undo-tree throws errors because `buffer-undo-tree' isn't
|
||||
;; correctly initialized
|
||||
(setq-default buffer-undo-tree (make-undo-tree)))
|
||||
(ignore-errors
|
||||
(delete-directory ,(expand-file-name "auto-save-list" doom-emacs-dir) 'parents)))
|
||||
(current-buffer))
|
||||
(prin1 `(unwind-protect
|
||||
(defun --run-- () ,(read (concat "(progn\n" contents "\n)")))
|
||||
(delete-file ,file))
|
||||
(current-buffer))
|
||||
(prin1 (pcase mode
|
||||
(`vanilla-doom+ ; Doom core + modules - private config
|
||||
`(progn
|
||||
(load-file ,(expand-file-name "core.el" doom-core-dir))
|
||||
(setq doom-modules-dirs (list doom-modules-dir))
|
||||
(let ((doom-init-modules-p t))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core-modules))
|
||||
(setq doom-modules ',doom-modules)
|
||||
(maphash (lambda (key plist)
|
||||
(doom-module-put
|
||||
(car key) (cdr key)
|
||||
:path (doom-module-locate-path (car key) (cdr key))))
|
||||
doom-modules)
|
||||
(--run--)
|
||||
(maphash (doom-module-loader doom-module-init-file) doom-modules)
|
||||
(maphash (doom-module-loader doom-module-config-file) doom-modules)
|
||||
(run-hook-wrapped 'doom-init-modules-hook #'doom-try-run-hook)
|
||||
(doom-run-all-startup-hooks-h)))
|
||||
(`vanilla-doom ; only Doom core
|
||||
`(progn
|
||||
(load-file ,(expand-file-name "core.el" doom-core-dir))
|
||||
(let ((doom-init-modules-p t))
|
||||
(doom-initialize)
|
||||
(doom-initialize-core-modules))
|
||||
(--run--)
|
||||
(doom-run-all-startup-hooks-h)))
|
||||
(`vanilla ; nothing loaded
|
||||
`(progn
|
||||
(package-initialize)
|
||||
(--run--))))
|
||||
(current-buffer)))
|
||||
(let ((args (if (eq mode 'doom)
|
||||
(list "-l" file)
|
||||
(list "-Q" "-l" file))))
|
||||
@@ -254,10 +341,10 @@ markdown and copies it to your clipboard, ready to be pasted into bug reports!"
|
||||
(delete-file file)
|
||||
(signal (car e) (cdr e)))))))
|
||||
|
||||
(fset 'doom--run-vanilla-emacs (lambda! (doom--run-sandbox 'vanilla)))
|
||||
(fset 'doom--run-vanilla-doom (lambda! (doom--run-sandbox 'vanilla-doom)))
|
||||
(fset 'doom--run-vanilla-doom+ (lambda! (doom--run-sandbox 'vanilla-doom+)))
|
||||
(fset 'doom--run-full-doom (lambda! (doom--run-sandbox 'doom)))
|
||||
(fset 'doom--run-vanilla-emacs (cmd! (doom--run-sandbox 'vanilla)))
|
||||
(fset 'doom--run-vanilla-doom (cmd! (doom--run-sandbox 'vanilla-doom)))
|
||||
(fset 'doom--run-vanilla-doom+ (cmd! (doom--run-sandbox 'vanilla-doom+)))
|
||||
(fset 'doom--run-full-doom (cmd! (doom--run-sandbox 'doom)))
|
||||
|
||||
(defvar doom-sandbox-emacs-lisp-mode-map
|
||||
(let ((map (make-sparse-keymap)))
|
||||
@@ -293,7 +380,7 @@ to reproduce bugs and determine if Doom is to blame."
|
||||
(doom-sandbox-emacs-lisp-mode)
|
||||
(setq-local default-directory doom-emacs-dir)
|
||||
(unless (buffer-live-p exists)
|
||||
(doom-template-insert "VANILLA_SANDBOX")
|
||||
(insert-file-contents (doom-glob doom-core-dir "templates/VANILLA_SANDBOX"))
|
||||
(let ((contents (substitute-command-keys (buffer-string))))
|
||||
(erase-buffer)
|
||||
(insert contents "\n")))
|
||||
@@ -328,17 +415,3 @@ will be automatically appended to the result."
|
||||
(profiler-report)
|
||||
(profiler-stop))
|
||||
(setq doom--profiler (not doom--profiler)))
|
||||
|
||||
;;;###autoload
|
||||
(defun doom/toggle-debug-mode (&optional arg)
|
||||
"Toggle `debug-on-error' and `doom-debug-mode' for verbose logging."
|
||||
(interactive (list (or current-prefix-arg 'toggle)))
|
||||
(let ((value
|
||||
(cond ((eq arg 'toggle) (not doom-debug-mode))
|
||||
((> (prefix-numeric-value arg) 0)))))
|
||||
(setq doom-debug-mode value
|
||||
debug-on-error value
|
||||
jka-compr-verbose value
|
||||
lsp-log-io value
|
||||
gcmh-verbose value)
|
||||
(message "Debug mode %s" (if value "on" "off"))))
|
||||
|
||||
Reference in New Issue
Block a user