Split core/autoload/util.el into {help,debug}.el

This commit is contained in:
Henrik Lissner 2018-05-20 12:13:05 +02:00
parent af7fb1c628
commit 7b8917ed42
No known key found for this signature in database
GPG key ID: 5F6C0EA160557395
2 changed files with 176 additions and 162 deletions

View file

@ -1,126 +1,10 @@
;;; core/autoload/util.el -*- lexical-binding: t; -*- ;;; core/autoload/debug.el -*- lexical-binding: t; -*-
;;;###autoload
(defun doom/what-face (&optional pos)
"Shows all faces and overlay faces at point.
Interactively prints the list to the echo area. Noninteractively, returns a list
whose car is the list of faces and cadr is the list of overlay faces."
(interactive)
(let* ((pos (or pos (point)))
(faces (let ((face (get-text-property pos 'face)))
(if (keywordp (car-safe face))
(list face)
(cl-loop for f in (doom-enlist face) collect f))))
(overlays (cl-loop for ov in (overlays-at pos (1+ pos))
nconc (doom-enlist (overlay-get ov 'face)))))
(cond ((called-interactively-p 'any)
(message "%s %s\n%s %s"
(propertize "Faces:" 'face 'font-lock-comment-face)
(if faces
(cl-loop for face in faces
if (listp face)
concat (format "'%s " face)
else
concat (concat (propertize (symbol-name face) 'face face) " "))
"n/a ")
(propertize "Overlays:" 'face 'font-lock-comment-face)
(if overlays
(cl-loop for ov in overlays
concat (concat (propertize (symbol-name ov) 'face ov) " "))
"n/a")))
(t
(and (or faces overlays)
(list faces overlays))))))
;;;###autoload
(defun doom-active-minor-modes ()
"Get a list of active minor-mode symbols."
(cl-loop for mode in minor-mode-list
if (and (boundp mode) (symbol-value mode))
collect mode))
;;;###autoload
(defun doom/what-minor-mode (mode)
"Get information on an active minor mode. Use `describe-minor-mode' for a
selection of all minor-modes, active or not."
(interactive
(list (completing-read "Minor mode: "
(doom-active-minor-modes))))
(describe-minor-mode-from-symbol
(cl-typecase mode
(string (intern mode))
(symbol mode)
(t (error "Expected a symbol/string, got a %s" (type-of mode))))))
;;;###autoload
(defun doom/am-i-secure ()
"Test to see if your root certificates are securely configured in emacs."
(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/")
if (condition-case _e
(url-retrieve-synchronously bad)
(error nil))
collect bad)))
(error (format "tls seems to be misconfigured (it got %s)."
bad-hosts))
(url-retrieve "https://badssl.com"
(lambda (status)
(if (or (not status) (plist-member status :error))
(warn "Something went wrong.\n\n%s" (pp-to-string status))
(message "Your trust roots are set up properly.\n\n%s" (pp-to-string status))
t)))))
(defvar doom--profiler nil)
;;;###autoload
(defun doom/toggle-profiler ()
"Toggle the Emacs profiler. Starts it if isn't running. Stops it and pops up
the profiling report otherwise."
(interactive)
(if (not doom--profiler)
(profiler-start 'cpu+mem)
(profiler-report)
(profiler-stop))
(setq doom--profiler (not doom--profiler)))
;;;###autoload
(defun doom/profile-emacs ()
"Profile the startup time of Emacs in the background.
If INIT-FILE is non-nil, profile that instead of USER-INIT-FILE."
(interactive)
(require 'esup)
(let ((init-file esup-user-init-file))
(message "Starting esup...")
(esup-reset)
(setq esup-server-process (esup-server-create (esup-select-port)))
(setq esup-server-port (process-contact esup-server-process :service))
(message "esup process started on port %s" esup-server-port)
(let ((process-args `("*esup-child*"
"*esup-child*"
,esup-emacs-path
"-q"
"-L" ,esup-load-path
"-l" "esup-child"
,(format "--eval=(esup-child-run \"%s\" \"%s\" %d)"
init-file
esup-server-port
esup-depth)
"--eval=(run-hooks 'after-init-hook 'emacs-startup-hook 'window-setup-hook)")))
(when esup-run-as-batch-p
(setq process-args (append process-args '("--batch"))))
(setq esup-child-process (apply #'start-process process-args)))
(set-process-sentinel esup-child-process 'esup-child-process-sentinel)))
;;;###autoload ;;;###autoload
(defun doom-info () (defun doom-info ()
"Returns diagnostic information about the current Emacs session in markdown, "Returns diagnostic information about the current Emacs session in markdown,
ready to be pasted in a bug report on github." ready to be pasted in a bug report on github."
(doom-initialize)
(require 'vc-git) (require 'vc-git)
(let ((default-directory doom-emacs-dir)) (let ((default-directory doom-emacs-dir))
(format (format
@ -136,7 +20,7 @@ ready to be pasted in a bug report on github."
" packages: %s\n" " packages: %s\n"
" elc dirs: %s\n" " elc dirs: %s\n"
" exec-path: %s\n" " exec-path: %s\n"
" ```\n") " ```")
system-type system-configuration system-type system-configuration
emacs-version (format-time-string "%b %d, %Y" emacs-build-time) emacs-version (format-time-string "%b %d, %Y" emacs-build-time)
doom-version doom-version
@ -144,7 +28,7 @@ ready to be pasted in a bug report on github."
branch branch
"n/a") "n/a")
(if-let* ((rev (vc-git-working-revision "core/core.el"))) (if-let* ((rev (vc-git-working-revision "core/core.el")))
(format "https://github.com/hlissner/doom-emacs/commit/%s" rev) rev
"n/a") "n/a")
(display-graphic-p) (daemonp) (display-graphic-p) (daemonp)
(bound-and-true-p system-configuration-features) (bound-and-true-p system-configuration-features)
@ -177,11 +61,11 @@ ready to be pasted in a bug report on github."
(load ,(expand-file-name "core/autoload/packages.el" doom-emacs-dir)) (load ,(expand-file-name "core/autoload/packages.el" doom-emacs-dir))
(doom-get-packages)) (doom-get-packages))
(lambda (p) (setq packages p)))) (lambda (p) (setq packages p))))
(mapcar (lambda (x) (cl-loop for pkg in (cl-sort packages #'string-lessp
(if (cdr x) :key (lambda (x) (symbol-name (car x))))
(format "%s" x) collect (if (cdr pkg)
(symbol-name (car x)))) (format "%s" pkg)
(cl-sort packages #'string-lessp :key (lambda (x) (symbol-name (car x))))))) (symbol-name (car pkg))))))
"n/a") "n/a")
(or (ignore-errors (or (ignore-errors
(cl-delete-duplicates (cl-delete-duplicates
@ -191,22 +75,105 @@ ready to be pasted in a bug report on github."
collect (file-relative-name (file-name-directory file) doom-emacs-dir)) collect (file-relative-name (file-name-directory file) doom-emacs-dir))
:test #'equal)) :test #'equal))
"n/a") "n/a")
exec-path))) ;; abbreviate $HOME to hide username
(mapcar #'abbreviate-file-name exec-path))))
;;
;; Commands
;;
;;;###autoload ;;;###autoload
(defun doom/info () (defun doom//info ()
"Collects some debug information about your Emacs session, formats it into "Collects some debug information about your Emacs session, formats it into
markdown and copies it to your clipboard, ready to be pasted into bug reports!" markdown and copies it to your clipboard, ready to be pasted into bug reports!"
(declare (interactive-only t)) (declare (interactive-only t))
(interactive) (interactive)
(if noninteractive
(message "%s" (doom-info))
(message "Generating Doom info...") (message "Generating Doom info...")
(if noninteractive
(print! (doom-info))
(kill-new (doom-info)) (kill-new (doom-info))
(message "Done! Copied to clipboard."))) (message "Done! Copied to clipboard.")))
;;;###autoload ;;;###autoload
(defun doom/toggle-debug-mode () (defun doom//am-i-secure ()
"Test to see if your root certificates are securely configured in emacs."
(declare (interactive-only t))
(interactive) (interactive)
(setq doom-debug-mode (not doom-debug-mode)) (unless (string-match-p "\\_<GNUTLS\\_>" system-configuration-features)
(toggle-debug-on-error)) (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/")
if (condition-case _e
(url-retrieve-synchronously bad)
(error nil))
collect bad)))
(error "tls seems to be misconfigured (it got %s)."
bad-hosts)
(url-retrieve "https://badssl.com"
(lambda (status)
(if (or (not status) (plist-member status :error))
(warn "Something went wrong.\n\n%s" (pp-to-string status))
(message "Your trust roots are set up properly.\n\n%s" (pp-to-string status))
t)))))
;;;###autoload
(defun doom//version ()
"Display the current version of Doom & Emacs, including the current Doom
branch and commit."
(interactive)
(require 'vc-git)
(print! "Doom v%s (Emacs v%s)\nBranch: %s\nCommit: %s."
doom-version
emacs-version
(or (vc-git--symbolic-ref doom-core-dir)
"n/a")
(or (vc-git-working-revision doom-core-dir)
"n/a")))
;;
;; Profiling
;;
(defvar doom--profiler nil)
;;;###autoload
(defun doom//toggle-profiler ()
"Toggle the Emacs profiler. Run it again to see the profiling report."
(interactive)
(if (not doom--profiler)
(profiler-start 'cpu+mem)
(profiler-report)
(profiler-stop))
(setq doom--profiler (not doom--profiler)))
;;;###autoload
(defun doom//profile-emacs ()
"Profile the startup time of Emacs in the background with ESUP.
If INIT-FILE is non-nil, profile that instead of USER-INIT-FILE."
(interactive)
(require 'esup)
(let ((init-file esup-user-init-file))
(message "Starting esup...")
(esup-reset)
(setq esup-server-process (esup-server-create (esup-select-port)))
(setq esup-server-port (process-contact esup-server-process :service))
(message "esup process started on port %s" esup-server-port)
(let ((process-args `("*esup-child*"
"*esup-child*"
,esup-emacs-path
"-q"
"-L" ,esup-load-path
"-l" "esup-child"
,(format "--eval=(esup-child-run \"%s\" \"%s\" %d)"
init-file
esup-server-port
esup-depth)
"--eval=(run-hooks 'after-init-hook 'emacs-startup-hook 'window-setup-hook)")))
(when esup-run-as-batch-p
(setq process-args (append process-args '("--batch"))))
(setq esup-child-process (apply #'start-process process-args)))
(set-process-sentinel esup-child-process 'esup-child-process-sentinel)))

View file

@ -1,22 +1,5 @@
;;; core/autoload/help.el -*- lexical-binding: t; -*- ;;; core/autoload/help.el -*- lexical-binding: t; -*-
;;;###autoload
(defun doom/describe-setting (setting)
"Open the documentation of SETTING (a keyword defined with `def-setting!').
Defaults to the "
(interactive
(let ((sym (symbol-at-point)))
(list (completing-read "Describe setting: "
(sort (mapcar #'car doom-settings) #'string-lessp)
nil t (if (keywordp sym) (symbol-name sym))))))
(let ((fn (cdr (assq (intern setting) doom-settings))))
(unless fn
(error "'%s' is not a valid DOOM setting" setting))
(describe-function fn)))
;;
(defvar doom--module-mode-alist (defvar doom--module-mode-alist
'((c-mode :lang cc) '((c-mode :lang cc)
(c++-mode :lang cc) (c++-mode :lang cc)
@ -58,6 +41,39 @@ Defaults to the "
(stylus-mode :lang web)) (stylus-mode :lang web))
"TODO") "TODO")
;;
;; Helpers
;;
;;;###autoload
(defun doom-active-minor-modes ()
"Return a list of active minor-mode symbols."
(cl-loop for mode in minor-mode-list
if (and (boundp mode) (symbol-value mode))
collect mode))
;;
;; Commands
;;
;;;###autoload
(defun doom/describe-setting (setting)
"Open the documentation of SETTING (a keyword defined with `def-setting!').
Defaults to the "
(interactive
(let ((sym (symbol-at-point)))
(list (completing-read "Describe setting: "
(sort (mapcar #'car doom-settings) #'string-lessp)
nil t (if (keywordp sym) (symbol-name sym))))))
(let ((fn (cdr (assq (intern setting) doom-settings))))
(unless fn
(error "'%s' is not a valid DOOM setting" setting))
(describe-function fn)))
;;;###autoload ;;;###autoload
(defun doom/describe-module (module) (defun doom/describe-module (module)
"Open the documentation of MODULE (a string that represents the category and "Open the documentation of MODULE (a string that represents the category and
@ -98,22 +114,53 @@ in, or d) the module associated with the current major mode (see
(mapcar #'intern (split-string module " ")) (mapcar #'intern (split-string module " "))
(unless (doom-module-p category submodule) (unless (doom-module-p category submodule)
(error "'%s' isn't a valid module" module)) (error "'%s' isn't a valid module" module))
(let ((doc-path (doom-module-expand-file category submodule "README.org"))) (let ((doc-path (doom-module-path category submodule "README.org")))
(unless (file-exists-p doc-path) (unless (file-exists-p doc-path)
(error "There is no documentation for this module")) (error "There is no documentation for this module"))
(find-file doc-path)))) (find-file doc-path))))
;;;###autoload ;;;###autoload
(defun doom/version () (defun doom/describe-active-minor-mode (mode)
"Display the current version of Doom & Emacs, including the current Doom "Get information on an active minor mode. Use `describe-minor-mode' for a
branch and commit." selection of all minor-modes, active or not."
(interactive
(list (completing-read "Minor mode: "
(doom-active-minor-modes))))
(describe-minor-mode-from-symbol
(cl-typecase mode
(string (intern mode))
(symbol mode)
(t (error "Expected a symbol/string, got a %s" (type-of mode))))))
;;;###autoload
(defun doom/what-face (&optional pos)
"Shows all faces and overlay faces at point.
Interactively prints the list to the echo area. Noninteractively, returns a list
whose car is the list of faces and cadr is the list of overlay faces."
(interactive) (interactive)
(message "Doom v%s (Emacs v%s). Branch: %s. Commit: %s." (let* ((pos (or pos (point)))
doom-version (faces (let ((face (get-text-property pos 'face)))
emacs-version (if (keywordp (car-safe face))
(if-let* ((branch (vc-git--symbolic-ref "core/core.el"))) (list face)
branch (cl-loop for f in (doom-enlist face) collect f))))
(overlays (cl-loop for ov in (overlays-at pos (1+ pos))
nconc (doom-enlist (overlay-get ov 'face)))))
(cond ((called-interactively-p 'any)
(message "%s %s\n%s %s"
(propertize "Faces:" 'face 'font-lock-comment-face)
(if faces
(cl-loop for face in faces
if (listp face)
concat (format "'%s " face)
else
concat (concat (propertize (symbol-name face) 'face face) " "))
"n/a ") "n/a ")
(if-let* ((rev (vc-git-working-revision "core/core.el"))) (propertize "Overlays:" 'face 'font-lock-comment-face)
rev (if overlays
(cl-loop for ov in overlays
concat (concat (propertize (symbol-name ov) 'face ov) " "))
"n/a"))) "n/a")))
(t
(and (or faces overlays)
(list faces overlays))))))