emenel/doomemacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity
doomemacs/core/autoload/debug.el
Henrik Lissner 6c0b7e1530
refactor!(cli): rewrite CLI framework libraries 
BREAKING CHANGE: this changes Doom's CLI framework in subtle ways, which
is listed in greater detail below. If you've never extended Doom's CLI,
then this won't affect you, but otherwise it'd be recommended you read
on below.

This commit focuses on the CLI framework itself and backports some
foundational changes to its DSL and how it resolves command line
arguments to CLIs, validates input, displays documentation, and persists
state across sessions -- and more. This is done in preparation for the
final stretch towarding completing the CLI rewrite (see #4273).

This is also an effort to generalize Doom's CLI (both its framework and
bin/doom), to increase it versatility and make it a viable dev tool for
other Doom projects (on our Github org) and beyond.

However, there is a *lot* to cover so I'll try to be brief:

- Refactor: generalize Doom's CLI framework by moving all bin/doom
  specific configuration/commands out of core-cli into bin/doom. This
  makes it easier to use bin/doom as a project-agnostic development
  tool (or for users to write their own).
- Refactor: change the namespace for CLI variables/functions from
  doom-cli-X to doom-X.
- Fix: subcommands being mistaken as arguments. "doom make index" will
  resolve to (defcli! (doom make index)) if it exists,
  otherwise (defcli! (doom make)) with "index" as an argument. Before
  this, it would resolve to the latter no matter what. &rest can
  override this; with (defcli! (doom make) (&rest args)), (defcli! (doom
  make index)) will never be invoked.
- Refactor!: redesign our output library (was core/autoload/output.el,
  is now core/autoload/print.el), and how our CLI framework buffers and
  logs output, and now merges logs across (exit! ...) restarts.
- Feat: add support for :before and :after pseudo commands. E.g.

    (defcli! (:before doom help) () ...)
    (defcli! (:after doom sync) () ...)

  Caveat: unlike advice, only one of each can be defined per-command.
- Feat: option arguments now have rudimentary type validation (see
  `doom-cli-option-arg-types`). E.g.

    (defcli! (doom foo) ((foo ("--foo" num))) ...)

  If NUM is not a numeric, it will throw a validation error.

  Any type that isn't in `doom-cli-option-arg-types` will be treated as a
  wildcard string type. `num` can also be replaced with a specification,
  e.g. "HOST[:PORT]", and can be formatted by using symbol quotes:
  "`HOST'[:`PORT']".
- Feat: it is no longer required that options *immediately* follow the command
  that defines them (but it must be somewhere after it, not before). E.g.
    With:
      (defcli! (:before doom foo) ((foo ("--foo"))) ...)
      (defcli! (doom foo baz) () ...)
    Before:
      FAIL: doom --foo foo baz
      GOOD: doom foo --foo baz
      FAIL: doom foo baz --foo
    After:
      FAIL: doom --foo foo baz
      GOOD: doom foo --foo baz
      GOOD: doom foo baz --foo
- Refactor: CLI session state is now kept in a doom-cli-context struct (which
  can be bound to a CLI-local variable with &context in the arglist):

    (defcli! (doom sync) (&context context)
      (print! "Command: " (doom-cli-context-command context)))

  These contexts are persisted across sessions (when restarted). This is
  necessary to support seamless script restarting (i.e. execve
  emulation) in post-3.0.
- Feat: Doom's CLI framework now understands "--". Everything after it will be
  treated as regular arguments, instead of sub-commands or options.
- Refactor!: the semantics of &rest for CLIs has changed. It used to be "all
  extra literal, non-option arguments". It now means *all* unprocessed
  arguments, and its use will suppress "unrecognized option" errors, and
  tells the framework not to process any further subcommands. Use &args
  if you just want "all literal arguments following this command".
- Feat: add new auxiliary keywords for CLI arglists: &context, &multiple,
  &flags, &args, &stdin, &whole, and &cli.
  - &context SYM: binds the currently running context to SYM (a
    `doom-cli-context` struct). Helpful for introspection or passing
    along state when calling subcommands by hand (with `call!`).
  - &stdin SYM: SYM will be bound to a string containing any input piped
    into the running script, or nil if none. Use
    `doom-cli-context-pipe-p` to detect whether the script has been
    piped into or out of.
  - &multiple OPTIONS...: allows all following OPTIONS to be repeated. E.g. "foo
    -x a -x b -x c" will pass (list ("-x" . "a") ("-x" . "b") ("-x" .
    "c")) as -x's value.
  - &flags OPTIONS...: All options after "&flags" get an implicit --no-* switch
    and cannot accept arguments. Will be set to :yes or :no depending on which flag is
    provided, and nil if the flag isn't provided. Otherwise, a default
    value can be specified in that options' arglist. E.g.

      (defcli! (doom foo) (&flags (foo ("--foo" :no))) ...)

    When called, this command sets FOO to :yes if --foo, :no if --no-foo, and
    defaults to :no otherwise.
  - &args SYM: this replaces what &rest used to be; it binds to SYM a
    list of all unprocessed (non-option) arguments.
  - &rest SYM: now binds SYM to a list of all unprocessed arguments, including
    options. This also suppresses "unrecognized option" errors, but will render
    any sub-commands inaccessible. E.g.

      (defcli! (doom make) (&rest rest) ...)
      ;; These are now inaccessible!
      (defcli! (doom make foo) (&rest rest) ...)
      (defcli! (doom make bar) (&rest rest) ...)
  - &cli SYM: binds SYM to the currently running `doom-cli` struct. Can also be
    obtained via `(doom-cli-get (doom-cli-context-command context))`. Possibly
    useful for introspection.
- feat: add defobsolete! macro for quickly defining obsolete commands.
- feat: add defalias! macro for quickly defining alias commands.
- feat: add defautoload! macro for defining an autoloaded command (won't
  be loaded until it is called for).
- refactor!: rename defcligroup! to defgroup! for consistency.
- fix: CLIs will now recursively inherit plist properties from parent
  defcli-group!'s (but will stack :prefix).
- refactor!: remove obsolete 'doom update':
- refactor!: further generalize 'doom ci'
  - In an effort to generalize 'doom ci' (so other Doom--or
    non-doom--projects can use it), all its subcommands have been
    changed to operate on the current working directory's repo instead
    of $EMACSDIR.
  - Doom-specific CI configuration was moved to .github/ci.el.
  - All 'doom ci' commands will now preload one of \$CURRENT_REPO_ROOT/ci.el or
    \$DOOMDIR/ci.el before executing.
- refactor!: changed 'doom env'
  - 'doom env {-c,--clear}' is now 'doom env {clear,c}'
  - -r/--reject and -a/--allow may now be specified multiple times
- refactor!: rewrote CLI help framework and error handling to be more
  sophisticated and detailed.
- feat: can now initiate $PAGER on output with (exit! :pager) (or use
  :pager? to only invoke pager is output is longer than the terminal is
  tall).
- refactor!: changed semantics+conventions for global bin/doom options
  - Single-character global options are now uppercased, to distinguish them from
    local options:
    - -d (for debug mode) is now -D
    - -y (to suppress prompts) is now -!
    - -l (to load elisp) is now -L
    - -h (short for --help) is now -?
  - Replace --yes/-y switches with --force/-!
  - -L/--load FILE: now silently ignores file errors.
  - Add --strict-load FILE: does the same as -L/--load, but throws an error if
    FILE does not exist/is unreadable.
  - Add -E/--eval FORM: evaluates arbitrary lisp before commands are processed.
  - -L/--load, --strict-load, and -E/--eval can now be used multiple times in
    one command.
  - Add --pager COMMAND to specify an explicit pager. Will also obey
    $DOOMPAGER envvar. Does not obey $PAGER.
- Fix #3746: which was likely caused by the generated post-script overwriting
  the old mid-execution. By salting the postscript filenames (with both an
  overarching session ID and a step counter).
- Docs: document websites, environment variables, and exit codes in
  'doom --help'
- Feat: add imenu support for def{cli,alias,obsolete}!

Ref: #4273
Fix: #3746
Fix: #3844
2022-06-18 23:53:12 +02:00

382 lines
15 KiB
EmacsLisp
Raw Blame History

;;; core/autoload/debug.el -*- lexical-binding: t; -*-
;;
;;; Doom's debug mode
;;;###autoload
(defvar doom-debug-variables
'(async-debug
debug-on-error
(debugger . doom-debugger)
doom-debug-p
(doom-print-level . debug)
garbage-collection-messages
gcmh-verbose
init-file-debug
jka-compr-verbose
url-debug
use-package-verbose
(message-log-max . 16384))
"A list of variable to toggle on `doom-debug-mode'.
Each entry can be a variable symbol or a cons cell whose CAR is the variable
symbol and CDR is the value to set it to when `doom-debug-mode' is activated.")
(defvar doom--debug-vars-undefined nil)
(defun doom--watch-debug-vars-h (&rest _)
(when-let (bound-vars (cl-remove-if-not #'boundp doom--debug-vars-undefined))
(doom-log "New variables available: %s" bound-vars)
(let ((message-log-max nil))
(doom-debug-mode -1)
(doom-debug-mode +1))))
;;;###autoload
(define-minor-mode doom-debug-mode
"Toggle `debug-on-error' and `doom-debug-p' for verbose logging."
:init-value nil
:global t
(let ((enabled doom-debug-mode))
(setq doom--debug-vars-undefined nil)
(dolist (var doom-debug-variables)
(cond ((listp var)
(cl-destructuring-bind (var . val) var
(if (boundp var)
(set-default
var (if (not enabled)
(prog1 (get var 'initial-value)
(put 'x 'initial-value nil))
(put var 'initial-value (symbol-value var))
val))
(add-to-list 'doom--debug-vars-undefined var))))
((if (boundp var)
(set-default var enabled)
(add-to-list 'doom--debug-vars-undefined var)))))
(when (called-interactively-p 'any)
(when (fboundp 'explain-pause-mode)
(explain-pause-mode (if enabled +1 -1))))
;; Watch for changes in `doom-debug-variables', or when packages load (and
;; potentially define one of `doom-debug-variables'), in case some of them
;; aren't defined when `doom-debug-mode' is first loaded.
(cond (enabled
(advice-add #'message :before #'doom--timestamped-message-a)
(add-variable-watcher 'doom-debug-variables #'doom--watch-debug-vars-h)
(add-hook 'after-load-functions #'doom--watch-debug-vars-h))
(t
(advice-remove #'message #'doom--timestamped-message-a)
(remove-variable-watcher 'doom-debug-variables #'doom--watch-debug-vars-h)
(remove-hook 'after-load-functions #'doom--watch-debug-vars-h)))
(message "Debug mode %s" (if enabled "on" "off"))))
;;
;;; Custom debuggers
(autoload 'backtrace-get-frames "backtrace")
(defun doom-backtrace ()
"Return a stack trace as a list of `backtrace-frame' objects."
;; (let* ((n 0)
;; (frame (backtrace-frame n))
;; (frame-list nil)
;; (in-program-stack nil))
;; (while frame
;; (when in-program-stack
;; (push (cdr frame) frame-list))
;; (when (eq (elt frame 1) debugger)
;; (setq in-program-stack t))
;; ;; (when (and (eq (elt frame 1) 'doom-cli-execute)
;; ;; (eq (elt frame 2) :doom))
;; ;; (setq in-program-stack nil))
;; (setq n (1+ n)
;; frame (backtrace-frame n)))
;; (nreverse frame-list))
(cdr (backtrace-get-frames debugger)))
(defun doom-backtrace-write-to-file (backtrace file)
"Write BACKTRACE to FILE with appropriate boilerplate."
(make-directory (file-name-directory file) t)
(let ((doom-print-indent 0))
(with-temp-file file
(insert ";; -*- lisp-interaction -*-\n")
(insert ";; vim: set ft=lisp:\n")
(insert (format ";; command=%S\n" command-line-args))
(insert (format ";; date=%S\n\n" (format-time-string "%Y-%m-%d %H-%M-%S" before-init-time)))
(insert ";;;; ENVIRONMENT\n" (with-output-to-string (doom/version)) "\n")
(let ((standard-output (current-buffer))
(print-quoted t)
(print-escape-newlines t)
(print-escape-control-characters t)
(print-symbols-bare t)
(print-level nil)
(print-circle nil)
(n -1))
(mapc (lambda (frame)
(princ (format ";;;; %d\n" (cl-incf n)))
(pp (list (cons (backtrace-frame-fun frame)
(backtrace-frame-args frame))
(backtrace-frame-locals frame)))
(terpri))
backtrace))
file)))
(defun doom-debugger (&rest args)
"Enter `debugger' in interactive sessions, `doom-cli-debugger' otherwise.
Writes backtraces to file and ensures the backtrace is recorded, so the user can
always access it."
(let ((backtrace (doom-backtrace)))
;; Work around Emacs's heuristic (in eval.c) for detecting errors in the
;; debugger, which would run this handler again on subsequent calls. Taken
;; from `ert--run-test-debugger'.
(cl-incf num-nonmacro-input-events)
;; TODO Write backtraces to file
;; TODO Write backtrace to a buffer in case recursive error interupts the
;; debugger (happens more often than it should).
(apply #'debug args)))
;;
;;; Time-stamped *Message* logs
(defun doom--timestamped-message-a (format-string &rest args)
"Advice to run before `message' that prepends a timestamp to each message.
Activate this advice with:
(advice-add 'message :before 'doom--timestamped-message-a)"
(when (and (stringp format-string)
message-log-max
(not (string-equal format-string "%s%s")))
(with-current-buffer "*Messages*"
(let ((timestamp (format-time-string "[%F %T] " (current-time)))
(deactivate-mark nil))
(with-silent-modifications
(goto-char (point-max))
(if (not (bolp))
(newline))
(insert timestamp))))
(let ((window (get-buffer-window "*Messages*")))
(when (and window (not (equal (selected-window) window)))
(with-current-buffer "*Messages*"
(goto-char (point-max))
(set-window-point window (point-max)))))))
;;
;;; Hooks
;;;###autoload
(defun doom-run-all-startup-hooks-h ()
"Run all startup Emacs hooks. Meant to be executed after starting Emacs with
-q or -Q, for example:
emacs -Q -l init.el -f doom-run-all-startup-hooks-h"
(setq after-init-time (current-time))
(let ((inhibit-startup-hooks nil))
(doom-run-hooks 'after-init-hook
'delayed-warnings-hook
'emacs-startup-hook
'tty-setup-hook
'window-setup-hook)))
;;
;;; Helpers
(defsubst doom--collect-forms-in (file form)
(when (file-readable-p file)
(let (forms)
(with-temp-buffer
(insert-file-contents file)
(with-syntax-table emacs-lisp-mode-syntax-table
(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))
(letf! ((defun sh (&rest args) (cdr (apply #'doom-call-process args)))
(defun cat (file &optional limit)
(with-temp-buffer
(insert-file-contents file nil 0 limit)
(buffer-string)))
(defun abbrev-path (path)
(replace-regexp-in-string
(regexp-opt (list (user-login-name)) 'words) "$USER"
(abbreviate-file-name path)))
(defun symlink-path (file)
(format "%s%s" (abbrev-path file)
(if (file-symlink-p file) ""
(concat " -> " (abbrev-path (file-truename file)))))))
`((generated . ,(format-time-string "%b %d, %Y %H:%M:%S"))
(system . ,(delq
nil (list (doom-system-distro-version)
(when (executable-find "uname")
(sh "uname" "-msr"))
(window-system))))
(emacs . ,(delq
nil (list emacs-version
(bound-and-true-p emacs-repository-branch)
(and (stringp emacs-repository-version)
(substring emacs-repository-version 0 9))
(symlink-path doom-emacs-dir))))
(doom . ,(list doom-version
(sh "git" "log" "-1" "--format=%D %h %ci")
(symlink-path doom-private-dir)))
(shell . ,(abbrev-path shell-file-name))
(features . ,system-configuration-features)
(traits
. ,(mapcar
#'symbol-name
(delq
nil (list (cond ((not doom-interactive-p) 'batch)
((display-graphic-p) 'gui)
('tty))
(if (daemonp) 'daemon)
(if (and (require 'server)
(server-running-p))
'server-running)
(if (boundp 'chemacs-profiles-path)
'chemacs)
(if (file-exists-p doom-env-file)
'envvar-file)
(if (featurep 'exec-path-from-shell)
'exec-path-from-shell)
(if (file-symlink-p user-emacs-directory)
'symlinked-emacsdir)
(if (file-symlink-p doom-private-dir)
'symlinked-doomdir)
(if (and (stringp custom-file) (file-exists-p custom-file))
'custom-file)
(if (doom-files-in `(,@doom-modules-dirs
,doom-core-dir
,doom-private-dir)
:type 'files :match "\\.elc$")
'byte-compiled-config)))))
(custom
,@(when (and (stringp custom-file)
(file-exists-p custom-file))
(cl-loop for (type var _) in (get 'user 'theme-settings)
if (eq type 'theme-value)
collect var)))
(modules
,@(or (cl-loop with cat = nil
for key being the hash-keys of doom-modules
if (or (not cat)
(not (eq cat (car key))))
do (setq cat (car key))
and collect cat
collect
(let* ((flags (doom-module-get cat (cdr key) :flags))
(path (doom-module-get cat (cdr key) :path))
(module
(append
(cond ((null path)
(list '&nopath))
((not (file-in-directory-p path doom-modules-dir))
(list '&user)))
(if flags
`(,(cdr key) ,@flags)
(list (cdr key))))))
(if (= (length module) 1)
(car module)
module)))
'("n/a")))
(packages
,@(condition-case e
(mapcar
#'cdr (doom--collect-forms-in
(doom-path doom-private-dir "packages.el")
"package!"))
(error (format "<%S>" e))))
(unpin
,@(condition-case e
(mapcan #'identity
(mapcar
#'cdr (doom--collect-forms-in
(doom-path doom-private-dir "packages.el")
"unpin!")))
(error (list (format "<%S>" e)))))
(elpa
,@(condition-case e
(progn
(package-initialize)
(cl-loop for (name . _) in package-alist
collect (format "%s" name)))
(error (format "<%S>" e))))))))
;;
;;; Commands
;;;###autoload
(defun doom/version ()
"Display the running version of Doom core, module sources, and Emacs."
(interactive)
(print! "%-13s v%-15s %s"
"GNU Emacs"
emacs-version
emacs-repository-version)
(let ((default-directory doom-emacs-dir))
(print! "%-13s v%-15s %s"
"Doom core"
doom-version
(or (cdr (doom-call-process "git" "log" "-1" "--format=%D %h %ci"))
"n/a")))
;; NOTE This is a placeholder. Our modules will be moved to its own repo
;; eventually, and Doom core will later be capable of managing them like
;; package sources.
(let ((default-directory doom-modules-dir))
(print! "%-13s v%-15s %s"
"Doom modules"
doom-modules-version
(or (cdr (doom-call-process "git" "log" "-1" "--format=%D %h %ci"))
"n/a"))))
;;;###autoload
(defun doom/info ()
"Collects some debug information about your Emacs session, formats it and
copies it to your clipboard, ready to be pasted into bug reports!"
(interactive)
(let ((buffer (get-buffer-create "*doom info*")))
(with-current-buffer buffer
(setq buffer-read-only t)
(with-silent-modifications
(erase-buffer)
(save-excursion
(dolist (spec (cl-remove-if-not #'cdr (doom-info)))
(insert! "%-11s %s\n"
((car spec)
(if (listp (cdr spec))
(mapconcat (lambda (x) (format "%s" x))
(cdr spec) " ")
(cdr spec)))))))
(pop-to-buffer buffer)
(kill-new (buffer-string))
(when (y-or-n-p "Your doom-info was copied to the clipboard.\n\nOpen pastebin.com?")
(browse-url "https://pastebin.com")))))
;;
;;; 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)))
Reference in a new issue View git blame Copy permalink