diff --git a/core/autoload/util.el b/core/autoload/debug.el similarity index 63% rename from core/autoload/util.el rename to core/autoload/debug.el index 2500df78b..db5764ee4 100644 --- a/core/autoload/util.el +++ b/core/autoload/debug.el @@ -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 "\\_" 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) + (message "Generating Doom info...") (if noninteractive - (message "%s" (doom-info)) - (message "Generating Doom info...") + (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 "\\_" 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))) + diff --git a/core/autoload/help.el b/core/autoload/help.el index 969081464..e4c311b96 100644 --- a/core/autoload/help.el +++ b/core/autoload/help.el @@ -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 - "n/a"))) + (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))))))