emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity

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

Browse source
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
Download patch file Download diff file Expand all files Collapse all files

231
core/autoload/util.el → core/autoload/debug.el
View file

@ -1,126 +1,10 @@
;;; core/autoload/util.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)))
;;; core/autoload/debug.el -*- lexical-binding: t; -*-
;;;###autoload
(defun doom-info ()
"Returns diagnostic information about the current Emacs session in markdown,
ready to be pasted in a bug report on github."
(doom-initialize)
(require 'vc-git)
(let ((default-directory doom-emacs-dir))
(format
@ -136,7 +20,7 @@ ready to be pasted in a bug report on github."
" packages: %s\n"
" elc dirs: %s\n"
" exec-path: %s\n"
" ```\n")
" ```")
system-type system-configuration
emacs-version (format-time-string "%b %d, %Y" emacs-build-time)
doom-version
@ -144,7 +28,7 @@ ready to be pasted in a bug report on github."
branch
"n/a")
(if-let* ((rev (vc-git-working-revision "core/core.el")))
(format "https://github.com/hlissner/doom-emacs/commit/%s" rev)
rev
"n/a")
(display-graphic-p) (daemonp)
(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))
(doom-get-packages))
(lambda (p) (setq packages p))))
(mapcar (lambda (x)
(if (cdr x)
(format "%s" x)
(symbol-name (car x))))
(cl-sort packages #'string-lessp :key (lambda (x) (symbol-name (car x)))))))
(cl-loop for pkg in (cl-sort packages #'string-lessp
:key (lambda (x) (symbol-name (car x))))
collect (if (cdr pkg)
(format "%s" pkg)
(symbol-name (car pkg))))))
"n/a")
(or (ignore-errors
(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))
:test #'equal))
"n/a")
exec-path)))
;; abbreviate $HOME to hide username
(mapcar #'abbreviate-file-name exec-path))))
;;
;; Commands
;;
;;;###autoload
(defun doom/info ()
(defun doom//info ()
"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!"
(declare (interactive-only t))
(interactive)
(if noninteractive
(message "%s" (doom-info))
(message "Generating Doom info...")
(if noninteractive
(print! (doom-info))
(kill-new (doom-info))
(message "Done! Copied to clipboard.")))
;;;###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)
(setq doom-debug-mode (not doom-debug-mode))
(toggle-debug-on-error))
(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 "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)))

105
core/autoload/help.el
View file

@ -1,22 +1,5 @@
;;; 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
'((c-mode :lang cc)
(c++-mode :lang cc)
@ -58,6 +41,39 @@ Defaults to the "
(stylus-mode :lang web))
"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
(defun doom/describe-module (module)
"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 " "))
(unless (doom-module-p category submodule)
(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)
(error "There is no documentation for this module"))
(find-file doc-path))))
;;;###autoload
(defun doom/version ()
"Display the current version of Doom & Emacs, including the current Doom
branch and commit."
(defun doom/describe-active-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/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)
(message "Doom v%s (Emacs v%s). Branch: %s. Commit: %s."
doom-version
emacs-version
(if-let* ((branch (vc-git--symbolic-ref "core/core.el")))
branch
"n/a")
(if-let* ((rev (vc-git-working-revision "core/core.el")))
rev
(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))))))