From dd18fa16be2348feb6c64d6bf5e7838bd0deeae0 Mon Sep 17 00:00:00 2001 From: 45mg <45mg@no.mail> Date: Sat, 23 Mar 2024 19:06:23 +0530 Subject: [PATCH 01/35] feat(corfu): `both` option for RET behavior Adds a new value of `+corfu-want-ret-to-confirm` to cover the case where the user wants to select the candidate as well as perform the normal behavior of RET. Also, the logic for RET behavior has been refactored for clarity, and the variable's documentation has been clarified a little. --- modules/completion/corfu/config.el | 6 +++--- modules/config/default/config.el | 23 +++++++++++++++-------- 2 files changed, 18 insertions(+), 11 deletions(-) diff --git a/modules/completion/corfu/config.el b/modules/completion/corfu/config.el index 7cd7b5173..34368030a 100644 --- a/modules/completion/corfu/config.el +++ b/modules/completion/corfu/config.el @@ -4,9 +4,9 @@ "Configure how the user expects RET to behave. Possible values are: - t (default): Insert candidate if one is selected, pass-through otherwise; -- `minibuffer': Insert candidate if one is selected, pass-through otherwise, - and immediatelly exit if in the minibuffer; -- nil: Pass-through without inserting.") +- nil: Pass-through without inserting; +- `both': Insert candidate if one is selected, then pass-through; +- `minibuffer': Behaves like `both` in the minibuffer and `t` otherwise.") (defvar +corfu-buffer-scanning-size-limit (* 1 1024 1024) ; 1 MB "Size limit for a buffer to be scanned by `cape-dabbrev'.") diff --git a/modules/config/default/config.el b/modules/config/default/config.el index 21aa7268d..4ebb63f20 100644 --- a/modules/config/default/config.el +++ b/modules/config/default/config.el @@ -482,16 +482,23 @@ Continues comments if executed from a commented line. Consults (cond ((null +corfu-want-ret-to-confirm) (corfu-quit) nil) - ((eq +corfu-want-ret-to-confirm 'minibuffer) + ((eq +corfu-want-ret-to-confirm t) + (if (>= corfu--index 0) + cmd + nil)) + ((eq +corfu-want-ret-to-confirm 'both) (funcall-interactively cmd) nil) - ((and (or (not (minibufferp nil t)) - (eq +corfu-want-ret-to-confirm t)) - (>= corfu--index 0)) - cmd) - ((or (not (minibufferp nil t)) - (eq +corfu-want-ret-to-confirm t)) - nil) + ((eq +corfu-want-ret-to-confirm 'minibuffer) + (if (minibufferp nil t) + ;; 'both' behavior + (progn + (funcall-interactively cmd) + nil) + ;; 't' behavior + (if (>= corfu--index 0) + cmd + nil))) (t cmd)))))) (map! :when (modulep! :completion corfu) :map corfu-map From 97690184afde83a7a0d4a28a688457208893b156 Mon Sep 17 00:00:00 2001 From: 45mg <45mg@no.mail> Date: Fri, 29 Mar 2024 18:32:08 +0530 Subject: [PATCH 02/35] docs(corfu): `both` option for RET behavior --- modules/completion/corfu/README.org | 10 +++++++--- 1 file changed, 7 insertions(+), 3 deletions(-) diff --git a/modules/completion/corfu/README.org b/modules/completion/corfu/README.org index 541510cb5..7618a3165 100644 --- a/modules/completion/corfu/README.org +++ b/modules/completion/corfu/README.org @@ -193,9 +193,13 @@ A few variables may be set to change behavior of this module: - [[var:corfu-preview-current]] :: Configures current candidate preview. - [[var:+corfu-want-ret-to-confirm]] :: - Enables commiting with [[RET]] when the popup is visible. Default is ~t~, may be set to - ~'minibuffer~ if you want to commit both the completion and the minibuffer when - active. When ~nil~, it is always passed-through. + Controls the behavior of [[kbd:][RET]] when the popup is visible - whether it confirms + the selected candidate, and whether [[kbd:][RET]] is passed through (ie. the normal + behavior of [[kbd:][RET]] is performed). The default value of ~t~ enables confirmation + and disables pass-through. Other variations are ~nil~ for pass-through and no + confirmation and ~both~ for confirmation followed by pass-through. Finally, + the value of ~minibuffer~ will both confirm and pass-through (like ~both~) + when in the minibuffer, and only confirm (like ~t~) otherwise. - [[var:+corfu-buffer-scanning-size-limit]] :: Sets the maximum buffer size to be scanned by ~cape-dabbrev~. Defaults to 1 MB. Set this if you are having performance problems using the CAPF. From be8a1244f21ec22efaeab8bb7ff3fef5e4f3e880 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 13:39:38 -0400 Subject: [PATCH 03/35] bump: flymake-popon https://codeberg.org/akib/emacs-flymake-popon@HEAD -> doomelpa/flymake-popon@99ea813346f3 - Switched to a pinned, Github mirror for flymake-popon, for stability's sake. - Indirectly fixes Straight unable to fetch from a codeberg url with :host set to nil or 'codeberg (see #8035). Fix: #8035 Close: #8034 --- modules/checkers/syntax/packages.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/modules/checkers/syntax/packages.el b/modules/checkers/syntax/packages.el index 1fbf16d6c..9980921b8 100644 --- a/modules/checkers/syntax/packages.el +++ b/modules/checkers/syntax/packages.el @@ -8,4 +8,6 @@ (package! flycheck-posframe :pin "19896b922c76a0f460bf3fe8d8ebc2f9ac9028d8"))) (when (modulep! +flymake) - (package! flymake-popon :recipe (:repo "https://codeberg.org/akib/emacs-flymake-popon"))) + (package! flymake-popon + :recipe (:host github :repo "doomelpa/flymake-popon") + :pin "99ea813346f3edef7220d8f4faeed2ec69af6060")) From 8c6ee0ed4bc76e46f04043217e3629f41a44e583 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 15:09:57 -0400 Subject: [PATCH 04/35] fix: associate .doom(project|module|profile) w/ lisp-data-mode Same as .dir-locals.el --- lisp/doom-start.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/doom-start.el b/lisp/doom-start.el index 8e06d729d..67ca01b2d 100644 --- a/lisp/doom-start.el +++ b/lisp/doom-start.el @@ -150,7 +150,8 @@ ;;; Support for Doom-specific file extensions -(add-to-list 'auto-mode-alist '("/\\.doom\\(?:rc\\|project\\|module\\|profile\\)\\'" . emacs-lisp-mode)) +(add-to-list 'auto-mode-alist '("/\\.doom\\(?:project\\|module\\|profile\\)\\'" . lisp-data-mode)) +(add-to-list 'auto-mode-alist '("/\\.doomrc\\'" . emacs-lisp-mode)) ;; From ed02241cb88bd2069641b4c08557648d0cbb479e Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 15:12:58 -0400 Subject: [PATCH 05/35] fix(default): respect evil-disable-insert-state-bindings Respect this setting in more places. Ref: 8c4d871f7c14 Ref: 122e3732f70f --- modules/config/default/+evil-bindings.el | 16 ++++++++++------ 1 file changed, 10 insertions(+), 6 deletions(-) diff --git a/modules/config/default/+evil-bindings.el b/modules/config/default/+evil-bindings.el index 7d89c873b..3bd46abca 100644 --- a/modules/config/default/+evil-bindings.el +++ b/modules/config/default/+evil-bindings.el @@ -159,8 +159,9 @@ ;;; :completion (in-buffer) (map! (:when (modulep! :completion company) - :i "C-@" (cmds! (not (minibufferp)) #'company-complete-common) - :i "C-SPC" (cmds! (not (minibufferp)) #'company-complete-common) + (:unless (bound-and-true-p evil-disable-insert-state-bindings) + :i "C-@" (cmds! (not (minibufferp)) #'company-complete-common) + :i "C-SPC" (cmds! (not (minibufferp)) #'company-complete-common)) (:after company (:map company-active-map "C-w" nil ; don't interfere with `evil-delete-backward-word' @@ -189,15 +190,18 @@ (:when (modulep! :completion corfu) (:after corfu (:map corfu-mode-map - :i "C-SPC" #'completion-at-point - :i "C-n" #'+corfu/dabbrev-or-next - :i "C-p" #'+corfu/dabbrev-or-last + (:unless (bound-and-true-p evil-disable-insert-state-bindings) + :i "C-@" #'completion-at-point + :i "C-SPC" #'completion-at-point + :i "C-n" #'+corfu/dabbrev-or-next + :i "C-p" #'+corfu/dabbrev-or-last) :n "C-SPC" (cmd! (call-interactively #'evil-insert-state) (call-interactively #'completion-at-point)) :v "C-SPC" (cmd! (call-interactively #'evil-change) (call-interactively #'completion-at-point))) (:map corfu-map - :i "C-SPC" #'corfu-insert-separator + (:unless (bound-and-true-p evil-disable-insert-state-bindings) + :i "C-SPC" #'corfu-insert-separator) "C-k" #'corfu-previous "C-j" #'corfu-next "C-u" (cmd! (let (corfu-cycle) From c9acdb72a4bd95d7ac38d62e92aa79f395c1dccd Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 15:16:08 -0400 Subject: [PATCH 06/35] refactor(cli): remove bin/doom.cmd This batch script hasn't worked for some time. For v3, I'm working on a Emacs TUI porcelain for the bin/doom script that will serve as a replacement/alternative for folks on Windows (or who simply don't want/need the CLI). --- bin/doom.cmd | 25 ------------------------- 1 file changed, 25 deletions(-) delete mode 100644 bin/doom.cmd diff --git a/bin/doom.cmd b/bin/doom.cmd deleted file mode 100644 index 7cba4ca5e..000000000 --- a/bin/doom.cmd +++ /dev/null @@ -1,25 +0,0 @@ -:: Forward the ./doom script to Emacs - -@ECHO OFF -SETLOCAL ENABLEDELAYEDEXPANSION - -PUSHD "%~dp0" >NUL - -SET args= -SET command=%1 - -:LOOP -SHIFT /1 -IF NOT [%1]==[] ( - SET args=%args% %1 - GOTO :LOOP -) - -IF [%command%]==[run] ( - start runemacs -Q %args% -l ..\init.el -f "doom-run-all-startup-hooks-h" -) ELSE ( - emacs --quick --script .\doom -- %* -) - -POPD >NUL -ECHO ON From affaa7ec9ccb2e7f7ccb9ee77a7785728a650840 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 16:38:28 -0400 Subject: [PATCH 07/35] docs(ligature): use correct obsoleted-in version These should reflect the version of doomemacs/modules the symbols were deprecated in, not the version of doomemacs/core. --- modules/ui/ligatures/config.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/ui/ligatures/config.el b/modules/ui/ligatures/config.el index 097c9ccde..23389f76b 100644 --- a/modules/ui/ligatures/config.el +++ b/modules/ui/ligatures/config.el @@ -63,11 +63,11 @@ font.") (defvar +ligatures-prog-mode-list nil "A list of ligatures to enable in all `prog-mode' buffers.") -(make-obsolete-variable '+ligatures-prog-mode-list "Use `+ligatures-alist' instead" "3.0.0") +(make-obsolete-variable '+ligatures-prog-mode-list "Use `+ligatures-alist' instead" "24.09.0") (defvar +ligatures-all-modes-list nil "A list of ligatures to enable in all buffers.") -(make-obsolete-variable '+ligatures-all-modes-list "Use `+ligatures-alist' instead" "3.0.0") +(make-obsolete-variable '+ligatures-all-modes-list "Use `+ligatures-alist' instead" "24.09.0") (defvar +ligatures-extra-alist '((t)) "A map of major modes to symbol lists (for `prettify-symbols-alist').") From 069ea9e02fc9834b8ddcb5245bd5a087ad3caa21 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 21:45:30 -0400 Subject: [PATCH 08/35] fix(cli): straight: highlight 'Reset "*" to "*"' option --- lisp/cli/packages.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/cli/packages.el b/lisp/cli/packages.el index 06762e544..bf113d5a2 100644 --- a/lisp/cli/packages.el +++ b/lisp/cli/packages.el @@ -677,7 +677,7 @@ If ELPA-P, include packages installed with package.el (M-x package-install)." (defvar doom-cli--straight-auto-options '(("has diverged from" - . "^Reset [^ ]+ to branch") + . "^Reset [^ ]+ to ") ("but recipe specifies a URL of" . "Delete remote \"[^\"]+\", re-create it with correct URL") ("has a merge conflict:" From a8f116bb6b663dd3c19443486cf805148527ce84 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 21:47:52 -0400 Subject: [PATCH 09/35] bump: magit forge orgit orgit-forge magit/forge@30f181f78552 -> magit/forge@35cc600d62a0 magit/magit@2da34f1317c6 -> magit/magit@0aa26864e3fc magit/orgit-forge@a989b2b54d11 -> magit/orgit-forge@2718a6aaf0f6 magit/orgit@29a0f37e5cc7 -> magit/orgit@59d21fdb21f8 For Magit's 4.1.0 release, and to repin away from these packages' recently removed 'melpa' branches (see #8007). Ref: #8003 Ref: #8007 --- modules/emacs/vc/packages.el | 2 +- modules/lang/org/packages.el | 4 ++-- modules/tools/magit/packages.el | 4 ++-- 3 files changed, 5 insertions(+), 5 deletions(-) diff --git a/modules/emacs/vc/packages.el b/modules/emacs/vc/packages.el index d471201e1..18adebb42 100644 --- a/modules/emacs/vc/packages.el +++ b/modules/emacs/vc/packages.el @@ -6,7 +6,7 @@ (package! smerge-mode :built-in t) (package! browse-at-remote :pin "76aa27dfd469fcae75ed7031bb73830831aaccbf") -(package! git-commit :pin "2da34f1317c619ec2dfb9e0d969449261ca7f31f") +(package! git-commit :pin "0aa26864e3fc4e6949711a4821caf6819e7ab171") (package! git-timemachine ;; The original lives on codeberg.org; which has uptime issues. :recipe (:host github :repo "emacsmirror/git-timemachine") diff --git a/modules/lang/org/packages.el b/modules/lang/org/packages.el index 8cb561e8e..914c6067c 100644 --- a/modules/lang/org/packages.el +++ b/modules/lang/org/packages.el @@ -68,9 +68,9 @@ (when (modulep! :tools pdf) (package! org-pdftools :pin "4e420233a153a9c4ab3d1a7e1d7d3211c836f0ac")) (when (modulep! :tools magit) - (package! orgit :pin "29a0f37e5cc74b2979f3f256913460624deaf152") + (package! orgit :pin "59d21fdb21f84238c3172d37fdd2446b753e98dc") (when (modulep! :tools magit +forge) - (package! orgit-forge :pin "a989b2b54d116bda9d0396a9773b3e11b9f54e05"))) + (package! orgit-forge :pin "2718a6aaf0f64cb52c64c419053fbc80eb358c8d"))) (when (modulep! +brain) (package! org-brain :pin "2bad7732aae1a3051e2a14de2e30f970bbe43c25")) (when (modulep! +dragndrop) diff --git a/modules/tools/magit/packages.el b/modules/tools/magit/packages.el index ae2597e42..32f31582a 100644 --- a/modules/tools/magit/packages.el +++ b/modules/tools/magit/packages.el @@ -4,9 +4,9 @@ ;; NOTE: Always bump magit and forge to HEAD~1, not HEAD, because the latest ;; commit on their melpa branches are auto-generated and moved to HEAD every ;; time there's a commit to its main branch. -(package! magit :pin "2da34f1317c619ec2dfb9e0d969449261ca7f31f") +(package! magit :pin "0aa26864e3fc4e6949711a4821caf6819e7ab171") (when (modulep! +forge) - (package! forge :pin "30f181f785522f2debf60945d6b589a65bc415f6") + (package! forge :pin "35cc600d62a01d50699a529b0caa7d40e642d62a") (package! code-review :recipe (:host github :repo "doomelpa/code-review" From b2ce4f0afc8c6d672878c546c0f98723b116ea7c Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 22:07:57 -0400 Subject: [PATCH 10/35] refactor(org): +org-exclude-agenda-buffers-from-workspace-h --- modules/lang/org/config.el | 28 ++++++++++++---------------- 1 file changed, 12 insertions(+), 16 deletions(-) diff --git a/modules/lang/org/config.el b/modules/lang/org/config.el index 9581d3ed6..ea671bc10 100644 --- a/modules/lang/org/config.el +++ b/modules/lang/org/config.el @@ -787,30 +787,26 @@ via an indirect buffer." (defvar recentf-exclude) (defadvice! +org--optimize-backgrounded-agenda-buffers-a (fn file) - "Disable a lot of org-mode's startup processes for temporary agenda buffers. + "Disable `org-mode's startup processes for temporary agenda buffers. - This includes preventing them from polluting recentf. - - However, if the user tries to visit one of these buffers they'll see a - gimped, half-broken org buffer. To avoid that, install a hook to restart - `org-mode' when they're switched to so they can grow up to be fully-fledged - org-mode buffers." +Prevents recentf pollution as well. However, if the user tries to visit one of +these buffers they'll see a gimped, half-broken org buffer, so to avoid that, +install a hook to restart `org-mode' when they're switched to so they can grow +up to be fully-fledged org-mode buffers." :around #'org-get-agenda-file-buffer (if-let (buf (org-find-base-buffer-visiting file)) buf - (let ((recentf-exclude (list (lambda (_file) t))) + (let ((recentf-exclude '(always)) (doom-inhibit-large-file-detection t) - org-startup-indented - org-startup-folded + (doom-inhibit-local-var-hooks t) + (org-inhibit-startup t) vc-handled-backends - org-mode-hook enable-local-variables find-file-hook) - (let ((buf (funcall fn file))) - (when buf - (with-current-buffer buf - (add-hook 'doom-switch-buffer-hook #'+org--restart-mode-h - nil 'local))) + (when-let ((buf (delay-mode-hooks (funcall fn file)))) + (with-current-buffer buf + (add-hook 'doom-switch-buffer-hook #'+org--restart-mode-h + nil 'local)) buf)))) (defadvice! +org--fix-inconsistent-uuidgen-case-a (uuid) From d8157d8cc669c1a1c766c305e84f497766664853 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 22:08:25 -0400 Subject: [PATCH 11/35] tweak(org): move RET keybinds from normal to motion state --- modules/lang/org/config.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/modules/lang/org/config.el b/modules/lang/org/config.el index ea671bc10..a373809b6 100644 --- a/modules/lang/org/config.el +++ b/modules/lang/org/config.el @@ -1215,8 +1215,8 @@ between the two." :n CSup #'org-shiftup :n CSdown #'org-shiftdown ;; more intuitive RET keybinds - :n [return] #'+org/dwim-at-point - :n "RET" #'+org/dwim-at-point + :m [return] #'+org/dwim-at-point + :m "RET" #'+org/dwim-at-point :i [return] #'+org/return :i "RET" #'+org/return :i [S-return] #'+org/shift-return From 086aed32b2b1f0c9da5bfbaeaa849c4d9c448658 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sat, 31 Aug 2024 21:39:56 -0400 Subject: [PATCH 12/35] release(modules): 24.10.0-dev Ref: 2b39e4136850 --- lisp/doom.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/doom.el b/lisp/doom.el index ccf3d1114..e304dfdb8 100644 --- a/lisp/doom.el +++ b/lisp/doom.el @@ -202,7 +202,7 @@ "Current version of Doom Emacs core.") ;; DEPRECATED: Remove these when the modules are moved out of core. -(defconst doom-modules-version "24.09.0-pre" +(defconst doom-modules-version "24.10.0-pre" "Current version of Doom Emacs.") (defvar doom-init-time nil From 2bc6dd2a96fca93202404726a2c24c67418fcf8b Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 12:55:04 -0400 Subject: [PATCH 13/35] fix(cli): don't load subdirs.el again Doom loaded subdirs.el's in `load-path`, but doesn't need to. This normally wasn't an issue because subdirs.el files are typically idempotent, but there is one case where it isn't: on nixpkgs, with certain configurations on top of programs.emacs (see NixOS/nixpkgs#267548), which will cause file-missing errors trying to load the user's site-lisp afterwards (see #7681). Ref: NixOS/nixpkgs#267548 Fix: #7681 Amend: 6c0b7e1530a6 --- lisp/doom-cli.el | 17 +++-------------- 1 file changed, 3 insertions(+), 14 deletions(-) diff --git a/lisp/doom-cli.el b/lisp/doom-cli.el index 666551311..43d8a46ff 100644 --- a/lisp/doom-cli.el +++ b/lisp/doom-cli.el @@ -30,20 +30,9 @@ ;; information to the user, like deprecation notices, file-loaded messages, ;; and linter warnings. With this, that output is suppressed. (quiet! - (require 'cl nil t) - (unless site-run-file - (let ((site-run-file "site-start") - (tail load-path) - (lispdir (expand-file-name "../lisp" data-directory)) - dir) - (while tail - (setq dir (car tail)) - (let ((default-directory dir)) - (load (expand-file-name "subdirs.el") t inhibit-message t)) - (unless (string-prefix-p lispdir dir) - (let ((default-directory dir)) - (load (expand-file-name "leim-list.el") t inhibit-message t))) - (setq tail (cdr tail))) + (require 'cl nil t) ; "Package cl is deprecated" + (unless site-run-file ; unset in doom.el + (when-let ((site-run-file (get 'site-run-file 'initial-value))) (load site-run-file t inhibit-message)))) (setq-default From 515f61295bb36e076e3366f735773dcc44132d44 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 13:03:31 -0400 Subject: [PATCH 14/35] nit(cli): revise comments wrt site-run-file loading --- bin/doom | 15 ++++++--------- lisp/doom-cli.el | 12 ++++++------ lisp/doom.el | 8 ++++---- 3 files changed, 16 insertions(+), 19 deletions(-) diff --git a/bin/doom b/bin/doom index 542b1de30..5351c7fa2 100755 --- a/bin/doom +++ b/bin/doom @@ -62,17 +62,14 @@ ;; Put together, plus a strategically placed exit call, the shell will read ;; one part of this file and ignore the rest, while the elisp interpreter will ;; do the opposite. -;; - I intentionally avoid loading site files, so lisp/doom-cli.el can load them -;; by hand later. There, I can suppress and deal with unhelpful warnings (e.g. -;; "package cl is deprecated"), "Loading X...DONE" spam, and any other -;; disasterous side-effects. -;; -;; But be careful not to use -Q! It implies --no-site-lisp, which omits the -;; site-lisp directory from `load-path'. +;; - I intentionally suppress loading site files (must be done with '-q +;; --no-site-file' NOT '-Q', as the latter omits the site-lisp dir from +;; `load-path' too), so lisp/doom-cli.el can load them manually later (early +;; in lisp/doom-cli.el). Look there for an explanation why I do this. ;; - POSIX-compliancy is paramount: there's no guarantee what /bin/sh will be ;; symlinked to in the esoteric OSes/distros Emacs users use. -;; - The user may have a noexec flag set on /tmp, so pass the exit script to -;; /bin/sh rather than executing them directly. +;; - The user may have mounted /tmp with a noexec flag, so pass the exit script +;; to /bin/sh rather than executing them directly. ;; In CLI sessions, prefer correctness over performance. (setq load-prefer-newer t) diff --git a/lisp/doom-cli.el b/lisp/doom-cli.el index 43d8a46ff..c9f54dd56 100644 --- a/lisp/doom-cli.el +++ b/lisp/doom-cli.el @@ -23,12 +23,12 @@ doom-cache-dir doom-state-dir)) - ;; HACK: bin/doom invokes Emacs with --no-site-lisp so that site files can be - ;; loaded manually, here, where I can suppress any output it produces, and - ;; they almost always produce some. This output pollutes the output of doom - ;; scripts with potentially confusing -- but always unimportant -- - ;; information to the user, like deprecation notices, file-loaded messages, - ;; and linter warnings. With this, that output is suppressed. + ;; HACK: bin/doom suppresses loading of site files so they can be loaded + ;; manually, here. Why? To suppress the otherwise unavoidable output they + ;; commonly produce (like deprecation notices, file-loaded messages, and + ;; linter warnings). This output pollutes the output of doom's CLI (or + ;; scripts derived from it) with potentially confusing or alarming -- but + ;; always unimportant -- information to the user. (quiet! (require 'cl nil t) ; "Package cl is deprecated" (unless site-run-file ; unset in doom.el diff --git a/lisp/doom.el b/lisp/doom.el index e304dfdb8..46b3e4245 100644 --- a/lisp/doom.el +++ b/lisp/doom.el @@ -502,10 +502,10 @@ users).") ;; PERF,UX: site-lisp files are often obnoxiously noisy (emitting output ;; that isn't useful to end-users, like load messages, deprecation - ;; notices, and linter warnings. Displaying these in the minibuffer causes - ;; unnecessary redraws at startup which can impact startup time - ;; drastically and cause flashes of white. It also pollutes the logs. By - ;; suppressing it here, I load it myself, later, in a more controlled way + ;; notices, and linter warnings). Displaying these in the minibuffer + ;; causes unnecessary redraws at startup which can impact startup time + ;; drastically and cause flashes of white. It also pollutes the logs. I + ;; suppress it here and load it myself, later, in a more controlled way ;; (see `startup--load-user-init-file@undo-hacks'). (put 'site-run-file 'initial-value site-run-file) (setq site-run-file nil) From 8475d29f3c3a8cab39f599a4c644f09ac199f3d3 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 13:04:08 -0400 Subject: [PATCH 15/35] refactor: remove redundant set-default-toplevel-value call --- lisp/doom.el | 2 -- 1 file changed, 2 deletions(-) diff --git a/lisp/doom.el b/lisp/doom.el index 46b3e4245..149f010ae 100644 --- a/lisp/doom.el +++ b/lisp/doom.el @@ -384,8 +384,6 @@ users).") (locate-file-internal "calc-loaddefs.el" load-path)) nil (list (rassq 'jka-compr-handler old-value)))) - ;; Make sure the new value survives any current let-binding. - (set-default-toplevel-value 'file-name-handler-alist file-name-handler-alist) ;; Remember it so it can be reset where needed. (put 'file-name-handler-alist 'initial-value old-value) ;; COMPAT: Eventually, Emacs will process any files passed to it via the From d6db88162e5ff515d6daa73d1a8896a26e31fd70 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 13:04:54 -0400 Subject: [PATCH 16/35] refactor(lib): doom-load --- lisp/doom-lib.el | 25 +++++++++++-------------- 1 file changed, 11 insertions(+), 14 deletions(-) diff --git a/lisp/doom-lib.el b/lisp/doom-lib.el index 52db88af7..602fa6309 100644 --- a/lisp/doom-lib.el +++ b/lisp/doom-lib.el @@ -151,20 +151,17 @@ If NOERROR, don't throw an error if PATH doesn't exist." (signal (car e) (cdr e))) (error (setq path (locate-file path load-path (get-load-suffixes))) - (signal (cond ((not (and path (featurep 'doom))) - 'error) - ((file-in-directory-p path (expand-file-name "cli" doom-core-dir)) - 'doom-cli-error) - ((file-in-directory-p path doom-core-dir) - 'doom-core-error) - ((file-in-directory-p path doom-user-dir) - 'doom-user-error) - ((file-in-directory-p path doom-profile-dir) - 'doom-profile-error) - ((file-in-directory-p path doom-modules-dir) - 'doom-module-error) - ('doom-error)) - (list path e))))) + (if (not (and path (featurep 'doom))) + (signal (car e) (cdr e)) + (cl-loop for (err . dir) + in `((doom-cli-error . ,(expand-file-name "cli" doom-core-dir)) + (doom-core-error . ,doom-core-dir) + (doom-user-error . ,doom-user-dir) + (doom-profile-error . ,doom-profile-dir) + (doom-module-error . ,doom-modules-dir)) + if (file-in-directory-p path dir) + do (signal err (list (file-relative-name path (expand-file-name "../" dir)) + e))))))) (defun doom-require (feature &optional filename noerror) "Like `require', but handles and enhances Doom errors. From 3bced4dbbe783767e10a47f9a4b57f32616f94bc Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 13:08:17 -0400 Subject: [PATCH 17/35] refactor(cli): separate cli bootstrap from lib Eventually, I want to autoload some of this stuff, so that users in interactive sessions can safely load it without side effects (useful when writing their own CLIs or editing Doom's source). --- lisp/cli/meta.el | 519 ---------- lisp/doom-cli-lib.el | 2320 ++++++++++++++++++++++++++++++++++++++++++ lisp/doom-cli.el | 2173 ++++----------------------------------- 3 files changed, 2508 insertions(+), 2504 deletions(-) delete mode 100644 lisp/cli/meta.el create mode 100644 lisp/doom-cli-lib.el diff --git a/lisp/cli/meta.el b/lisp/cli/meta.el deleted file mode 100644 index 9d0f01742..000000000 --- a/lisp/cli/meta.el +++ /dev/null @@ -1,519 +0,0 @@ -;;; lisp/cli/meta.el -*- lexical-binding: t; -*- -;;; Commentary: -;; -;; This file defines special commands that the Doom CLI will invoke when a -;; command is passed with -?, --help, or --version. They can also be aliased to -;; a sub-command to make more of its capabilities accessible to users, with: -;; -;; (defcli-alias! (myscript (help h)) (:help)) -;; -;; You can define your own command-specific help handlers, e.g. -;; -;; (defcli! (:help myscript subcommand) () ...) -;; -;; And it will be invoked instead of the generic one. -;; -;;; Code: - -;; -;;; Variables - -(defvar doom-help-commands '("%p %c {-?,--help}") - "A list of help commands recognized for the running script. - -Recognizes %p (for the prefix) and %c (for the active command).") - - -;; -;;; Commands - -;; When __DOOMDUMP is set, doomscripts trigger this special handler. -(defcli! (:root :dump) - ((pretty? ("--pretty") "Pretty print output") - &context context - &args commands) - "Dump metadata to stdout for other commands to read." - (let* ((prefix (doom-cli-context-prefix context)) - (command (cons prefix commands))) - (funcall (if pretty? #'pp #'prin1) - (cond ((equal commands '("-")) (hash-table-values doom-cli--table)) - (commands (doom-cli-find command)) - ((doom-cli-find (list prefix))))) - (terpri) - ;; Kill manually so we don't save output to logs. - (let (kill-emacs) (kill-emacs 0)))) - -(defcli! (:root :help) - ((localonly? ("-g" "--no-global") "Hide global options") - (manpage? ("--manpage") "Generate in manpage format") - (commands? ("--commands") "List all known commands") - &multiple - (sections ("--synopsis" "--subcommands" "--similar" "--envvars" - "--postamble") - "Show only the specified sections.") - &context context - &args command) - "Show documentation for a Doom CLI command. - -OPTIONS: - --synopsis, --subcommands, --similar, --envvars, --postamble - TODO" - (doom-cli-load-all) - (when (doom-cli-context-error context) - (terpri)) - (let* ((command (cons (doom-cli-context-prefix context) command)) - (cli (doom-cli-get command t)) - (rcli (doom-cli-get cli)) - (fallbackcli (cl-loop with targets = (doom-cli--command-expand (butlast command) t) - for cmd in (cons command targets) - if (doom-cli-get cmd t) - return it))) - (cond (commands? - (let ((cli (or cli (doom-cli-get (doom-cli-context-prefix context))))) - (print! "Commands under '%s':\n%s" - (doom-cli-command-string cli) - (indent (doom-cli-help--render-commands - (or (doom-cli-subcommands cli) - (user-error "No commands found")) - :prefix (doom-cli-command cli) - :inline? t - :docs? t))))) - ((null sections) - (if (null cli) - (signal 'doom-cli-command-not-found-error command) - (doom-cli-help--print cli context manpage? localonly?) - (exit! :pager?))) - ((dolist (section sections) - (unless (equal section (car sections)) (terpri)) - (pcase section - ("--synopsis" - (print! "%s" (doom-cli-help--render-synopsis - (doom-cli-help--synopsis cli) - "Usage: "))) - ("--subcommands" - (print! "%s\n%s" (bold "Available commands:") - (indent (doom-cli-help--render-commands - (doom-cli-subcommands rcli 1) - :prefix command - :grouped? t - :docs? t) - doom-print-indent-increment))) - ("--similar" - (unless command - (user-error "No command specified")) - (let ((similar (doom-cli-help-similar-commands command 0.4))) - (print! "Similar commands:") - (if (not similar) - (print! (indent (warn "Can't find any!"))) - (dolist (command (seq-take similar 10)) - (print! (indent (item "(%d%%) %s")) - (* (car command) 100) - (doom-cli-command-string (cdr command))))))) - ("--envvars" - (let* ((key "ENVIRONMENT VARIABLES") - (clis (if command (doom-cli-find command) (hash-table-values doom-cli--table))) - (clis (seq-remove #'doom-cli-alias clis)) - (clis (seq-filter (fn! (cdr (assoc key (doom-cli-docs %)))) clis)) - (clis (seq-group-by #'doom-cli-command clis))) - (print! "List of environment variables for %s:\n" command) - (if (null clis) - (print! (indent "None!")) - (dolist (group clis) - (print! (bold "%s%s:" - (doom-cli-command-string (car group)) - (if (doom-cli-fn (doom-cli-get (car group))) - "" " *"))) - (dolist (cli (cdr group)) - (print! (indent "%s") (markup (cdr (assoc key (doom-cli-docs cli)))))))))) - ("--postamble" - (print! "See %s for documentation." - (join (cl-loop with spec = - `((?p . ,(doom-cli-context-prefix context)) - (?c . ,(doom-cli-command-string (cdr (doom-cli-command (or cli fallbackcli)))))) - for cmd in doom-help-commands - for formatted = (trim (format-spec cmd spec)) - collect (replace-regexp-in-string - " +" " " (format "'%s'" formatted))) - " or "))))))))) - -(defcli! (:root :version) - ((simple? ("--simple")) - &context context) - "Show installed versions of Doom, Doom modules, and Emacs." - (doom/version) - (unless simple? - (terpri) - (with-temp-buffer - (insert-file-contents (doom-path doom-emacs-dir "LICENSE")) - (re-search-forward "^Copyright (c) ") - (print! "%s\n" (trim (thing-at-point 'line t))) - (print! (p "Doom Emacs uses the MIT license and is provided without warranty " - "of any kind. You may redistribute and modify copies if " - "given proper attribution. See the LICENSE file for details."))))) - - -;; -;;; Helpers - -(defun doom-cli-help (cli) - "Return an alist of documentation summarizing CLI (a `doom-cli')." - (let* ((rcli (doom-cli-get cli)) - (docs (doom-cli-docs rcli))) - `((command . ,(doom-cli-command-string cli)) - (summary . ,(or (cdr (assoc "SUMMARY" docs)) "TODO")) - (description . ,(or (cdr (assoc "MAIN" docs)) "TODO")) - (synopsis . ,(doom-cli-help--synopsis cli)) - (arguments . ,(doom-cli-help--arguments rcli)) - (options . ,(doom-cli-help--options rcli)) - (commands . ,(doom-cli-subcommands cli 1)) - (sections . ,(seq-filter #'cdr (cddr docs)))))) - -(defun doom-cli-help-similar-commands (command &optional maxscore) - "Return N commands that are similar to COMMAND." - (seq-take-while - (fn! (>= (car %) (or maxscore 0.0))) - (seq-sort-by - #'car #'> - (cl-loop with prefix = (seq-find #'doom-cli-get (nreverse (doom-cli--command-expand command t))) - with input = (doom-cli-command-string (cdr (doom-cli--command command t))) - for command in (hash-table-keys doom-cli--table) - if (doom-cli-fn (doom-cli-get command)) - if (equal prefix (seq-take command (length prefix))) - collect (cons (doom-cli-help--similarity - input (doom-cli-command-string (cdr command))) - command))))) - -(defun doom-cli-help--similarity (a b) - (- 1 (/ (float (doom-cli-help--string-distance a b)) - (max (length a) (length b))))) - -(defun doom-cli-help--string-distance (a b) - "Calculate the Restricted Damerau-Levenshtein distance between A and B. -This is also known as the Optimal String Alignment algorithm. - -It is assumed that A and B are both strings, and before processing both are -converted to lowercase. - -This returns the minimum number of edits required to transform A -to B, where each edit is a deletion, insertion, substitution, or -transposition of a character, with the restriction that no -substring is edited more than once." - (let ((a (downcase a)) - (b (downcase b)) - (alen (length a)) - (blen (length b)) - (start 0)) - (when (> alen blen) - (let ((c a) - (clen alen)) - (setq a b alen blen - b c blen clen))) - (while (and (< start (min alen blen)) - (= (aref a start) (aref b start))) - (cl-incf start)) - (cl-decf start) - (if (= (1+ start) alen) - (- blen start) - (let ((v0 (make-vector (- blen start) 0)) - (v1 (make-vector (- blen start) 0)) - (a_i (aref a (max 0 start))) - (current 0) - a_i-1 b_j b_j-1 - left transition-next - above this-transition) - (dotimes (vi (length v0)) - (aset v0 vi (1+ vi))) - (dolist (i (number-sequence (1+ start) (1- alen))) - (setq a_i-1 a_i - a_i (aref a i) - b_j (aref b (max 0 start)) - left (- i start 1) - current (- i start) - transition-next 0) - (dolist (j (number-sequence (1+ start) (1- blen))) - (setq b_j-1 b_j - b_j (aref b j) - above current - current left - this-transition transition-next - transition-next (aref v1 (- j start))) - (aset v1 (- j start) current) - (setq left (aref v0 (- j start))) - (unless (= a_i b_j) - ;; Minimum between substitution, deletion, and insertion - (setq current (min (1+ current) (1+ above) (1+ left))) - (when (and (> i (1+ start)) (> j (1+ start)) (= a_i b_j-1) (= a_i-1 b_j)) - (setq current (min current (cl-incf this-transition))))) - (aset v0 (- j start) current))) - current)))) - -;;; Help: printers -;; TODO Parameterize optional args with `cl-defun' -(defun doom-cli-help--print (cli context &optional manpage? noglobal?) - "Write CLI's documentation in a manpage-esque format to stdout." - (let-alist (doom-cli-help cli) - (let* ((alist - `(,@(if manpage? - `((nil . ,(let* ((title (cadr (member "--load" command-line-args))) - (width (floor (/ (- (doom-cli-context-width context) - (length title)) - 2.0)))) - ;; FIXME Who am I fooling? - (format (format "%%-%ds%%s%%%ds" width width) - "DOOM(1)" title "DOOM(1)"))) - ("NAME" . ,(concat .command " - " .summary)) - ("SYNOPSIS" . ,(doom-cli-help--render-synopsis .synopsis nil t)) - ("DESCRIPTION" . ,.description)) - `((nil . ,(doom-cli-help--render-synopsis .synopsis "Usage: ")) - (nil . ,(string-join (seq-remove #'string-empty-p (list .summary .description)) - "\n\n")))) - ("ARGUMENTS" . ,(doom-cli-help--render-arguments .arguments)) - ("COMMANDS" - . ,(doom-cli-help--render-commands - .commands :prefix (doom-cli-command cli) :grouped? t :docs? t)) - ("OPTIONS" - . ,(doom-cli-help--render-options - (if (or (not (doom-cli-fn cli)) noglobal?) - `(,(assq 'local .options)) - .options) - cli)))) - (command (doom-cli-command cli))) - (letf! (defun printsection (section) - (print! "%s\n" - (if (null section) - (dark "TODO") - (markup - (format-spec - section `((?p . ,(car command)) - (?c . ,(doom-cli-command-string (cdr command)))) - 'ignore))))) - (pcase-dolist (`(,label . ,contents) alist) - (when (and contents (not (string-blank-p contents))) - (when label - (print! (bold "%s%s") label (if manpage? "" ":"))) - (print-group! :if label (printsection contents)))) - (pcase-dolist (`(,label . ,contents) .sections) - (when (and contents (not (assoc label alist))) - (print! (bold "%s:") label) - (print-group! (printsection contents)))))))) - -;;; Help: synopsis -(defun doom-cli-help--synopsis (cli &optional all-options?) - (let* ((rcli (doom-cli-get cli)) - (opts (doom-cli-help--options rcli)) - (opts (mapcar #'car (if all-options? (mapcan #'cdr opts) (alist-get 'local opts)))) - (opts (cl-loop for opt in opts - for args = (cdar opt) - for switches = (mapcar #'car opt) - for multi? = (member "..." args) - if args - collect (format (if multi? "[%s %s]..." "[%s %s]") - (string-join switches "|") - (string-join (remove "..." args) "|")) - else collect (format "[%s]" (string-join switches "|")))) - (args (doom-cli-arguments rcli)) - (subcommands? (doom-cli-subcommands rcli 1 :predicate? t))) - `((command . ,(doom-cli-command cli)) - (options ,@opts) - (required ,@(mapcar (fn! (upcase (format "`%s'" %))) (if subcommands? '(command) (alist-get '&required args)))) - (optional ,@(mapcar (fn! (upcase (format "[`%s']" %)))(alist-get '&optional args))) - (rest ,@(mapcar (fn! (upcase (format "[`%s'...]" %))) (if subcommands? '(args) (alist-get '&args args))))))) - -(defun doom-cli-help--render-synopsis (synopsis &optional prefix) - (let-alist synopsis - (let ((doom-print-indent 0) - (prefix (or prefix "")) - (command (doom-cli-command-string .command))) - (string-trim-right - (format! "%s\n\n" - (fill (concat (bold prefix) - (format "%s " command) - (markup - (join (append .options - (and .options - (or .required - .optional - .rest) - (list (dark "[--]"))) - .required - .optional - .rest)))) - 80 (1+ (length (concat prefix command))))))))) - -;;; Help: arguments -(defun doom-cli-help--arguments (cli &optional all?) - (doom-cli-help--parse-docs (doom-cli-find cli t) "ARGUMENTS")) - -(defun doom-cli-help--render-arguments (arguments) - (mapconcat (lambda (arg) - (format! "%-20s\n%s" - (underscore (car arg)) - (indent (if (equal (cdr arg) "TODO") - (dark (cdr arg)) - (cdr arg)) - doom-print-indent-increment))) - arguments - "\n")) - -;;; Help: commands -(cl-defun doom-cli-help--render-commands (commands &key prefix grouped? docs? (inline? t)) - (with-temp-buffer - (let* ((doom-print-indent 0) - (commands (seq-group-by (fn! (if grouped? (doom-cli-prop (doom-cli-get % t) :group))) - (nreverse commands))) - (toplevel (assq nil commands)) - (rest (remove toplevel commands)) - (drop (if prefix (length prefix) 0)) - (minwidth - (apply - #'max (or (cl-loop for cmd in (apply #'append (mapcar #'cdr commands)) - for cmd = (seq-drop cmd drop) - collect (length (doom-cli-command-string cmd))) - (list 15)))) - (ellipsis (doom-print--style 'dark " […]")) - (ellipsislen (- (length ellipsis) (if (eq doom-print-backend 'ansi) 2 4)))) - (dolist (group (cons toplevel rest)) - (let ((label (if (car-safe group) (cdr commands)))) - (when label - (insert! ((bold "%s:") (car group)) "\n")) - (print-group! :if label - (dolist (command (cdr group)) - (let* ((cli (doom-cli-get command t)) - (rcli (doom-cli-get command)) - (summary (doom-cli-short-docs rcli)) - (subcommands? (doom-cli-subcommands cli 1 :predicate? t))) - (insert! ((format "%%-%ds%%s%%s" - (+ (- minwidth doom-print-indent) - doom-print-indent-increment - (if subcommands? ellipsislen 0))) - (concat (doom-cli-command-string (seq-drop command drop)) - (if subcommands? ellipsis)) - (if inline? " " "\n") - (indent (if (and (doom-cli-alias cli) - (not (doom-cli-type rcli))) - (dark "-> %s" (doom-cli-command-string cli)) - (when docs? - (if summary (markup summary) (dark "TODO")))))) - "\n"))) - (when (cdr rest) - (insert "\n"))))) - (string-trim-right (buffer-string))))) - -;;; Help: options -(defun doom-cli-help--options (cli &optional noformatting?) - "Return an alist summarizing CLI's options. - -The alist's CAR are lists of formatted switches plus their arguments, e.g. -'((\"`--foo'\" \"`BAR'\") ...). Their CDR is their formatted documentation." - (let* ((docs (doom-cli-help--parse-docs (doom-cli-find cli t) "OPTIONS")) - (docs (mapcar (fn! (cons (split-string (car %) ", ") - (cdr %))) - docs)) - (strfmt (if noformatting? "%s" "`%s'")) - local-options - global-options - seen) - (dolist (neighbor (nreverse (doom-cli-find cli))) - (dolist (option (doom-cli-options neighbor)) - (when-let* ((switches (cl-loop for sw in (doom-cli-option-switches option) - if (and (doom-cli-option-flag-p option) - (string-prefix-p "--" sw)) - collect (format "--[no-]%s" (substring sw 2)) - else collect sw)) - (switches (seq-difference switches seen))) - (dolist (switch switches) (push switch seen)) - (push (cons (cl-loop for switch in switches - if (doom-cli-option-arguments option) - collect (cons (format strfmt switch) - (append (doom-cli-help--parse-args it noformatting?) - (when (doom-cli-option-multiple-p option) - (list "...")))) - else collect (list (format strfmt switch))) - (string-join - (or (delq - nil (cons (when-let (docs (doom-cli-option-docs option)) - (concat docs ".")) - (cl-loop for (flags . docs) in docs - unless (equal (seq-difference flags switches) flags) - collect docs))) - '("TODO")) - "\n\n")) - (if (equal (doom-cli-command neighbor) - (doom-cli-command cli)) - local-options - global-options))))) - `((local . ,(nreverse local-options)) - (global . ,(nreverse global-options))))) - -(defun doom-cli-help--render-options (options &optional cli) - (let ((doom-print-indent 0) - (local (assq 'local options)) - (global (assq 'global options))) - (when (or (cdr local) (cdr global)) - (letf! (defun printopts (opts) - (pcase-dolist (`(,switches . ,docs) (cdr opts)) - (let (multiple?) - (insert! - ("%s%s\n%s" - (mapconcat - (fn! (when (member "..." (cdr %)) - (setq multiple? t)) - (string-trim-right - (format "%s %s" - (doom-print--cli-markup (car %)) - (doom-print--cli-markup - (string-join (remove "..." (cdr %)) "|"))))) - switches - ", ") - (if multiple? ", ..." "") - (indent (fill (markup docs)) doom-print-indent-increment)) - "\n\n")))) - (with-temp-buffer - (if (null (cdr local)) - (insert (if global "This command has no local options.\n" "") "\n") - (printopts local)) - (when (cdr global) - (insert! ((bold "Global options:\n"))) - (print-group! (printopts global))) - (string-trim-right (buffer-string))))))) - -;;; Help: internal -(defun doom-cli-help--parse-args (args &optional noformatting?) - (cl-loop for arg in args - if (listp arg) - collect (string-join (doom-cli-help--parse-args arg noformatting?) "|") - else if (symbolp arg) - collect (format (if noformatting? "%s" "`%s'") (upcase (symbol-name arg))) - else collect arg)) - -(defun doom-cli-help--parse-docs (cli-list section-name) - (cl-check-type section-name string) - (let (alist) - (dolist (cli cli-list (nreverse alist)) - (when-let (section (cdr (assoc section-name (doom-cli-docs cli)))) - (with-temp-buffer - (save-excursion (insert section)) - (let ((lead (current-indentation)) - (buffer (current-buffer))) - (while (not (eobp)) - (let ((heading (string-trim (buffer-substring (point-at-bol) (point-at-eol)))) - (beg (point-at-bol 2)) - end) - (forward-line 1) - (while (and (not (eobp)) - (/= (current-indentation) lead) - (forward-line 1))) - (setf (alist-get heading alist nil nil #'equal) - (string-join - (delq - nil (list (alist-get heading alist nil nil #'equal) - (let ((end (point))) - (with-temp-buffer - (insert-buffer-substring buffer beg end) - (goto-char (point-min)) - (indent-rigidly (point-min) (point-max) (- (current-indentation))) - (string-trim-right (buffer-string)))))) - "\n\n")))))))))) - -(provide 'doom-cli-meta) -;;; meta.el ends here diff --git a/lisp/doom-cli-lib.el b/lisp/doom-cli-lib.el new file mode 100644 index 000000000..1ee45a8ab --- /dev/null +++ b/lisp/doom-cli-lib.el @@ -0,0 +1,2320 @@ +;;; lisp/doom-cli-lib.el --- API for Doom's CLI framework -*- lexical-binding: t; -*- + +(require 'doom-modules) +(require 'doom-packages) +(require 'doom-profiles) + +(defgroup doom-cli nil + "Doom's command-line interface framework." + :link '(url-link "https://doomemacs.org/cli") + :group 'doom) + +(defcustom doom-cli-load-path + (append (when-let ((doompath (getenv "DOOMPATH"))) + (cl-loop for dir in (split-string doompath path-separator) + collect (expand-file-name dir))) + (list (file-name-concat (dir!) "cli"))) + "A list of paths to search for autoloaded Doom CLIs. + +It is prefilled by the DOOMPATH envvar (a colon-separated list on Linux/macOS, +semicolon otherwise)." + :type '(list directory) + :group 'doom-cli) + + +;; +;;; CLI definition variables + +(defvar doom-cli-argument-types + '(&args + &cli + &context + &flags + &multiple + &optional + &rest + &required + &input + &whole) + "A list of auxiliary keywords allowed in `defcli!'s arglist. + +See `defcli!' for documentation on them.") + +(defvar doom-cli-option-types + '((&flag . &flags) + (&multi . &multiple)) + "An alist of auxiliary keywords permitted in option specs in `defcli!'. + +They serve as shorter, inline aliases for `doom-cli-argument-types'. + +See `defcli!' for documentation on them.") + +(defvar doom-cli-option-generators + '((&flags . doom-cli--make-option-flag) + (&multiple . doom-cli--make-option-multi) + (&required . doom-cli--make-option-generic) + (&optional . doom-cli--make-option-generic)) + "An alist of `doom-cli-option' factories for argument types. + +Types that + +See argument types in `doom-cli-argument-types', and `defcli!' for usage.") + +(defvar doom-cli-option-arg-types + `((dir :test file-directory-p + :read expand-file-name + :error "Not a valid path to an existing directory" + :zshcomp "_dirs") + (file :test file-exists-p + :read expand-file-name + :error "Not a valid path to an existing file" + :zshcomp "_files") + (stdout :test ,(lambda (str) (equal str "-")) + :read identity + :error "Not a dash to signal stdout" + :zshcomp "(-)") + (path :read expand-file-name :zshcomp "_files") + (form :read read) + (regexp :test ,(lambda (str) (always (string-match-p str "")))) + (int :test "^[0-9]+$" + :read string-to-number + :error "Not an integer") + (num :test "^[0-9]+\\(\\.[0-9]+\\)?$" + :read string-to-number + :error "Not a valid number or float") + (float :test "^[0-9]+\\(\\.[0-9]+\\)$" + :read string-to-number + :error "Not a float") + (bool :test "^y\\(?:es\\)?\\|no?\\|on\\|off\\|t\\(?:rue\\)?\\|false\\|[01]\\|$" + :read ,(lambda (x) + (pcase x + ((or "y" "yes" "t" "true" "1" "on") :yes) + ((or "n" "no" "nil" "false" "0" "off") :no))) + :error "Not a valid boolean, should be blank or one of: yes, no, y, n, true, false, on, off" + :zshcomp "(y n yes no true false on off 1 0)") + (date :test ,(lambda (str) + (let ((ts (parse-time-string str))) + (and (decoded-time-day ts) + (decoded-time-month ts) + (decoded-time-year ts)))) + :read parse-time-string + :error "Not a valid date (try YYYY-MM-DD or a date produced by `date')") + (time :test ,(lambda (str) + (let ((ts (parse-time-string str))) + (and (decoded-time-hour ts) + (decoded-time-minute ts) + (decoded-time-second ts)))) + :read parse-time-string + :error "Not a valid date (try YYYY-MM-DD or a date produced by `date')") + (duration :test ,(lambda (str) + (not (cl-loop for d in (split-string-and-unquote str " ") + unless (string-match-p "^[0-9]+[hmsdMY]$" d) + return t))) + :read ,(doom-rpartial #'split-string-and-unquote " ") + :error "Not a valid duration (e.g. 5h 20m 40s 2Y 1M)") + (size :test "^[0-9]+[kmgt]?b$" + :read ,(lambda (str) + (save-match-data + (and (string-match "^\\([0-9]+\\(?:\\.[0-9]+\\)\\)\\([kmgt]?b\\)$" str) + (* (string-to-number (match-string 1 str)) + (or (cdr (assoc (match-string 2 str) + '(("kb" . 1000) + ("mb" . 1000000) + ("gb" . 1000000000) + ("tb" . 1000000000000)))) + 1))))) + :error "Not a valid filesize (e.g. 5mb 10.4kb 2gb 1.4tb)")) + "A list of implicit option argument datatypes and their rules. + +Recognizies the following properies: + + :test FN + Predicate function to determine if a value is valid. + :read FN + A transformer that converts the string argument to a desired format. + :error STR + The message to display if a value fails :test.") + +;;; Post-script settings +(defvar doom-cli-exit-commands + '(;; (:editor . doom-cli--exit-editor) + ;; (:emacs . doom-cli--exit-emacs) + (:pager . doom-cli--exit-pager) + (:pager? . doom-cli--exit-pager-maybe) + (:restart . doom-cli--exit-restart)) + "An alist of commands that `doom-cli--exit' recognizes.") + +(defcustom doom-cli-pager (getenv "DOOMPAGER") + "The PAGER command to use. + +If nil, falls back to less." + :type 'string + :group 'doom-cli) + +(defcustom doom-cli-pager-ratio 1.0 + "If output exceeds TTY height times this ratio, the pager is invoked. + +Only applies if (exit! :pager) or (exit! :pager?) are called." + :type 'float + :group 'doom-cli) + +;;; Logger settings +(defvar doom-cli-log-file-format (expand-file-name "logs/cli.%s.%s.%s" doom-state-dir) + "Where to write any output/log file to. + +Must have two arguments, one for session id and the other for log type.") + +(defvar doom-cli-log-retain 12 + "Number of each log type to retain.") + +(defvar doom-cli-log-backtrace-depth 12 + "How many frames of the backtrace to display in stdout.") + +(defvar doom-cli-log-straight-error-lines 16 + "How many lines of straight.el errors to display in stdout.") + +(defvar doom-cli-log-benchmark-threshold 5 + "How much execution time (in seconds) before benchmark is shown. + +If set to nil, only display benchmark if a CLI explicitly requested with a +non-nil :benchmark property. +If set to `always', show the benchmark no matter what.") + +;;; Internal variables +(defvar doom-cli--context nil) +(defvar doom-cli--exit-code 255) +(defvar doom-cli--group-plist nil) +(defvar doom-cli--table (make-hash-table :test 'equal)) + + +;; +;;; Custom hooks + +(defcustom doom-cli-create-context-functions () + "A hook executed once a new context has been generated. + +Called by `doom-cli-context-parse' and `doom-cli-context-restore', once a +`doom-cli-context' is fully populated and ready to be executed (but before it +has). + +Hooks are run with one argument: the newly created context." + :type 'hook + :group 'doom-cli) + +(defcustom doom-cli-before-run-functions () + "Hooks run before `run!' executes the command. + +Runs with a single argument: the active context (a `doom-cli-context' struct)." + :type 'hook + :group 'doom-cli) + +(defcustom doom-cli-after-run-functions () + "Hooks run after `run!' has executed the command. + +Runs with two arguments: the active context (a `doom-cli-context' struct) and +the return value of the executed CLI." + :type 'hook + :group 'doom-cli) + + +;; +;;; Errors + +(define-error 'doom-cli-error "There was an unexpected error" 'doom-error) +(define-error 'doom-cli-definition-error "Invalid CLI definition" 'doom-cli-error) +(define-error 'doom-cli-autoload-error "Failed to autoload deferred command" 'doom-cli-error) +(define-error 'doom-cli-invalid-prefix-error "Prefix has no defined commands" 'doom-cli-error) +(define-error 'doom-cli-command-not-found-error "Could not find that command" 'doom-cli-error) +(define-error 'doom-cli-wrong-number-of-arguments-error "Wrong number of CLI arguments" 'doom-cli-error) +(define-error 'doom-cli-unrecognized-option-error "Not a recognized option" 'doom-cli-error) +(define-error 'doom-cli-invalid-option-error "Invalid option value" 'doom-cli-error) + + +;; +;;; `doom-cli' + +(cl-defstruct doom-cli + "An executable CLI command." + (command nil :read-only t) + type + docs + autoload + alias + options + arguments + plist + fn) + +(defun doom-cli-execute (cli bindings) + "Execute CLI with BINDINGS (an alist). + +BINDINGS is an alist of (SYMBOL . VALUE) to bind lexically during CLI's +execution. Can be generated from a `doom-cli-context' with +`doom-cli--bindings'." + (doom-log "execute: %s %s" (doom-cli-key cli) bindings) + (funcall (doom-cli-fn cli) cli bindings)) + +(defun doom-cli-key (cli) + "Return CLI's (type . command), used as a table key or unique identifier." + (let ((command (doom-cli-command cli))) + (if-let (type (doom-cli-type cli)) + (cons type command) + command))) + +(defun doom-cli-command-normalize (command &optional plist) + "Ensure that COMMAND is properly formatted. + +This means that all non-keywords are strings, any prefixes provided by PLIST are +prepended, and the keyword is in front." + (let* ((command (ensure-list command)) + (prefix (plist-get plist :prefix)) + (prefix (if prefix (doom-cli-command-normalize + prefix (append `(:prefix nil) plist)))) + (command (append prefix command)) + (type (cl-find-if #'keywordp (remq :root command) :from-end t)) + (command (seq-subseq + command (or (cl-position :root command :from-end t) + 0)))) + (when (or command prefix) + (cl-loop with map = (fn! (if (or (stringp %) (keywordp %)) % (prin1-to-string %))) + for c in (delq nil (cons type (seq-remove #'keywordp command))) + if (listp c) + collect (mapcar map c) + else collect (funcall map c))))) + +(defun doom-cli-command-string (command) + "Return a joined string representation of normalized COMMAND. + +COMMAND should either be a command list (e.g. '(doom foo bar)) or a `doom-cli' +struct." + (mapconcat (doom-partial #'format "%s") + (doom-cli--command command) + " ")) + +(defun doom-cli-get (command &optional noresolve? noload?) + "Return CLI at COMMAND. + +Will autoload COMMAND if it was deferred with `defcli-autoload!'. + +If NORESOLVE?, don't follow aliases." + (when-let* ((command (doom-cli--command command)) + (cli (gethash command doom-cli--table)) + (cli (if noload? cli (doom-cli-load cli)))) + (if noresolve? + cli + (let (path) + (while (setq path (ignore-errors (doom-cli-alias cli))) + (setq cli (doom-cli-get path t noload?))) + (unless cli + (signal 'doom-cli-command-not-found-error (or path command))) + cli)))) + +(defun doom-cli-path (cli &optional noload?) + "Return a list of `doom-cli's encountered while following CLI's aliases. + +If NOLOAD? is non-nil, don't autoload deferred CLIs (see `doom-cli-get')." + (when cli + (cons + cli (let (alias paths) + (while (setq alias (ignore-errors (doom-cli-alias cli))) + (and (setq cli (doom-cli-get alias t noload?)) + (push cli paths))) + (nreverse paths))))) + +(defun doom-cli-find (command &optional nopartials?) + "Find all CLIs assocated with COMMAND, including partials. + +COMMAND can be a command path (list of strings), a `doom-cli' struct, or a +`doom-cli-context' struct. + +Returned in the order they will execute. Includes pseudo CLIs." + (let* ((command (doom-cli--command command)) + (paths (nreverse (doom-cli--command-expand command t))) + results clis) + (push '(:after) results) + (dolist (path paths) + (push (cons :after path) results)) + (push command results) + (dolist (path (nreverse paths)) + (push (cons :before path) results)) + (push '(:before) results) + (dolist (result results (nreverse clis)) + (when-let ((cli (doom-cli-get result t)) + ((or (not nopartials?) + (doom-cli-type cli)))) + (cl-pushnew cli clis + :test #'equal + :key #'doom-cli-key))))) + +(defun doom-cli-prop (cli prop &optional null-value) + "Returns a PROPerty of CLI's plist, or NULL-VALUE if it doesn't exist." + (let ((plist (doom-cli-plist cli))) + (if (plist-member plist prop) + (plist-get plist prop) + null-value))) + +(cl-defun doom-cli-subcommands (command &optional (depth 9999) &key tree? all? predicate?) + "Return a list of subcommands, DEPTH levels deep, below COMMAND. + + If DEPTH is non-nil, list *all* subcommands, recursively. Otherwise it expects +an integer. + If TREE?, return commands in a tree structure. + If ALL?, include hidden commands (like aliases)." + (when (or (null depth) (> depth 0)) + (catch :predicate + (let* ((command (doom-cli--command command t)) + (prefixlen (length command)) + results) + (dolist (cli (hash-table-values doom-cli--table)) + (let ((clicmd (doom-cli-command cli))) + (when (and (not (doom-cli-type cli)) + (= (length clicmd) (1+ prefixlen)) + (equal command (seq-take clicmd prefixlen)) + (or all? (not (doom-cli-prop cli :hide)))) + (when predicate? + (throw :predicate t)) + (let* ((car (if tree? (car (last clicmd)) clicmd)) + (cdr (doom-cli-subcommands + clicmd (if depth (1- depth)) + :tree? tree? + :all? all?))) + (if tree? + (push (if cdr (cons car cdr) car) results) + (cl-callf nconc results (cons car cdr))))))) + (if tree? + (nreverse results) + results))))) + +(defun doom-cli-aliases (cli) + "Return all known `doom-cli's that are aliased to CLI. + +This cannot see autoloaded CLIs. Use `doom-cli-load' or `doom-cli-load-all' +to reach them." + (cl-loop with cli = (doom-cli-get cli) + with key = (doom-cli-key cli) + for rcli in (hash-table-values doom-cli--table) + if (equal key (doom-cli-key rcli)) + collect cli)) + +(defun doom-cli-short-docs (cli) + "Return the first line of CLI's documentation. + +Return nil if CLI (a `doom-cli') has no explicit documentation." + (ignore-errors (cdr (assoc "SUMMARY" (doom-cli-docs cli))))) + +(defun doom-cli--bindings (cli context &optional seen) + "Return a CLI with a value alist in a cons cell." + (let* ((optspec (doom-cli-options cli)) + (argspec (doom-cli-arguments cli)) + alist) + ;; Ensure all symbols are defined + (dolist (opt optspec) + (setf (alist-get (doom-cli-option-symbol opt) alist) + (doom-cli-option-default opt))) + (dolist (syms argspec) + (dolist (sym (cdr syms)) + (setf (alist-get sym alist) nil))) + ;; Populate options + (let ((options (doom-cli-context-options context))) + (dolist (opt optspec) + (when-let (option (cl-loop for flag in (doom-cli-option-switches opt) + if (cdr (assoc flag options)) + return (cons flag it))) + (unless (member (car option) seen) + (setf (alist-get (doom-cli-option-symbol opt) alist) + (cdr option)) + (push (car option) seen))))) + ;; Populate arguments + (let* ((arglist (doom-cli-context-arguments context)) + (rest (copy-sequence (map-elt arglist (doom-cli-command cli)))) + (args (copy-sequence (alist-get t arglist))) + (argc (length args)) + (required (alist-get '&required argspec)) + (optional (alist-get '&optional argspec)) + (spec (append required optional)) + (min (length required)) + (max (if (or (assq '&args argspec) + (assq '&rest argspec)) + most-positive-fixnum + (length spec)))) + (when (or (< argc min) + (> argc max)) + (signal 'doom-cli-wrong-number-of-arguments-error + (list (doom-cli-key cli) nil args min max))) + (dolist (sym spec) + (setf (alist-get sym alist) (if args (pop args)))) + (dolist (type `((&args . ,args) + (&cli . ,cli) + (&context . ,context) + (&input + . ,(if (doom-cli-context-pipe-p context :in t) + (with-current-buffer (doom-cli-context-stdin context) + (buffer-string)))) + (&rest . ,rest) + (&whole . ,(doom-cli-context-whole context)))) + (when-let (var (car (alist-get (car type) argspec))) + (setf (alist-get var alist) (cdr type))))) + alist)) + +(defun doom-cli--command (target &optional notype?) + "Fetch the normalized command from TARGET. + +If NOTYPE? is non-nil, omit any leading keywords from the command. + +TARGET can be a `doom-cli', `doom-cli-context', or a command list." + (cond ((doom-cli-p target) + (if notype? + (doom-cli-command target) + (doom-cli-key target))) + ((doom-cli-context-p target) + (doom-cli-context-command target)) + ((and target (not (listp target))) + (signal 'wrong-type-argument + (list '(doom-cli-p doom-cli-context-p listp) target))) + ((let ((target (doom-cli-command-normalize target))) + (if (and notype? (keywordp (car target))) + (cdr target) + target))))) + +(defun doom-cli--command-expand (commandspec &optional recursive?) + "Expand COMMANDSPEC into a list of commands. + +If RECURSIVE, includes breadcrumbs leading up to COMMANDSPEC." + (funcall (if recursive? + #'identity + (fn! (cl-loop with cmdlen = (length (car %)) + for command in % + while (= (length command) cmdlen) + collect command))) + (seq-reduce (lambda (init next) + (nconc (cl-loop with firstlen = (length (car init)) + for seg in (ensure-list next) + nconc + (cl-loop for command in init + while (= (length command) firstlen) + collect (append command (list seg)))) + init)) + (cdr commandspec) + `(,@(mapcar #'list (ensure-list (car commandspec))))))) + +(defun doom-cli--parse-docs (docs) + (when (and (stringp docs) + (not (equal docs "TODO"))) + (let ((re "^\\([A-Z0-9 _-]+\\):\n") sections) + (with-temp-buffer + (save-excursion + (insert "__DOOMDOCS__:\n") + (insert docs)) + (while (re-search-forward re nil t) + (push (cons (match-string 1) + (let ((buffer (current-buffer)) + (beg (match-end 0)) + (end (save-excursion + (if (re-search-forward re nil t) + (1- (match-beginning 0)) + (point-max))))) + (with-temp-buffer + (insert-buffer-substring buffer beg end) + (goto-char (point-min)) + (indent-rigidly (point-min) (point-max) (- (skip-chars-forward " "))) + (string-trim-right (buffer-string))))) + sections))) + (let ((lines (split-string (cdr (assoc "__DOOMDOCS__" sections)) "\n")) + (sections (assoc-delete-all "__DOOMDOCS__" sections))) + `(("SUMMARY" . ,(car lines)) + ("MAIN" . ,(string-trim (string-join (cdr lines) "\n"))) + ,@(nreverse sections)))))) + + +;; +;;; `doom-cli-option' + +(cl-defstruct doom-cli-option + "A switch specification dictating the characteristics of a recognized option." + (symbol nil :read-only t) + docs + multiple-p + flag-p + switches + arguments + default) + +(defun doom-cli-option-validate (option &rest values) + "Test if OPTION will accept VALUES, and conforms them if necessary. + +OPTION is a `doom-cli-option' struct. VALUES can be any arbitrary values. +Returns VALUES once mapped through their respective reader (as dictated by +`doom-cli-option-arg-types'). + +Throws `doom-cli-invalid-option-error' for illegal values." + (let ((args (doom-cli-option-arguments option)) + (values (copy-sequence values))) + (dotimes (i (length args) values) + (let ((value (nth i values)) + (types (ensure-list (nth i args))) + errors) + (catch 'done + (dolist (type types) + ;; REVIEW Use pcase-let + map.el when 27.x support is dropped + (cl-destructuring-bind (&key test read error &allow-other-keys) + (if (or (symbolp type) + (and (stringp type) + (string-match-p "^[A-Z0-9-_]+$" type))) + (cdr (assq (if (symbolp type) type (intern (downcase type))) + doom-cli-option-arg-types)) + (list 'str :test #'stringp)) + (condition-case-unless-debug e + (or (and (or (null test) + (if (stringp test) + (and (string-match-p test value) t) + (funcall test value))) + (or (null read) + (setf (nth i values) (funcall read value))) + (throw 'done t)) + (push error errors)) + ((invalid-regexp invalid-read-syntax) + (push (error-message-string e) errors))))) + (signal 'doom-cli-invalid-option-error + (list types option value errors))))))) + +(defun doom-cli--read-option-switches (optspec) + (delq + nil (cl-loop for spec in optspec + if (and (stringp spec) + (string-match-p "^-\\(?:-[a-zA-Z0-9]\\|[^-]$\\)" spec)) + collect spec))) + +(defun doom-cli--read-option-args (argspec) + (delq + nil (cl-loop for spec in argspec + if (or (and (stringp spec) + (not (string-match-p "^-\\(?:-[a-zA-Z0-9]\\|[^-]$\\)" spec))) + (keywordp spec) + (symbolp spec) + (listp spec)) + collect spec))) + +(defun doom-cli--make-option-generic (symbol spec &optional docs) + (make-doom-cli-option + :symbol symbol + :docs docs + :switches (doom-cli--read-option-switches spec) + :arguments (doom-cli--read-option-args spec))) + +(defun doom-cli--make-option-flag (symbol spec &optional docs) + (let ((switches (doom-cli--read-option-switches spec)) + (args (doom-cli--read-option-args spec))) + (when (and args + (not (or (memq :yes args) + (memq :no args)))) + (signal 'doom-cli-definition-error + (list "Argument type %s cannot accept arguments for: %s" + '&flag (mapconcat #'symbol-name spec ", ")))) + (make-doom-cli-option + :symbol symbol + :docs docs + :flag-p t + :switches switches + :default (car args)))) + +(defun doom-cli--make-option-multi (symbol spec &optional docs) + (make-doom-cli-option + :symbol symbol + :docs docs + :multiple-p t + :switches (doom-cli--read-option-switches spec) + :arguments (doom-cli--read-option-args spec))) + + +;; +;;; `doom-cli-context' + +(cl-defstruct doom-cli-context + "A CLI context, containing all state pertinent to the current session." + (init-time before-init-time) ; When this context was created + ;; A session-specific ID of the current context (defaults to number + (pid (if-let (pid (getenv "__DOOMPID")) + (string-to-number pid) + (emacs-pid))) + ;; Number of Emacs processes this context has been processed through + (step (if-let (step (getenv "__DOOMSTEP")) + (string-to-number step) + -1)) + ;; The geometry of the terminal window. + (geometry (save-match-data + (when-let* ((geom (getenv "__DOOMGEOM")) + ((string-match "^\\([0-9]+\\)x\\([0-9]+\\)$" geom))) + (cons (string-to-number (match-string 1 geom)) + (string-to-number (match-string 2 geom)))))) + ;; Whether the script is being piped into or out of + (pipes (cl-loop for (env . scope) in `((,(getenv "__DOOMGPIPE") . global) + (,(getenv "__DOOMPIPE") . local)) + if (stringp env) + for pipes = (string-to-list env) + nconc `(,@(if (memq ?0 pipes) `((:in . ,scope))) + ,@(if (memq ?1 pipes) `((:out . ,scope))))) + :skip t) + ;; If non-nil, suppress prompts and auto-accept their consequences. + suppress-prompts-p + (prefix "@") ; The basename of the script creating this context + meta-p ; Whether or not this is a help/meta request + error ; + (command nil :skip t) ; The full command that led to this context + (path nil :skip t) ; Breadcrumb list of resolved commands so far + (whole nil :skip t) ; Unfiltered and unprocessed list of arguments + (options nil :skip t) ; An alist of (flags . value) + (arguments nil :skip t) ; An alist of non-subcommand arguments, by command + (stdin (generate-new-buffer " *doom-cli stdin*") :type buffer) ; buffer containing anything piped into this session + (stdout (generate-new-buffer " *doom-cli stdout*") :type buffer) ; buffer containing user-visible output + (stderr (generate-new-buffer " *doom-cli stderr*") :type buffer) ; buffer containing all output, including debug output + ;; An alist of persistent and arbitrary elisp state + (state nil :type alist)) + +(defun doom-cli-context-execute (context) + "Execute a given CONTEXT. + +Use `doom-cli-context-parse' or `doom-cli-context-restore' to produce a valid, +executable context." + (let* ((command (doom-cli-context-command context)) + (cli (doom-cli-get command t)) + (prefix (doom-cli-context-prefix context))) + (doom-log "context-execute: %s" + (mapconcat #'doom-cli-command-string + (delq nil (list (car (doom-cli-context-path context)) command)) + " -> ")) + (cond ((null (or command (doom-cli-get (list prefix) t))) + (signal 'doom-cli-invalid-prefix-error (list prefix))) + + ((doom-cli-context-meta-p context) + (pcase (doom-cli-context-meta-p context) + ("--version" + (doom-cli-call `(:version ,@(cdr command)) context) + t) + ((or "-?" "--help") + (doom-cli-call `(:help ,@(cdr command)) context) + t) + (_ (error "In meta mode with no destination!")))) + + ((not (and cli (doom-cli-fn (doom-cli-get cli)))) + (signal 'doom-cli-command-not-found-error + (append command (alist-get t (doom-cli-context-arguments context))))) + + ((let ((seen '(t)) + runners) + (dolist (cli (doom-cli-find command (doom-cli-type cli))) + (push (cons (doom-cli-get cli) + (doom-cli--bindings cli context seen)) + runners)) + (pcase-dolist (`(,cli . ,bindings) (nreverse runners)) + (doom-cli-execute cli bindings)) + context))))) + +(defun doom-cli-context-restore (file context) + "Restore the last restarted context from FILE into CONTEXT." + (when (and (stringp file) + (file-exists-p file)) + (when-let (old-context (with-temp-buffer + (insert-file-contents file) + (read (current-buffer)))) + (unless (doom-cli-context-p old-context) + (error "An invalid context was restored from file: %s" file)) + (unless (equal (doom-cli-context-prefix context) + (doom-cli-context-prefix old-context)) + (error "Restored context belongs to another script: %s" + (doom-cli-context-prefix old-context))) + (pcase-dolist (`(,slot ,_ . ,plist) + (cdr (cl-struct-slot-info 'doom-cli-context))) + (unless (plist-get plist :skip) + (let* ((idx (cl-struct-slot-offset 'doom-cli-context slot)) + (old-value (aref old-context idx))) + (aset context idx + (pcase (plist-get plist :type) + (`alist + (dolist (entry old-value (aref context idx)) + (setf (alist-get (car entry) (aref context idx)) (cdr entry)))) + (`buffer + (with-current-buffer (aref context idx) + (insert old-value) + (current-buffer))) + (_ old-value)))))) + (run-hook-with-args 'doom-cli-create-context-functions context) + (delete-file file) + (doom-log "context-restore: %s" (doom-cli-context-pid context)))) + context) + +(defun doom-cli-context-parse (args context) + "Parse ARGS and update CONTEXT to reflect it." + (let* ((case-fold-search t) + (args (delq nil (copy-sequence args))) + (arguments) + rest? + arg) + (while args + (setq arg (pop args)) + (save-match-data + (cond + ((equal arg "--") + (doom-log "context-parse: found arg separator" arg) + (setq arguments (cdr args) + args nil)) + + ((and (stringp arg) + (string-match "^\\(-\\([^-]\\{2,\\}\\)\\)" arg)) + (let ((chars (split-string (match-string 2 arg) "" t))) + (dolist (ch (nreverse chars)) + (push (concat "-" ch) args)))) + + ((and (stringp arg) + (or (string-match "^\\(--\\w[a-z0-9-_]+\\)\\(?:=\\(.*\\)\\)?$" arg) + (string-match "^\\(-[^-]\\)$" arg))) + (doom-log "context-parse: found switch %S" arg) + (catch :skip + (let* ((fullflag (match-string 1 arg)) + (normflag (if (string-prefix-p "--no-" fullflag) + (concat "--" (substring fullflag 5)) + fullflag)) + (option (or (doom-cli-context-find-option context normflag) + (when (member fullflag '("-?" "--help" "--version")) + (doom-log "context-parse: found help switch %S" arg) + (setf (doom-cli-context-meta-p context) fullflag) + (throw :skip t)) + (when rest? + (push arg arguments) + (throw :skip t)) + (signal 'doom-cli-unrecognized-option-error + (list fullflag)))) + (explicit-arg (match-string 2 arg)) + (arity (length (doom-cli-option-arguments option))) + (key (if (doom-cli-option-multiple-p option) + (car (doom-cli-option-switches option)) + normflag))) + (doom-cli-context-put + context key + (let ((value (seq-take args arity))) + (when explicit-arg + (push explicit-arg value)) + (when (/= (length value) arity) + (signal 'doom-cli-wrong-number-of-arguments-error + (list (doom-cli--command context) + fullflag value arity arity))) + (setq args (seq-drop args arity) + value (apply #'doom-cli-option-validate option value)) + (cond ((doom-cli-option-flag-p option) + (if (string-prefix-p "--no-" fullflag) :no :yes)) + ((doom-cli-option-multiple-p option) + (append (doom-cli-context-get context key) + (if (doom-cli-option-arguments option) + (cl-loop for v in value + collect (cons fullflag v)) + (list fullflag)))) + ((= arity 1) (car value)) + ((> arity 1) value) + (fullflag))))))) + + ((when-let* + (((null arguments)) + ((not rest?)) + (command (append (doom-cli-context-command context) (list arg))) + (cli (doom-cli-get command t)) + (rcli (doom-cli-get command)) + (key (doom-cli-key rcli))) + (doom-log "context-parse: found command %s" command) + ;; Show warnings depending on CLI plists + (when (doom-cli-alias cli) + (dolist (pcli (doom-cli-path cli)) + (doom-log "context-parse: path += %s" (doom-cli-key pcli)) + (push (doom-cli-key pcli) (doom-cli-context-path context)))) + ;; Collect &rest for this command + (setf (doom-cli-context-command context) key + (map-elt (doom-cli-context-arguments context) + (doom-cli-command rcli)) + (copy-sequence args)) + ;; Initialize options associated with this command to a nil value; + ;; this simplifies existence validation later. + (dolist (cli (doom-cli-find key)) + (dolist (option (doom-cli-options cli)) + (dolist (switch (doom-cli-option-switches option)) + (unless (assoc switch (doom-cli-context-options context)) + (setf (map-elt (doom-cli-context-options context) switch) + nil))))) + ;; If this command uses &rest, stop processing commands from this + ;; point on and pass the rest (of the unprocessed arguments) to it. + (when (and (doom-cli-fn rcli) + (alist-get '&rest (doom-cli-arguments rcli))) + (setq rest? t)) + t)) + + ((push arg arguments) + (doom-log "context-parse: found arg %S" arg))))) + + (setf (alist-get t (doom-cli-context-arguments context)) + (append (alist-get t (doom-cli-context-arguments context)) + (nreverse arguments))) + (run-hook-with-args 'doom-cli-create-context-functions context) + context)) + +(defun doom-cli-context-get (context key &optional null-value) + "Fetch KEY from CONTEXT's options or state. + +Context objects are essentially persistent storage, and may contain arbitrary +state tied to switches (\"--foo\" or \"-x\") or arbitrary symbols (state). + +If KEY is a string, fetch KEY from context's OPTIONS (by switch). +If KEY is a symbol, fetch KEY from context's STATE. +Return NULL-VALUE if KEY does not exist." + (if-let (value + (if (stringp key) + (assoc key (doom-cli-context-options context)) + (assq key (doom-cli-context-state context)))) + (cdr value) + null-value)) + +(defun doom-cli-context-put (context key val) + "Set KEY in CONTEXT's options or state to VAL. + +Context objects contain persistent storage, and may contain arbitrary state tied +to switches (\"--foo\" or \"-x\") or arbitrary symbols (state). Use this to +register data into CONTEXT. + +If KEY is a string, set the value of a switch named KEY to VAL. +If KEY is a symbol, set the value of the context's STATE to VAL." + (setf (alist-get + key (if (stringp key) + (doom-cli-context-options context) + (doom-cli-context-state context)) + nil nil #'equal) + val)) + +(defun doom-cli-context-find-option (context switch) + "Return a `doom-cli-option' belonging to SWITCH in CONTEXT, if available. + +Returns nil if SWITCH isn't a valid option in CONTEXT or none of the associated +`doom-cli's have a `doom-cli-option' associated with SWITCH." + (when (assoc switch (doom-cli-context-options context)) + (cl-loop with command = (doom-cli-context-command context) + for cli in (doom-cli-find command) + if (seq-find (lambda (opt) + (let ((switches (doom-cli-option-switches opt))) + (or (member switch switches) + (and (doom-cli-option-flag-p opt) + (string-prefix-p "--no-" switch))))) + (doom-cli-options cli)) + return it))) + +(defun doom-cli-context-width (context) + "Return the width (in character units) of CONTEXT's original terminal." + (or (car (doom-cli-context-geometry context)) + 80)) + +(defun doom-cli-context-height (context) + "Return the height (in character units) of CONTEXT's original terminal." + (or (cdr (doom-cli-context-geometry context)) + 40)) + +(defun doom-cli-context-pipe-p (context type &optional global?) + "Return non-nil if TYPE is an active pipe in the local CONTEXT. + +TYPE can be one of `:in' (receiving input on stdin) or `:out' (output is piped +to another process), or any of `local-in', `local-out', `global-in', or +`global-out'. + +If GLOBAL? is non-nil, if TYPE is `:in' or `:out', the global context (the pipes +active in the super-session, rather than the local Emacs instance) will be +considered as well." + (let ((pipes (doom-cli-context-pipes context))) + (and (if global? + (assq type pipes) + (member (cons type 'local) pipes)) + t))) + +(defun doom-cli-context-sid (context &optional nodate?) + "Return a unique session identifier for CONTEXT." + (if nodate? + (doom-cli-context-pid context) + (format (format-time-string + "%y%m%d%H%M%S.%%s" (doom-cli-context-init-time context)) + (doom-cli-context-pid context)))) + + +;; +;;; Output management + +(defun doom-cli-debugger (type data &optional context) + "Print a more presentable backtrace to terminal and write it to file." + ;; HACK Works around a heuristic in eval.c for detecting errors in the + ;; debugger, which executes this handler again on subsequent calls. Taken + ;; from `ert--run-test-debugger'. + (cl-incf num-nonmacro-input-events) + (let* ((inhibit-read-only nil) + (inhibit-message nil) + (inhibit-redisplay nil) + (inhibit-trace t) + (executing-kbd-macro nil) + (load-read-function #'read) + (backtrace (doom-backtrace)) + (context (or context (make-doom-cli-context))) + (straight-error + (and (bound-and-true-p straight-process-buffer) + (or (member straight-process-buffer data) + (string-match-p (regexp-quote straight-process-buffer) + (error-message-string data))) + (with-current-buffer (straight--process-buffer) + (split-string (buffer-string) "\n" t)))) + (error-file (doom-cli--output-file 'error context))) + (cond + (straight-error + (print! (error "The package manager threw an error")) + (print! (error "Last %d lines of straight's error log:") + doom-cli-log-straight-error-lines) + (print-group! + (print! + "%s" (string-join + (seq-subseq straight-error + (max 0 (- (length straight-error) + doom-cli-log-straight-error-lines)) + (length straight-error)) + "\n"))) + (print! (warn "Wrote extended straight log to %s") + (path (let ((coding-system-for-write 'utf-8-auto)) + (with-file-modes #o600 + (with-temp-file error-file + (insert-buffer-substring (straight--process-buffer)))) + error-file)))) + ((eq type 'error) + (let* ((generic? (eq (car data) 'error)) + (doom-cli-log-backtrace-depth doom-cli-log-backtrace-depth) + (print-escape-newlines t)) + (if (doom-cli-context-p context) + (print! (error "There was an unexpected runtime error")) + (print! (bold (error "There was a fatal initialization error")))) + (print-group! + (print! "%s %s" (bold "Message:") + (if generic? + (error-message-string data) + (get (car data) 'error-message))) + (unless generic? + (print! "%s %s" (bold "Details:") + (let* ((print-level 4) + (print-circle t) + (print-escape-newlines t)) + (prin1-to-string (cdr data))))) + (when backtrace + (print! (bold "Backtrace:")) + (print-group! + (dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth)) + (print! "%s" (truncate (prin1-to-string + (cons (backtrace-frame-fun frame) + (backtrace-frame-args frame))) + (- (doom-cli-context-width context) + doom-print-indent + 1) + "...")))) + (when-let (backtrace-file (doom-backtrace-write-to-file backtrace error-file)) + (print! (warn "Wrote extended backtrace to %s") + (path backtrace-file)))))))) + (exit! 255))) + +(defmacro doom-cli-redirect-output (context &rest body) + "Redirect output from BODY to the appropriate log buffers in CONTEXT." + (declare (indent 1)) + (let ((contextsym (make-symbol "doomctxt"))) + `(let* ((,contextsym ,context) + ;; Emit more user-friendly backtraces + (debugger (doom-rpartial #'doom-cli-debugger ,contextsym)) + (debug-on-error t)) + (with-output-to! `((>= notice ,(doom-cli-context-stdout ,contextsym)) + (t . ,(doom-cli-context-stderr ,contextsym))) + ,@body)))) + +(defun doom-cli--output-file (type context) + "Return a log file path for TYPE and CONTEXT. + +See `doom-cli-log-file-format' for details." + (format doom-cli-log-file-format + (doom-cli-context-prefix context) + (doom-cli-context-sid context) + type)) + +(defun doom-cli--output-write-logs-h (context) + "Write all log buffers to their appropriate files." + (when (/= doom-cli--exit-code 254) + ;; Delete the last `doom-cli-log-retain' logs + (mapc #'delete-file + (let ((prefix (doom-cli-context-prefix context))) + (append (butlast (doom-glob (format doom-cli-log-file-format prefix "*" "log")) + doom-cli-log-retain) + (butlast (doom-glob (format doom-cli-log-file-format prefix "*" "error")) + doom-cli-log-retain)))) + ;; Then write the log file, if necessary + (let* ((buffer (doom-cli-context-stderr context)) + (file (doom-cli--output-file "log" context))) + (when (> (buffer-size buffer) 0) + (with-file-modes #o700 + (make-directory (file-name-directory file) t)) + (with-file-modes #o600 + (with-temp-file file + (insert-buffer-substring buffer) + (ansi-color-filter-region (point-min) (point-max)))))))) + +(defun doom-cli--output-benchmark-h (context) + "Write this session's benchmark to stdout or stderr, depending. + +Will also output it to stdout if requested (CLI sets :benchmark to t) or the +command takes >5s to run. If :benchmark is explicitly set to nil (or +`doom-cli-log-benchmark-threshold' is nil), under no condition should a +benchmark be shown." + (doom-cli-redirect-output context + (doom-log "%s (GCs: %d, elapsed: %.6fs)" + (if (= doom-cli--exit-code 254) "Restarted" "Finished") + gcs-done gc-elapsed) + (when-let* ((init-time (doom-cli-context-init-time context)) + (cli (doom-cli-get context)) + (duration (float-time (time-subtract (current-time) init-time))) + (hours (/ (truncate duration) 60 60)) + (minutes (- (/ (truncate duration) 60) (* hours 60))) + (seconds (- duration (* hours 60 60) (* minutes 60)))) + (when (and (/= doom-cli--exit-code 254) + (or (eq (doom-cli-prop cli :benchmark) t) + (eq doom-cli-log-benchmark-threshold 'always) + (and (eq (doom-cli-prop cli :benchmark :null) :null) + (not (doom-cli-context-pipe-p context 'out t)) + (> duration (or doom-cli-log-benchmark-threshold + most-positive-fixnum))))) + (print! (success "Finished in %s") + (join (list (unless (zerop hours) (format "%dh" hours)) + (unless (zerop minutes) (format "%dm" minutes)) + (format (if (> duration 60) "%ds" "%.5fs") + seconds)))))))) + + +;; +;;; Session management + +(defun doom-cli-call (args context &optional error) + "Process ARGS (list of string shell arguments) with CONTEXT as the basis. + +If ERROR is provided, store the error in CONTEXT, in case a later CLI wants to +read/use it (e.g. like a :help CLI)." + (let ((oldcommand (doom-cli-context-command context))) + (if oldcommand + (doom-log "call: %s -> %s" oldcommand args) + (doom-log "call: %s" oldcommand args)) + (when error + (setf (doom-cli-context-error context) error)) + (setf (doom-cli-context-command context) nil + (doom-cli-context-arguments context) nil + (doom-cli-context-meta-p context) nil) + (doom-cli-context-execute + (doom-cli-context-parse args (or context doom-cli--context))))) + +(defun doom-cli--restart (args context) + "Restart the current CLI session. + +If CONTEXT is non-nil, this is written to file and restored in the next Doom +session. + +This is done by writing a temporary shell script, which is executed after this +session ends (see the shebang lines of this file). It's done this way because +Emacs' batch library lacks an implementation of the exec system call." + (cl-check-type context doom-cli-context) + (when (= (doom-cli-context-step context) -1) + (error "__DOOMSTEP envvar missing; extended `exit!' functionality will not work")) + (let* ((pid (doom-cli-context-pid context)) + (step (doom-cli-context-step context)) + (context-file (format (doom-path temporary-file-directory "doom.%s.%s.context") pid step)) + (script-file (format (doom-path temporary-file-directory "doom.%s.%s.sh") pid step)) + (command (if (listp args) (combine-and-quote-strings (remq nil args)) args)) + (persistent-files + (combine-and-quote-strings (delq nil (list script-file context-file)))) + (persisted-env + (save-match-data + (cl-loop with initial-env = (get 'process-environment 'initial-value) + for env in (seq-difference process-environment initial-env) + if (string-match "^\\([a-zA-Z0-9_][^=]+\\)=\\(.+\\)$" env) + collect (format "%s=%s" + (match-string 1 env) + (shell-quote-argument (match-string 2 env))))))) + (cl-incf (doom-cli-context-step context)) + (with-file-modes #o600 + (doom-log "restart: writing context to %s" context-file) + (doom-file-write + context-file (let ((newcontext (copy-doom-cli-context context)) + (print-level nil) + (print-length nil) + (print-circle nil) + (print-escape-newlines t)) + ;; REVIEW: Use `print-unreadable-function' when 28 support + ;; is dropped. + (letf! (defmacro convert-buffer (fn) + `(setf (,fn newcontext) (with-current-buffer (,fn context) + (buffer-string)))) + (convert-buffer doom-cli-context-stdin) + (convert-buffer doom-cli-context-stdout) + (convert-buffer doom-cli-context-stderr)) + newcontext)) + (doom-log "restart: writing post-script to %s" script-file) + (doom-file-write + script-file `("#!/usr/bin/env sh\n" + "trap _doomcleanup EXIT\n" + "_doomcleanup() {\n rm -f " ,persistent-files "\n}\n" + "_doomrun() {\n " ,command "\n}\n" + ,(string-join persisted-env " \\\n") + ,(cl-loop for (envvar . val) + in `(("DOOMPROFILE" . ,(ignore-errors (doom-profile->id doom-profile))) + ("EMACSDIR" . ,doom-emacs-dir) + ("DOOMDIR" . ,doom-user-dir) + ("DEBUG" . ,(if init-file-debug "1")) + ("__DOOMSTEP" . ,(number-to-string (doom-cli-context-step context))) + ("__DOOMCONTEXT" . ,context-file)) + if val + concat (format "%s=%s \\\n" envvar (shell-quote-argument val))) + ,(format "PATH=\"%s%s$PATH\" \\\n" + (doom-path doom-emacs-dir "bin") + path-separator) + "_doomrun \"$@\"\n"))) + (doom-log "_doomrun: %s %s" (string-join persisted-env " ") command) + (doom-log "_doomcleanup: %s" persistent-files) + ;; Error code 254 is special: it indicates to the caller that the + ;; post-script should be executed after this session ends. It's up to + ;; `doom-cli-run's caller to enforce this (see bin/doom's shebang for a + ;; comprehensive example). + (doom-cli--exit 254 context))) + +(defun doom-cli--exit (args context) + "Accepts one of the following: + + (CONTEXT [ARGS...]) + TODO + (STRING [ARGS...]) + TODO + (:restart [ARGS...]) + TODO + (:pager [FILE...]) + TODO + (:pager? [FILE...]) + TODO + (INT) + TODO" + (let ((command (or (car-safe args) args)) + (args (if (car-safe args) (cdr-safe args)))) + (pcase command + ;; If an integer, treat it as an exit code. + ((pred (integerp)) + (setq doom-cli--exit-code command) + (kill-emacs command)) + + ;; Otherwise, run a command verbatim. + ((pred (stringp)) + (doom-cli--restart (format "%s %s" command (combine-and-quote-strings args)) + context)) + + ;; Same with buffers. + ((pred (bufferp)) + (doom-cli--restart (with-current-buffer command (buffer-string)) + context)) + + ;; If a context is given, restart the current session with the new context. + ((pred (doom-cli-context-p)) + (doom-cli--exit-restart args command)) + + ;; Run a custom action, defined in `doom-cli-exit-commands'. + ((pred (keywordp)) + (if-let (fn (alist-get command doom-cli-exit-commands)) + (funcall fn args context) + (error "Invalid exit command: %s" command))) + + ;; Any other value is invalid. + (_ (error "Invalid exit code or command: %s" command))))) + +(defun doom-cli--exit-restart (args context) + "Restart the session, verbatim (persisting CONTEXT). + +ARGS are addiitonal arguments to pass to the sub-process (in addition to the +ones passed to this one). It may contain :omit -- all arguments after this will +be removed from the argument list. They may specify number of arguments in the +format: + + --foo=4 omits --foo plus four following arguments + --foo=1 omits --foo plus one following argument + --foo= equivalent to --foo=1 + --foo=* omits --foo plus all following arguments + +Arguments don't have to be switches either." + (let ((pred (fn! (not (keywordp %)))) + (args (append (doom-cli-context-whole context) + (flatten-list args)))) + (let ((argv (seq-take-while pred args)) + (omit (mapcar (fn! (seq-let (arg n) (split-string % "=") + (cons + arg (cond ((not (stringp n)) 0) + ((string-empty-p n) 1) + ((equal n "*") -1) + ((string-to-number n)))))) + (seq-take-while pred (cdr (memq :omit args))))) + newargs) + (when omit + (while argv + (let ((arg (pop argv))) + (if-let (n (cdr (assoc arg omit))) + (if (= n -1) + (setq argv nil) + (dotimes (i n) (pop argv))) + (push arg newargs))))) + (doom-cli--exit (cons "$1" (or (nreverse newargs) argv)) + context)))) + +(defun doom-cli--exit-pager (args context) + "Invoke pager on output unconditionally. + +ARGS are options passed to less. If DOOMPAGER is set, ARGS are ignored." + (let ((pager (or doom-cli-pager (getenv "DOOMPAGER")))) + (cond ((null (or pager (executable-find "less"))) + (user-error "No pager set or available") + (doom-cli--exit 1 context)) + + ((or (doom-cli-context-pipe-p context :out t) + (equal pager "")) + (doom-cli--exit 0 context)) + + ((let ((tmpfile (doom-cli--output-file 'output context)) + (coding-system-for-write 'utf-8)) + (with-file-modes #o700 + (make-directory (file-name-directory tmpfile) t)) + (with-file-modes #o600 + (with-temp-file tmpfile + (insert-buffer-substring (doom-cli-context-stdout context)))) + (doom-cli--restart + (format "%s <%s; rm -f%s %s" + (or pager + (format "less %s" + (combine-and-quote-strings + (append (if doom-print-backend '("-r")) ; process ANSI codes + (or (delq nil args) '("+g")))))) + (shell-quote-argument tmpfile) + (if init-file-debug "v" "") + (shell-quote-argument tmpfile)) + context)))))) + +(defun doom-cli--exit-pager-maybe (args context) + "Invoke pager if stdout is longer than TTY height * `doom-cli-pager-ratio'. + +ARGS are options passed to less. If DOOMPAGER is set, ARGS are ignored." + (doom-cli--exit + (let ((threshold (ceiling (* (doom-cli-context-height context) + doom-cli-pager-ratio)))) + (if (>= (let ((stdout (doom-cli-context-stdout context))) + (if (fboundp 'buffer-line-statistics) + (car (buffer-line-statistics stdout)) + (with-current-buffer stdout + (count-lines (point-min) (point-max))))) + threshold) + (cons :pager args) + 0)) + context)) + +;; (defun doom-cli--exit-editor (args context)) ; TODO Launch $EDITOR + +;; (defun doom-cli--exit-emacs (args context)) ; TODO Launch Emacs subsession + + + +;; +;;; Migration paths + +;; (defvar doom-cli-context-restore-functions +;; '(doom-cli-context--restore-legacy-fn) +;; "A list of functions intended to unserialize `doom-cli-context'. + +;; They all take one argument, the raw data saved to $__DOOMCONTEXT. Each function +;; must return the version string corresponding to the version of Doom they have +;; transformed it for.") + +;; (defun doom-cli-context-restore (file context) +;; "Restore the last restarted context from FILE into CONTEXT." +;; (when (and (stringp file) +;; (file-exists-p file)) +;; (when-let* ((data (with-temp-buffer +;; (insert-file-contents file) +;; (read (current-buffer)))) +;; (version (if (stringp (car data)) (car data) "0")) +;; (old-context (if (string (car data)) (cdr data) data)) +;; (new-context (make-doom-cli-context)) +;; (struct-info (cl-loop for (slot _initval . plist) in (cdr (cl-struct-slot-info 'doom-cli-context)) +;; collect (cons (cl-struct-slot-offset 'doom-cli-context slot) +;; (cons slot plist))))) + +;; ;; (let ((version (if (stringp (car data)) (car data) "0")) +;; ;; (data (if (string (car data)) (cdr data) data)) +;; ;; (newcontext (make-doom-cli-context))) +;; ;; (dolist (fn doom-cli-context-restore-functions) +;; ;; (setq newcontext (funcall fn newcontext data version)))) + +;; (unless (doom-cli-context-p old-context) +;; (error "An invalid context was restored from file: %s" file)) +;; (unless (equal (doom-cli-context-prefix context) +;; (doom-cli-context-prefix old-context)) +;; (error "Restored context belongs to another script: %s" +;; (doom-cli-context-prefix old-context))) +;; (pcase-dolist (`(,slot ,_ . ,plist) +;; (cdr (cl-struct-slot-info 'doom-cli-context))) +;; (unless (plist-get plist :skip) +;; (let* ((idx (cl-struct-slot-offset 'doom-cli-context slot)) +;; (old-value (aref old-context idx))) +;; (aset context idx +;; (pcase (plist-get plist :type) +;; (`alist +;; (dolist (entry old-value (aref context idx)) +;; (setf (alist-get (car entry) (aref context idx)) (cdr entry)))) +;; (`buffer +;; (with-current-buffer (aref context idx) +;; (insert old-value) +;; (current-buffer))) +;; (_ old-value)))))) +;; (run-hook-with-args 'doom-cli-create-context-functions context) +;; (delete-file file) +;; (doom-log "Restored context: %s" (doom-cli-context-pid context)) +;; context))) + +;; (defun doom-cli-context--restore-legacy-fn (data old-version) +;; "Update `doom-cli-context' from <3.0.0 to 3.0.0." +;; (when (or (equal old-version "3.0.0-dev") +;; (string-match-p "^2\\.0\\." old-version)) + +;; "3.0.0")) + +;; (defun doom-cli-context--restore-3.1.0-fn (data old-version)) + + +;; +;;; Misc + +(defun doom-cli-load (cli) + "If CLI is autoloaded, load it, otherwise return it unchanged." + (or (when-let* ((path (doom-cli-autoload cli)) + (path (locate-file-internal path doom-cli-load-path load-suffixes))) + (doom-log "load: autoload %s" path) + (let ((doom-cli--group-plist (doom-cli-plist cli))) + (doom-load path)) + (let* ((key (doom-cli-key cli)) + (cli (gethash key doom-cli--table))) + (when (doom-cli-autoload cli) + (signal 'doom-cli-autoload-error (list (doom-cli-command cli) path))) + cli)) + cli)) + +(defun doom-cli-load-all () + "Immediately load all autoloaded CLIs." + (dolist (key (hash-table-keys doom-cli--table)) + (doom-cli-load (gethash key doom-cli--table)))) + + +;; +;;; DSL + +(defmacro defcli! (commandspec arglist &rest body) + "Defines a CLI command. + +COMMANDSPEC is the specification for the command that will trigger this CLI. It +can either be a symbol or list of symbols (or nested symbols). Nested lists are +treated as a list of aliases for the command. For example: + + (defcli! doom () ...) ; invoked on 'doom' + (defcli! (doom foo) () ...) ; invoked on 'doom foo' + (defcli! (doom (foo bar)) () ...) ; invoked on 'doom foo' or 'doom bar' + +COMMANDSPEC may be prefixed with any of these special keywords: + + :root ... + This command will ignore any :prefix set by a parent `defcli-group!'. + :before ... + This command will run before the specified command(s). + :after ... + This command will run after the specified command(s). + :version + A special handler, executed when 'X --version' is called. Define your own, + if you don't want it spewing Doom's version information. + :help COMMAND... + A special handler, executed when help documentation is requested for a + command. E.g. 'doom help foo' or 'doom foo --help' will call (:help foo). + You can define your own global :help handler, or one for a specific command. + :dump COMMAND... + A special handler, executed when the __DOOMDUMP environment variable is set. + You can define one for a specific COMMAND, or omit it to redefine the + catch-all :dump handler. + + The default implementation (living in lisp/doom-cli.el) will either: + + a) Dump to stdout a list of `doom-cli' structs for the commands and pseudo + commands that would've been executed had __DOOMDUMP not been set. + b) Or, given only \"-\" as an argument, dump all of `doom-cli--table' to + stdout. This table contains all known `doom-cli's (after loading + autoloaded ones). + +To interpolate values into COMMANDSPEC (e.g. to dynamically generate commands), +use the comma operator: + + (let ((somevar 'bfg)) + (defcli! (doom ,somevar) ...)) + +DOCSTRING is a string description; its first line should be a short summary +(under 60 characters) of what the command does. It will be used in the cramped +command listings served by help commands. The rest of DOCSTRING lines should be +no longer than 80 columns, and should go into greater detail. This documentation +may use `quoting' to appropriately highlight ARGUMENTS, --options, or $ENVVARS. + +DOCSTRING may also contain sections denoted by a capitalized header ending with +a colon and newline, and its contents indented by 2 spaces. These will be +appended to the end of the help documentation for that command. These three +sections are special: + + ARGUMENTS: + Use this to specify longer-form documentation for arguments. They are + prepended to the documentation for commands. If pseudo CLIs specify their + own ARGUMENTS sections, they are joined with that of the root command's CLI + as well. E.g. ':before doom sync's ARGUMENTS will be prepended to 'doom + sync's. + OPTIONS: + Use this to specify longer-form documentation for options. They are appended + to the auto-generated section of the same name. Only the option needs to be + specified for its lookup behavior to work. See bin/doom's `doom' command as + an example. + EXAMPLES: + To list example uses of the containing script. These are appended to + SYNOPSIS in generated manpages, but treated as a normal section otherwise + (i.e. appended to 'doom help's output). + +DOCSTRING may use any of these format specifications: + + %p The running script's prefix. E.g. for 'doom ci deploy-hooks' the + prefix is 'doom'. + %c The parent command minus the prefix. E.g. for 'doom ci deploy-hooks', + the command is 'ci deploy-hooks'. + +ARGLIST is a specification for options and arguments that is accepted by this +command. Arguments are represented by either a symbol or a cons cell where +(SYMBOL . DOCUMENTATION), and option specifications are lists in the following +formats: + + ([TYPE] VAR (FLAGSPEC... [ARGSPEC...]) [DESCRIPTION]) + + TYPE + Optional. One of &flag or &multi (which correspond to &flags and &multiple, + respectively, and are used for specifying a type inline, if desired). + VAR + Is the symbol to bind that option's value to. + FLAGSPEC + A list of switches or sub-lists thereof. Each switch is a string, e.g. + \"--foo\" \"-b\" \"--baz\". + + Nested lists will be treated as logical groups of switches in documentation. + E.g. for + + With (\"--foo\" \"--bar\" [ARGSPEC...]) you get: + + --foo, --bar + [Documentation] + + With ((\"--foo\") (\"--bar\") [ARGSPEC...]) you get: + + --foo + --bar + [Documentation] + + Use this to logically group options that have many, but semantically + distinct switches. + ARGSPEC + A list of arguments or sub-lists thereof. Each argument is either a string + or symbol. + + If a string, they are used verbatim as the argument's documentation. Use + this to document more complex specifications, like \"[user@]host[:port]\". + Use reference `quotes' to highlight arguments appropriately. No input + validation is performed on these arguments. + + If a symbol, this is equivalent to (upcase (format \"`%s'\" SYMBOL)), but + its arguments will also be implicitly validated against + `doom-cli-option-arg-types'. + + A nested list indicates that an argument accepts multiple types, and are + implicitly joined into \"`ARG1'|`ARG2'|...\". Input validation is performed + on symbols only. + + WARNING: If this option is a &flag, the option must not accept arguments. + Instead, use ARGSPEC to specify a single, default value (one of `:yes' or + `:no'). + DESCRIPTION + A one-line description of the option. Use reference `quotes' to + appropriately highlight arguments, options, and envvars. A syntax exists for + adding long-form option documentation from the CLI's docstring. See + DOCSTRING above. + +ARGLIST may be segmented with the following auxiliary keywords: + + &args ARG + The rest of the literal arguments are stored in ARG. + &cli ARG + The called `doom-cli' struct is bound to ARG. + &context ARG + The active `doom-cli-context' struct is bound to ARG. + &flags OPTION... + An option '--foo' declared after &flags will implicitly include a + '--no-foo', and will appear as \"--[no-]foo\" in 'doom help' docs. + &multiple OPTION... + Options specified after &multiple may be passed to the command multiple + times. Its symbol will be bound to a list of cons cells containing (FLAG . + VALUE). + &optional ARG... + Indicates that the (literal) arguments after it are optional. + &input ARG + ARG will be bound to the input piped in from stdin, as a string, or nil if + unavailable. If you want access to the original buffer, use + (doom-cli-context-stdin context) instead. + &rest ARG + All switches and arguments, unprocessed, after this command. If given, any + unrecognized switches will not throw an error. This will also prevent + subcommands beneath this command from being recognized. Use with care! + + Any non-option arguments before &optional, &rest, or &args are required. + +BODY is a list of arbitrary elisp forms that will be executed when this command +is called. BODY may begin with a plist to set metadata about it. The recognized +properties: + + :alias (CMD...) + Designates this command is an alias to CMD, which is a command specification + identical to COMMANDSPEC. + :benchmark BOOL + If non-nil, display a benchmark after the command finishes. + :disable BOOL + If non-nil, the command will not be defined. + :docs STRING + An alternative to DOCSTRING for defining documentation for this command. + :group (STR...) + A breadcrumb of group names to file this command under. They will be + organized by category in the CLI documentation (available through SCRIPT + {--help,-?,help}). + :hide BOOL + If non-nil, don't display this command in the help menu or in {ba,z}sh + completion (though it will still be callable). + :partial BOOL + If non-nil, this command is treated as partial, an intermediary command + intended as a stepping stone toward a non-partial command. E.g. were you to + define (doom foo bar), two \"partial\" commands are implicitly created: + \"doom\" and \"doom foo\". When called directly, partials will list its + subcommands and complain that a subcommand is rqeuired, rather than display + an 'unknown command' error. + :prefix (STR...) + A command path to prepend to the command name. This is more useful as part + of `defcli-group!'s inheritance. + +The BODY of commands with a non-nil :alias, :disable, or :partial will be +ignored. + +\(fn COMMANDSPEC ARGLIST [DOCSTRING] &rest BODY...)" + (declare (indent 2) (doc-string 3)) + (let ((docstring (if (stringp (car body)) (pop body))) + (plist (cl-loop for (key val) on body by #'cddr + while (keywordp key) + collect (pop body) + collect (pop body))) + options arguments bindings) + (let ((type '&required)) + (dolist (arg arglist) + (cond ((listp arg) + (let* ((inline-type (cdr (assq (car arg) doom-cli-option-types))) + (type (or inline-type type)) + (args (if inline-type (cdr arg) arg))) + (push (apply (or (alist-get type doom-cli-option-generators) + (signal 'doom-cli-definition-error + (cons "Invalid option type" type))) + args) + options) + (push (car args) bindings))) + ((memq arg doom-cli-argument-types) + (setq type arg)) + ((string-prefix-p "&" (symbol-name arg)) + (signal 'doom-cli-definition-error (cons "Invalid argument specifier" arg))) + ((push arg bindings) + (push arg (alist-get type arguments)))))) + (dolist (arg arguments) + (setcdr arg (nreverse (cdr arg)))) + `(let (;; Define function early to prevent overcapturing + (fn ,(let ((clisym (make-symbol "cli")) + (alistsym (make-symbol "alist"))) + `(lambda (,clisym ,alistsym) + (let ,(cl-loop for arg in (nreverse bindings) + unless (string-prefix-p "_" (symbol-name arg)) + collect `(,arg (cdr (assq ',arg ,alistsym)))) + ,@body))))) + ;; `cl-destructuring-bind's will validate keywords, so I don't have to + (cl-destructuring-bind + (&whole plist &key + alias autoload _benchmark docs disable hide _group partial + _prefix) + (append (list ,@plist) doom-cli--group-plist) + (unless disable + (let* ((command (doom-cli-command-normalize (backquote ,commandspec) plist)) + (type (if (keywordp (car command)) (pop command))) + (commands (doom-cli--command-expand command t)) + (target (pop commands))) + (dolist (prop '(:autoload :alias :partial :hide)) + (cl-remf plist prop)) + (puthash (delq nil (cons type target)) + (make-doom-cli + :command target + :type type + :docs (doom-cli--parse-docs (or ',docstring docs)) + :arguments ',arguments + :options ',(nreverse options) + :autoload autoload + :alias (if alias (doom-cli-command-normalize alias plist)) + :plist (append plist (list :hide (and (or hide type) t))) + :fn (unless (or partial autoload) fn)) + doom-cli--table) + (let ((docs (doom-cli--parse-docs docs))) + (dolist (alias (cl-loop for c in commands + while (= (length c) (length target)) + collect (pop commands))) + (puthash (delq nil (cons type alias)) + (make-doom-cli + :command alias + :type type + :docs docs + :autoload autoload + :alias (unless autoload (delq nil (cons type target))) + :plist (append plist '(:hide t))) + doom-cli--table)) + (dolist (partial commands) + (let ((cli (gethash partial doom-cli--table))) + (when (or (null cli) (doom-cli-autoload cli)) + (puthash (delq nil (cons type partial)) + (make-doom-cli + :command partial + :type type + :docs docs + :plist (list :group (plist-get plist :group))) + doom-cli--table))))) + target)))))) + +(defmacro defcli-alias! (commandspec target &rest plist) + "Define a CLI alias for TARGET at COMMANDSPEC. + +See `defcli!' for information about COMMANDSPEC. +TARGET is not a command specification, and should be a command list." + `(defcli! ,commandspec () :alias ',target ,@plist)) + +(defmacro defcli-obsolete! (commandspec target when) + "Define an obsolete CLI COMMANDSPEC that refers users to NEW-COMMAND. + +See `defcli!' for information about COMMANDSPEC. +TARGET is simply a command list. +WHEN specifies what version this command was rendered obsolete." + `(let ((ncommand (doom-cli-command-normalize (backquote ,target) doom-cli--group-plist))) + (defcli! ,commandspec (&context _context &cli cli &rest args) + :docs (format "An obsolete alias for '%s'." (doom-cli-command-string ncommand)) + :hide t + (print! (warn "'%s' was deprecated in %s") + (doom-cli-command-string cli) + ,when) + (print! (warn "It will eventually be removed; use '%s' instead.") + (doom-cli-command-string ncommand)) + (call! ',target args)))) + +(defmacro defcli-stub! (commandspec &optional _argspec &rest body) + "Define a stub CLI, which will throw an error if invoked. + +Use this to define commands that will eventually be implemented, but haven't +yet. They won't be included in command listings (by help documentation)." + (declare (indent 2) (doc-string 3)) + `(defcli! ,commandspec (&rest _) + ,(concat "THIS COMMAND IS A STUB AND HAS NOT BEEN IMPLEMENTED YET." + (if (stringp (car body)) (concat "\n\n" (pop body)))) + :hide t + (user-error "Command not implemented yet"))) + +(defmacro defcli-autoload! (commandspec &optional path &rest plist) + "Defer loading of PATHS until PREFIX is called." + `(let* ((doom-cli--group-plist (append (list ,@plist) doom-cli--group-plist)) + (commandspec (doom-cli-command-normalize ',commandspec)) + (commands (doom-cli--command-expand commandspec)) + (path (or ,path + (when-let* ((cmd (car commands)) + (last (car (last cmd))) + (last (if (listp last) (car last) last))) + (format "%s" last)) + (error "Failed to deduce autoload path for: %s" spec))) + (cli (doom-cli-get (car commands) nil t))) + (when (or (null cli) + (doom-cli-autoload cli)) + (defcli! ,commandspec () :autoload path)))) + +(defmacro defcli-group! (&rest body) + "Declare common properties for any CLI commands defined in BODY." + (when (stringp (car body)) + (push :group body)) + `(let ((doom-cli--group-plist (copy-sequence doom-cli--group-plist))) + ,@(let (forms) + (while (keywordp (car body)) + (let ((key (pop body)) + (val (pop body))) + (push `(cl-callf plist-put doom-cli--group-plist + ,key ,(if (eq key :prefix) + `(append (plist-get doom-cli--group-plist ,key) + (ensure-list ,val)) + val)) + forms))) + (nreverse forms)) + ,@body)) + +(defun exit! (&rest args) + "Exits the current CLI session. + +With ARGS, you may specify a shell command or action (see +`doom-cli-exit-commands') to execute after this Emacs process has ended. For +example: + + (exit! \"$@\") or (exit! :restart) + This reruns the current command with the same arguments. + (exit! \"$@ -h -c\") + This reruns the current command with two new switches. + (exit! :restart \"-c\" :omit \"--foo=2\" \"--bar\") + This reruns the current command with one new switch (-c) and two switches + removed (--foo plus two arguments and --bar). + (exit! \"emacs -nw FILE\") + Opens Emacs on FILE + (exit! \"emacs\" \"-nw\" \"FILE\") + Opens Emacs on FILE, but each argument is escaped (and nils are ignored). + (exit! t) or (exit! nil) + A safe way to simply abort back to the shell with exit code 0 + (exit! 42) + Abort to shell with an explicit exit code. + (exit! context) + Restarts the current session, but with context (a `doom-cli-context' struct). + (exit! :pager [FILES...]) + Invoke $DOOMPAGER (or less) on the output of this session. If ARGS are given, launch the pager on those + (exit! :pager? [FILES...]) + Same as :pager, but does so only if output is longer than the terminal is + tall. + +See `doom-cli--restart' for implementation details." + (throw 'exit (flatten-list args))) + +(defun call! (&rest command) + "A convenience wrapper around `doom-cli-call'. + +Implicitly resolves COMMAND relative to the running CLI, and uses the active +context (so you don't have to pass a context)." + (doom-cli-call (doom-cli-command-normalize + (flatten-list command) + `(:prefix + ,(doom-cli-context-prefix doom-cli--context) + ,@(doom-cli-context-command doom-cli--context))) + doom-cli--context)) + +(defun run! (prefix &rest args) + "Parse and execute ARGS. + +This is the entry point for any shell script that rely on Doom's CLI framework. +It should be called once, at top-level, and never again (use `doom-cli-call' for +nested calls instead). + +PREFIX is the name (string) of the top-level shell script (i.e. $0). All +commands that belong to this shell session should use PREFIX as the first +segment in their command paths. + +ARGS is a list of string arguments to execute. + +See bin/doom's shebang for an example of what state needs to be initialized for +Doom's CLI framework. In a nutshell, Doom is expecting the following environment +variables to be set: + + __DOOMGEOM The dimensions of the current terminal (W . H) + __DOOMPIPE Must contain 0 if script is being piped into, 1 if piping it out + __DOOMGPIPE Like __DOOMPIPE, but is the pipe state of the super process + __DOOMPID A unique ID for this session and its exit script processes + __DOOMSTEP How many layers deep this session has gotten + +The script should also execute ${temporary-file-directory}/doom.sh if Emacs +exits with code 254. This script is auto-generated as needed, to simulate exec +syscalls. See `doom-cli--restart' for technical details. + +Once done, this function kills Emacs gracefully and writes output to log files +(stdout to `doom-cli--output-file', stderr to `doom-cli-debug-file', and any +errors to `doom-cli-error-file')." + (when doom-cli--context + (error "Cannot nest `run!' calls")) + (doom-run-hooks 'doom-after-init-hook) + (doom-context-with 'cli + (doom-modules-initialize) + (let* ((args (flatten-list args)) + (context (make-doom-cli-context :prefix prefix :whole args)) + (doom-cli--context context) + (write-logs-fn (doom-partial #'doom-cli--output-write-logs-h context)) + (show-benchmark-fn (doom-partial #'doom-cli--output-benchmark-h context))) + ;; Clone output to stdout/stderr buffers for logging. + (doom-cli-redirect-output context + (doom-log "run!: %s %s" prefix (combine-and-quote-strings args)) + (add-hook 'kill-emacs-hook show-benchmark-fn 94) + (add-hook 'kill-emacs-hook write-logs-fn 95) + (when (doom-cli-context-pipe-p context :out t) + (setq doom-print-backend nil)) + (when (doom-cli-context-pipe-p context :in) + (with-current-buffer (doom-cli-context-stdin context) + (while (if-let (in (ignore-errors (read-from-minibuffer ""))) + (insert in "\n") + (ignore-errors (delete-char -1)))))) + (doom-cli--exit + (catch 'exit + (condition-case e + (let* ((args (cons (if (getenv "__DOOMDUMP") :dump prefix) args)) + (context (doom-cli-context-restore (getenv "__DOOMCONTEXT") context)) + (context (doom-cli-context-parse args context))) + (run-hook-with-args 'doom-cli-before-run-functions context) + (let ((result (doom-cli-context-execute context))) + (run-hook-with-args 'doom-cli-after-run-functions context result)) + 0) + (doom-cli-wrong-number-of-arguments-error + (pcase-let ((`(,command ,flag ,args ,min ,max) (cdr e))) + (print! (red "Error: %S expected %s argument%s, but got %d") + (or flag (doom-cli-command-string + (if (keywordp (car command)) + command + (cdr command)))) + (if (or (= min max) + (= max most-positive-fixnum)) + min + (format "%d-%d" min max)) + (if (or (= min 0) (> min 1)) "s" "") + (length args)) + (doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e)) + 5) + (doom-cli-unrecognized-option-error + (print! (red "Error: unknown option %s") (cadr e)) + (doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e) + 5) + (doom-cli-invalid-option-error + (pcase-let ((`(,types ,option ,value ,errors) (cdr e))) + (print! (red "Error: %s received invalid value %S") + (string-join (doom-cli-option-switches option) "/") + value) + (print! (bold "\nValidation errors:")) + (dolist (err errors) (print! (item "%s." (fill err))))) + (doom-cli-call `(:help "--postamble" ,@(cdr (doom-cli--command context))) context e) + 5) + (doom-cli-command-not-found-error + (let* ((command (cdr e)) + (cli (doom-cli-get command))) + (cond ((null cli) + (print! (red "Error: unrecognized command '%s'") + (doom-cli-command-string (or (cdr command) command))) + (doom-cli-call `(:help "--similar" "--postamble" ,@(cdr command)) context e)) + ((null (doom-cli-fn cli)) + (print! (red "Error: a subcommand is required")) + (doom-cli-call `(:help "--subcommands" "--postamble" ,@(cdr command)) context e)))) + 4) + (doom-cli-invalid-prefix-error + (let ((prefix (cadr e))) + (print! (red "Error: `run!' called with invalid prefix %S") prefix) + (if-let (suggested (cl-loop for cli being the hash-value of doom-cli--table + unless (doom-cli-type cli) + return (car (doom-cli-command cli)))) + (print! "Did you mean %S?" suggested) + (print! "There are no commands defined under %S." prefix))) + 4) + (user-error + (print! (red "Error: %s") (cadr e)) + (print! "\nAborting...") + 3))) + context))))) + +(defalias 'sh! #'doom-call-process) + +(defalias 'sh!! #'doom-exec-process) + +;; TODO Make `git!' into a more sophisticated wrapper around git +(defalias 'git! (doom-partial #'straight--process-run "git")) + +(defun get! (key) (doom-cli-context-get doom-cli--context key)) + +(defun put! (key val) (doom-cli-context-put doom-cli--context key val)) + + +;; +;;; doom-cli-help +;; +;; This file defines special commands that the Doom CLI will invoke when a +;; command is passed with -?, --help, or --version. They can also be aliased to +;; a sub-command to make more of its capabilities accessible to users, with: +;; +;; (defcli-alias! (myscript (help h)) (:help)) +;; +;; You can define your own command-specific help handlers, e.g. +;; +;; (defcli! (:help myscript subcommand) () ...) +;; +;; And it will be invoked instead of the generic one. +;; +;;; Code: + +(defun doom-cli-help (cli) + "Return an alist of documentation summarizing CLI (a `doom-cli')." + (let* ((rcli (doom-cli-get cli)) + (docs (doom-cli-docs rcli))) + `((command . ,(doom-cli-command-string cli)) + (summary . ,(or (cdr (assoc "SUMMARY" docs)) "[TODO]")) + (description . ,(or (cdr (assoc "MAIN" docs)) "")) + (synopsis . ,(doom-cli-help--synopsis cli)) + (arguments . ,(doom-cli-help--arguments rcli)) + (options . ,(doom-cli-help--options rcli)) + (commands . ,(doom-cli-subcommands cli 1)) + (sections . ,(seq-filter #'cdr (cddr docs)))))) + +(defun doom-cli-help-similar-commands (command &optional maxscore) + "Return N commands that are similar to COMMAND." + (seq-take-while + (fn! (>= (car %) (or maxscore 0.0))) + (seq-sort-by + #'car #'> + (cl-loop with prefix = (seq-find #'doom-cli-get (nreverse (doom-cli--command-expand command t))) + with input = (doom-cli-command-string (cdr (doom-cli--command command t))) + for command in (hash-table-keys doom-cli--table) + if (doom-cli-fn (doom-cli-get command)) + if (equal prefix (seq-take command (length prefix))) + collect (cons (doom-cli-help--similarity + input (doom-cli-command-string (cdr command))) + command))))) + +(defun doom-cli-help--similarity (a b) + (- 1 (/ (float (doom-cli-help--string-distance a b)) + (max (length a) (length b))))) + +(defun doom-cli-help--string-distance (a b) + "Calculate the Restricted Damerau-Levenshtein distance between A and B. +This is also known as the Optimal String Alignment algorithm. + +It is assumed that A and B are both strings, and before processing both are +converted to lowercase. + +This returns the minimum number of edits required to transform A +to B, where each edit is a deletion, insertion, substitution, or +transposition of a character, with the restriction that no +substring is edited more than once." + (let ((a (downcase a)) + (b (downcase b)) + (alen (length a)) + (blen (length b)) + (start 0)) + (when (> alen blen) + (let ((c a) + (clen alen)) + (setq a b alen blen + b c blen clen))) + (while (and (< start (min alen blen)) + (= (aref a start) (aref b start))) + (cl-incf start)) + (cl-decf start) + (if (= (1+ start) alen) + (- blen start) + (let ((v0 (make-vector (- blen start) 0)) + (v1 (make-vector (- blen start) 0)) + (a_i (aref a (max 0 start))) + (current 0) + a_i-1 b_j b_j-1 + left transition-next + above this-transition) + (dotimes (vi (length v0)) + (aset v0 vi (1+ vi))) + (dolist (i (number-sequence (1+ start) (1- alen))) + (setq a_i-1 a_i + a_i (aref a i) + b_j (aref b (max 0 start)) + left (- i start 1) + current (- i start) + transition-next 0) + (dolist (j (number-sequence (1+ start) (1- blen))) + (setq b_j-1 b_j + b_j (aref b j) + above current + current left + this-transition transition-next + transition-next (aref v1 (- j start))) + (aset v1 (- j start) current) + (setq left (aref v0 (- j start))) + (unless (= a_i b_j) + ;; Minimum between substitution, deletion, and insertion + (setq current (min (1+ current) (1+ above) (1+ left))) + (when (and (> i (1+ start)) (> j (1+ start)) (= a_i b_j-1) (= a_i-1 b_j)) + (setq current (min current (cl-incf this-transition))))) + (aset v0 (- j start) current))) + current)))) + +;;; Help: printers +;; TODO Parameterize optional args with `cl-defun' +(defun doom-cli-help--print (cli context &optional manpage? noglobal?) + "Write CLI's documentation in a manpage-esque format to stdout." + (let-alist (doom-cli-help cli) + (let* ((alist + `(,@(if manpage? + `((nil . ,(let* ((title (cadr (member "--load" command-line-args))) + (width (floor (/ (- (doom-cli-context-width context) + (length title)) + 2.0)))) + ;; FIXME Who am I fooling? + (format (format "%%-%ds%%s%%%ds" width width) + "DOOM(1)" title "DOOM(1)"))) + ("NAME" . ,(concat .command " - " .summary)) + ("SYNOPSIS" . ,(doom-cli-help--render-synopsis .synopsis nil t)) + ("DESCRIPTION" . ,.description)) + `((nil . ,(doom-cli-help--render-synopsis .synopsis "Usage: ")) + (nil . ,(string-join (seq-remove #'string-empty-p (list .summary .description)) + "\n\n")))) + ("ARGUMENTS" . ,(doom-cli-help--render-arguments .arguments)) + ("COMMANDS" + . ,(doom-cli-help--render-commands + .commands :prefix (doom-cli-command cli) :grouped? t :docs? t)) + ("OPTIONS" + . ,(doom-cli-help--render-options + (if (or (not (doom-cli-fn cli)) noglobal?) + `(,(assq 'local .options)) + .options) + cli)))) + (command (doom-cli-command cli))) + (letf! (defun printsection (section) + (print! "%s\n" + (if (null section) + (dark "TODO") + (markup + (format-spec + section `((?p . ,(car command)) + (?c . ,(doom-cli-command-string (cdr command)))) + 'ignore))))) + (pcase-dolist (`(,label . ,contents) alist) + (when (and contents (not (string-blank-p contents))) + (when label + (print! (bold "%s%s") label (if manpage? "" ":"))) + (print-group! :if label (printsection contents)))) + (pcase-dolist (`(,label . ,contents) .sections) + (when (and contents (not (assoc label alist))) + (print! (bold "%s:") label) + (print-group! (printsection contents)))))))) + +;;; Help: synopsis +(defun doom-cli-help--synopsis (cli &optional all-options?) + (let* ((rcli (doom-cli-get cli)) + (opts (doom-cli-help--options rcli)) + (opts (mapcar #'car (if all-options? (mapcan #'cdr opts) (alist-get 'local opts)))) + (opts (cl-loop for opt in opts + for args = (cdar opt) + for switches = (mapcar #'car opt) + for multi? = (member "..." args) + if args + collect (format (if multi? "[%s %s]..." "[%s %s]") + (string-join switches "|") + (string-join (remove "..." args) "|")) + else collect (format "[%s]" (string-join switches "|")))) + (args (doom-cli-arguments rcli)) + (subcommands? (doom-cli-subcommands rcli 1 :predicate? t))) + `((command . ,(doom-cli-command cli)) + (options ,@opts) + (required ,@(mapcar (fn! (upcase (format "`%s'" %))) (if subcommands? '(command) (alist-get '&required args)))) + (optional ,@(mapcar (fn! (upcase (format "[`%s']" %)))(alist-get '&optional args))) + (rest ,@(mapcar (fn! (upcase (format "[`%s'...]" %))) (if subcommands? '(args) (alist-get '&args args))))))) + +(defun doom-cli-help--render-synopsis (synopsis &optional prefix) + (let-alist synopsis + (let ((doom-print-indent 0) + (prefix (or prefix "")) + (command (doom-cli-command-string .command))) + (string-trim-right + (format! "%s\n\n" + (fill (concat (bold prefix) + (format "%s " command) + (markup + (join (append .options + (and .options + (or .required + .optional + .rest) + (list (dark "[--]"))) + .required + .optional + .rest)))) + 80 (1+ (length (concat prefix command))))))))) + +;;; Help: arguments +(defun doom-cli-help--arguments (cli &optional all?) + (doom-cli-help--parse-docs (doom-cli-find cli t) "ARGUMENTS")) + +(defun doom-cli-help--render-arguments (arguments) + (mapconcat (lambda (arg) + (format! "%-20s\n%s" + (underscore (car arg)) + (indent (if (equal (cdr arg) "TODO") + (dark (cdr arg)) + (cdr arg)) + doom-print-indent-increment))) + arguments + "\n")) + +;;; Help: commands +(cl-defun doom-cli-help--render-commands (commands &key prefix grouped? docs? (inline? t)) + (with-temp-buffer + (let* ((doom-print-indent 0) + (commands (seq-group-by (fn! (if grouped? (doom-cli-prop (doom-cli-get % t) :group))) + (nreverse commands))) + (toplevel (assq nil commands)) + (rest (remove toplevel commands)) + (drop (if prefix (length prefix) 0)) + (minwidth + (apply + #'max (or (cl-loop for cmd in (apply #'append (mapcar #'cdr commands)) + for cmd = (seq-drop cmd drop) + collect (length (doom-cli-command-string cmd))) + (list 15)))) + (ellipsis (doom-print--style 'dark " […]")) + (ellipsislen (- (length ellipsis) (if (eq doom-print-backend 'ansi) 2 4)))) + (dolist (group (cons toplevel rest)) + (let ((label (if (car-safe group) (cdr commands)))) + (when label + (insert! ((bold "%s:") (car group)) "\n")) + (print-group! :if label + (dolist (command (cdr group)) + (let* ((cli (doom-cli-get command t)) + (rcli (doom-cli-get command)) + (summary (doom-cli-short-docs rcli)) + (subcommands? (doom-cli-subcommands cli 1 :predicate? t))) + (insert! ((format "%%-%ds%%s%%s" + (+ (- minwidth doom-print-indent) + doom-print-indent-increment + (if subcommands? ellipsislen 0))) + (concat (doom-cli-command-string (seq-drop command drop)) + (if subcommands? ellipsis)) + (if inline? " " "\n") + (indent (if (and (doom-cli-alias cli) + (not (doom-cli-type rcli))) + (dark "-> %s" (doom-cli-command-string cli)) + (when docs? + (if summary (markup summary) (dark "TODO")))))) + "\n"))) + (when (cdr rest) + (insert "\n"))))) + (string-trim-right (buffer-string))))) + +;;; Help: options +(defun doom-cli-help--options (cli &optional noformatting?) + "Return an alist summarizing CLI's options. + +The alist's CAR are lists of formatted switches plus their arguments, e.g. +'((\"`--foo'\" \"`BAR'\") ...). Their CDR is their formatted documentation." + (let* ((docs (doom-cli-help--parse-docs (doom-cli-find cli t) "OPTIONS")) + (docs (mapcar (fn! (cons (split-string (car %) ", ") + (cdr %))) + docs)) + (strfmt (if noformatting? "%s" "`%s'")) + local-options + global-options + seen) + (dolist (neighbor (nreverse (doom-cli-find cli))) + (dolist (option (doom-cli-options neighbor)) + (when-let* ((switches (cl-loop for sw in (doom-cli-option-switches option) + if (and (doom-cli-option-flag-p option) + (string-prefix-p "--" sw)) + collect (format "--[no-]%s" (substring sw 2)) + else collect sw)) + (switches (seq-difference switches seen))) + (dolist (switch switches) (push switch seen)) + (push (cons (cl-loop for switch in switches + if (doom-cli-option-arguments option) + collect (cons (format strfmt switch) + (append (doom-cli-help--parse-args it noformatting?) + (when (doom-cli-option-multiple-p option) + (list "...")))) + else collect (list (format strfmt switch))) + (string-join + (or (delq + nil (cons (when-let (docs (doom-cli-option-docs option)) + (concat docs ".")) + (cl-loop for (flags . docs) in docs + unless (equal (seq-difference flags switches) flags) + collect docs))) + '("TODO")) + "\n\n")) + (if (equal (doom-cli-command neighbor) + (doom-cli-command cli)) + local-options + global-options))))) + `((local . ,(nreverse local-options)) + (global . ,(nreverse global-options))))) + +(defun doom-cli-help--render-options (options &optional cli) + (let ((doom-print-indent 0) + (local (assq 'local options)) + (global (assq 'global options))) + (when (or (cdr local) (cdr global)) + (letf! (defun printopts (opts) + (pcase-dolist (`(,switches . ,docs) (cdr opts)) + (let (multiple?) + (insert! + ("%s%s\n%s" + (mapconcat + (fn! (when (member "..." (cdr %)) + (setq multiple? t)) + (string-trim-right + (format "%s %s" + (doom-print--cli-markup (car %)) + (doom-print--cli-markup + (string-join (remove "..." (cdr %)) "|"))))) + switches + ", ") + (if multiple? ", ..." "") + (indent (fill (markup docs)) doom-print-indent-increment)) + "\n\n")))) + (with-temp-buffer + (if (null (cdr local)) + (insert (if global "This command has no local options.\n" "") "\n") + (printopts local)) + (when (cdr global) + (insert! ((bold "Global options:\n"))) + (print-group! (printopts global))) + (string-trim-right (buffer-string))))))) + +;;; Help: internal +(defun doom-cli-help--parse-args (args &optional noformatting?) + (cl-loop for arg in args + if (listp arg) + collect (string-join (doom-cli-help--parse-args arg noformatting?) "|") + else if (symbolp arg) + collect (format (if noformatting? "%s" "`%s'") (upcase (symbol-name arg))) + else collect arg)) + +(defun doom-cli-help--parse-docs (cli-list section-name) + (cl-check-type section-name string) + (let (alist) + (dolist (cli cli-list (nreverse alist)) + (when-let (section (cdr (assoc section-name (doom-cli-docs cli)))) + (with-temp-buffer + (save-excursion (insert section)) + (let ((lead (current-indentation)) + (buffer (current-buffer))) + (while (not (eobp)) + (let ((heading (string-trim (buffer-substring (point-at-bol) (point-at-eol)))) + (beg (point-at-bol 2)) + end) + (forward-line 1) + (while (and (not (eobp)) + (/= (current-indentation) lead) + (forward-line 1))) + (setf (alist-get heading alist nil nil #'equal) + (string-join + (delq + nil (list (alist-get heading alist nil nil #'equal) + (let ((end (point))) + (with-temp-buffer + (insert-buffer-substring buffer beg end) + (goto-char (point-min)) + (indent-rigidly (point-min) (point-max) (- (current-indentation))) + (string-trim-right (buffer-string)))))) + "\n\n")))))))))) + +(provide 'doom-cli-lib) +;;; doom-cli-lib.el ends here. diff --git a/lisp/doom-cli.el b/lisp/doom-cli.el index c9f54dd56..54ddf4baa 100644 --- a/lisp/doom-cli.el +++ b/lisp/doom-cli.el @@ -7,2003 +7,206 @@ ;; ;;; Code: -(when noninteractive - ;; PERF: Deferring the GC in non-interactive sessions isn't as important, but - ;; still yields a notable benefit. Still, avoid setting it to high here, as - ;; runaway memory usage is a real risk in longer sessions. - (setq gc-cons-threshold 134217728 ; 128mb - ;; Backported from 29 (see emacs-mirror/emacs@73a384a98698) - gc-cons-percentage 1.0) +(unless noninteractive + (error "Don't load doom-cli in an interactive session!")) - ;; REVIEW: Remove these later. The endpoints should be responsibile for - ;; ensuring they exist. For now, they exist to quell file errors. - (mapc (doom-rpartial #'make-directory 'parents) - (list doom-local-dir - doom-data-dir - doom-cache-dir - doom-state-dir)) +;; PERF: Deferring the GC in non-interactive sessions isn't as important, but +;; still yields a notable benefit. Still, avoid setting it to high here, as +;; runaway memory usage is a real risk in longer sessions. +(setq gc-cons-threshold 134217728 ; 128mb + ;; Backported from 29 (see emacs-mirror/emacs@73a384a98698) + gc-cons-percentage 1.0) - ;; HACK: bin/doom suppresses loading of site files so they can be loaded - ;; manually, here. Why? To suppress the otherwise unavoidable output they - ;; commonly produce (like deprecation notices, file-loaded messages, and - ;; linter warnings). This output pollutes the output of doom's CLI (or - ;; scripts derived from it) with potentially confusing or alarming -- but - ;; always unimportant -- information to the user. - (quiet! - (require 'cl nil t) ; "Package cl is deprecated" - (unless site-run-file ; unset in doom.el - (when-let ((site-run-file (get 'site-run-file 'initial-value))) - (load site-run-file t inhibit-message)))) +;; REVIEW: Remove these later. The endpoints should be responsibile for +;; ensuring they exist. For now, they exist to quell file errors. +(mapc (doom-rpartial #'make-directory 'parents) + (list doom-local-dir + doom-data-dir + doom-cache-dir + doom-state-dir)) - (setq-default - ;; PERF: Don't generate superfluous files when writing temp buffers. - make-backup-files nil - ;; COMPAT: Stop user configuration from interfering with package management. - enable-dir-local-variables nil - ;; PERF: Reduce ambiguity, embrace specificity, enjoy predictability. - case-fold-search nil - ;; UX: Don't clog the user's trash with our CLI refuse. - delete-by-moving-to-trash nil) +;; HACK: bin/doom suppresses loading of site files so they can be loaded +;; manually, here. Why? To suppress the otherwise unavoidable output they +;; commonly produce (like deprecation notices, file-loaded messages, and +;; linter warnings). This output pollutes the output of doom's CLI (or +;; scripts derived from it) with potentially confusing or alarming -- but +;; always unimportant -- information to the user. +(quiet! + (require 'cl nil t) ; "Package cl is deprecated" + (unless site-run-file ; unset in doom.el + (when-let ((site-run-file (get 'site-run-file 'initial-value))) + (load site-run-file t inhibit-message)))) - ;; Load just the... bear necessities~ - (require 'seq) - (require 'map) +(setq-default + ;; PERF: Don't generate superfluous files when writing temp buffers. + make-backup-files nil + ;; COMPAT: Stop user configuration from interfering with package management. + enable-dir-local-variables nil + ;; PERF: Reduce ambiguity, embrace specificity, enjoy predictability. + case-fold-search nil + ;; UX: Don't clog the user's trash with our CLI refuse. + delete-by-moving-to-trash nil) - ;; Suppress any possible coding system prompts during CLI sessions. - (set-language-environment "UTF-8") +;; Load just the... bear necessities~ +(require 'seq) +(require 'map) - ;; Load and set up our debugger first, so backtraces can be made more - ;; presentable and logged to file. - (doom-require 'doom-lib 'debug) - (if init-file-debug (doom-debug-mode +1)) +;; Suppress any possible coding system prompts during CLI sessions. +(set-language-environment "UTF-8") - ;; Then load the rest of Doom's libs eagerly, since autoloads may not be - ;; generated/loaded yet. - (doom-require 'doom-lib 'process) - (doom-require 'doom-lib 'system) - (doom-require 'doom-lib 'git) - (doom-require 'doom-lib 'plist) - (doom-require 'doom-lib 'files) - (doom-require 'doom-lib 'print) - (doom-require 'doom-lib 'autoloads) +;; Load and set up our debugger first, so backtraces can be made more +;; presentable and logged to file. +(doom-require 'doom-lib 'debug) +(if init-file-debug (doom-debug-mode +1)) - ;; Ensure straight and core packages are ready to go for CLI commands. - (require 'doom-modules) - (require 'doom-packages) - (require 'doom-profiles) - ;; Last minute initialization at the end of loading this file. - (with-eval-after-load 'doom-cli - (doom-run-hooks 'doom-before-init-hook))) +;; Then load the rest of Doom's libs eagerly, since autoloads may not be +;; generated/loaded yet. +(doom-require 'doom-lib 'process) +(doom-require 'doom-lib 'system) +(doom-require 'doom-lib 'git) +(doom-require 'doom-lib 'plist) +(doom-require 'doom-lib 'files) +(doom-require 'doom-lib 'print) +(doom-require 'doom-lib 'autoloads) + +;; Ensure straight and core packages are ready to go for CLI commands. +(require 'doom-cli-lib) +;; Last minute initialization at the end of loading this file. +(with-eval-after-load 'doom-cli + (doom-run-hooks 'doom-before-init-hook)) ;; -;;; Variables - -(defgroup doom-cli nil - "Doom's command-line interface framework." - :link '(url-link "https://doomemacs.org/cli") - :group 'doom) - -(defvar doom-cli-load-path - (append (when-let ((doompath (getenv "DOOMPATH"))) - (cl-loop for dir in (split-string doompath path-separator) - collect (expand-file-name dir))) - (list (file-name-concat (dir!) "cli"))) - "A list of paths to search for autoloaded Doom CLIs. - -It is prefilled by the DOOMPATH envvar (a colon-separated list on Linux/macOS, -semicolon otherwise).") - -;;; CLI definition variables -(defvar doom-cli-argument-types - '(&args - &cli - &context - &flags - &multiple - &optional - &rest - &required - &input - &whole) - "A list of auxiliary keywords allowed in `defcli!'s arglist. - -See `defcli!' for documentation on them.") - -(defvar doom-cli-option-types - '((&flag . &flags) - (&multi . &multiple)) - "An alist of auxiliary keywords permitted in option specs in `defcli!'. - -They serve as shorter, inline aliases for `doom-cli-argument-types'. - -See `defcli!' for documentation on them.") - -(defvar doom-cli-option-generators - '((&flags . doom-cli--make-option-flag) - (&multiple . doom-cli--make-option-multi) - (&required . doom-cli--make-option-generic) - (&optional . doom-cli--make-option-generic)) - "An alist of `doom-cli-option' factories for argument types. - -Types that - -See argument types in `doom-cli-argument-types', and `defcli!' for usage.") - -(defvar doom-cli-option-arg-types - `((dir :test file-directory-p - :read expand-file-name - :error "Not a valid path to an existing directory" - :zshcomp "_dirs") - (file :test file-exists-p - :read expand-file-name - :error "Not a valid path to an existing file" - :zshcomp "_files") - (stdout :test ,(lambda (str) (equal str "-")) - :read identity - :error "Not a dash to signal stdout" - :zshcomp "(-)") - (path :read expand-file-name :zshcomp "_files") - (form :read read) - (regexp :test ,(lambda (str) (always (string-match-p str "")))) - (int :test "^[0-9]+$" - :read string-to-number - :error "Not an integer") - (num :test "^[0-9]+\\(\\.[0-9]+\\)?$" - :read string-to-number - :error "Not a valid number or float") - (float :test "^[0-9]+\\(\\.[0-9]+\\)$" - :read string-to-number - :error "Not a float") - (bool :test "^y\\(?:es\\)?\\|no?\\|on\\|off\\|t\\(?:rue\\)?\\|false\\|[01]\\|$" - :read ,(lambda (x) - (pcase x - ((or "y" "yes" "t" "true" "1" "on") :yes) - ((or "n" "no" "nil" "false" "0" "off") :no))) - :error "Not a valid boolean, should be blank or one of: yes, no, y, n, true, false, on, off" - :zshcomp "(y n yes no true false on off 1 0)") - (date :test ,(lambda (str) - (let ((ts (parse-time-string str))) - (and (decoded-time-day ts) - (decoded-time-month ts) - (decoded-time-year ts)))) - :read parse-time-string - :error "Not a valid date (try YYYY-MM-DD or a date produced by `date')") - (time :test ,(lambda (str) - (let ((ts (parse-time-string str))) - (and (decoded-time-hour ts) - (decoded-time-minute ts) - (decoded-time-second ts)))) - :read parse-time-string - :error "Not a valid date (try YYYY-MM-DD or a date produced by `date')") - (duration :test ,(lambda (str) - (not (cl-loop for d in (split-string-and-unquote str " ") - unless (string-match-p "^[0-9]+[hmsdMY]$" d) - return t))) - :read ,(doom-rpartial #'split-string-and-unquote " ") - :error "Not a valid duration (e.g. 5h 20m 40s 2Y 1M)") - (size :test "^[0-9]+[kmgt]?b$" - :read ,(lambda (str) - (save-match-data - (and (string-match "^\\([0-9]+\\(?:\\.[0-9]+\\)\\)\\([kmgt]?b\\)$" str) - (* (string-to-number (match-string 1 str)) - (or (cdr (assoc (match-string 2 str) - '(("kb" . 1000) - ("mb" . 1000000) - ("gb" . 1000000000) - ("tb" . 1000000000000)))) - 1))))) - :error "Not a valid filesize (e.g. 5mb 10.4kb 2gb 1.4tb)")) - "A list of implicit option argument datatypes and their rules. - -Recognizies the following properies: - - :test FN - Predicate function to determine if a value is valid. - :read FN - A transformer that converts the string argument to a desired format. - :error STR - The message to display if a value fails :test.") - -;;; Post-script settings -(defvar doom-cli-exit-commands - '(;; (:editor . doom-cli--exit-editor) - ;; (:emacs . doom-cli--exit-emacs) - (:pager . doom-cli--exit-pager) - (:pager? . doom-cli--exit-pager-maybe) - (:restart . doom-cli--exit-restart)) - "An alist of commands that `doom-cli--exit' recognizes.") - -(defvar doom-cli-pager (getenv "DOOMPAGER") - "The PAGER command to use. - -If nil, falls back to less.") - -(defvar doom-cli-pager-ratio 1.0 - "If output exceeds TTY height times this ratio, the pager is invoked. - -Only applies if (exit! :pager) or (exit! :pager?) are called.") - -;;; Logger settings -(defvar doom-cli-log-file-format (expand-file-name "logs/cli.%s.%s.%s" doom-state-dir) - "Where to write any output/log file to. - -Must have two arguments, one for session id and the other for log type.") - -(defvar doom-cli-log-retain 12 - "Number of each log type to retain.") - -(defvar doom-cli-log-backtrace-depth 12 - "How many frames of the backtrace to display in stdout.") - -(defvar doom-cli-log-straight-error-lines 16 - "How many lines of straight.el errors to display in stdout.") - -(defvar doom-cli-log-benchmark-threshold 5 - "How much execution time (in seconds) before benchmark is shown. - -If set to nil, only display benchmark if a CLI explicitly requested with a -non-nil :benchmark property. -If set to `always', show the benchmark no matter what.") - -;;; Internal variables -(defvar doom-cli--context nil) -(defvar doom-cli--exit-code 255) -(defvar doom-cli--group-plist nil) -(defvar doom-cli--table (make-hash-table :test 'equal)) - - -;; -;;; Custom hooks - -(defcustom doom-cli-create-context-functions () - "A hook executed once a new context has been generated. - -Called by `doom-cli-context-parse' and `doom-cli-context-restore', once a -`doom-cli-context' is fully populated and ready to be executed (but before it -has). - -Hooks are run with one argument: the newly created context." - :type 'hook - :group 'doom-cli) - -(defcustom doom-cli-before-run-functions () - "Hooks run before `run!' executes the command. - -Runs with a single argument: the active context (a `doom-cli-context' struct)." - :type 'hook - :group 'doom-cli) - -(defcustom doom-cli-after-run-functions () - "Hooks run after `run!' has executed the command. - -Runs with two arguments: the active context (a `doom-cli-context' struct) and -the return value of the executed CLI." - :type 'hook - :group 'doom-cli) - - -;; -;;; Errors - -(define-error 'doom-cli-error "There was an unexpected error" 'doom-error) -(define-error 'doom-cli-definition-error "Invalid CLI definition" 'doom-cli-error) -(define-error 'doom-cli-autoload-error "Failed to autoload deferred command" 'doom-cli-error) -(define-error 'doom-cli-invalid-prefix-error "Prefix has no defined commands" 'doom-cli-error) -(define-error 'doom-cli-command-not-found-error "Could not find that command" 'doom-cli-error) -(define-error 'doom-cli-wrong-number-of-arguments-error "Wrong number of CLI arguments" 'doom-cli-error) -(define-error 'doom-cli-unrecognized-option-error "Not a recognized option" 'doom-cli-error) -(define-error 'doom-cli-invalid-option-error "Invalid option value" 'doom-cli-error) - - -;; -;;; `doom-cli' - -(cl-defstruct doom-cli - "An executable CLI command." - (command nil :read-only t) - type - docs - autoload - alias - options - arguments - plist - fn) - -(defun doom-cli-execute (cli bindings) - "Execute CLI with BINDINGS (an alist). - -BINDINGS is an alist of (SYMBOL . VALUE) to bind lexically during CLI's -execution. Can be generated from a `doom-cli-context' with -`doom-cli--bindings'." - (doom-log "execute: %s %s" (doom-cli-key cli) bindings) - (funcall (doom-cli-fn cli) cli bindings)) - -(defun doom-cli-key (cli) - "Return CLI's (type . command), used as a table key or unique identifier." - (let ((command (doom-cli-command cli))) - (if-let (type (doom-cli-type cli)) - (cons type command) - command))) - -(defun doom-cli-command-normalize (command &optional plist) - "Ensure that COMMAND is properly formatted. - -This means that all non-keywords are strings, any prefixes provided by PLIST are -prepended, and the keyword is in front." - (let* ((command (ensure-list command)) - (prefix (plist-get plist :prefix)) - (prefix (if prefix (doom-cli-command-normalize - prefix (append `(:prefix nil) plist)))) - (command (append prefix command)) - (type (cl-find-if #'keywordp (remq :root command) :from-end t)) - (command (seq-subseq - command (or (cl-position :root command :from-end t) - 0)))) - (when (or command prefix) - (cl-loop with map = (fn! (if (or (stringp %) (keywordp %)) % (prin1-to-string %))) - for c in (delq nil (cons type (seq-remove #'keywordp command))) - if (listp c) - collect (mapcar map c) - else collect (funcall map c))))) - -(defun doom-cli-command-string (command) - "Return a joined string representation of normalized COMMAND. - -COMMAND should either be a command list (e.g. '(doom foo bar)) or a `doom-cli' -struct." - (mapconcat (doom-partial #'format "%s") - (doom-cli--command command) - " ")) - -(defun doom-cli-get (command &optional noresolve? noload?) - "Return CLI at COMMAND. - -Will autoload COMMAND if it was deferred with `defcli-autoload!'. - -If NORESOLVE?, don't follow aliases." - (when-let* ((command (doom-cli--command command)) - (cli (gethash command doom-cli--table)) - (cli (if noload? cli (doom-cli-load cli)))) - (if noresolve? - cli - (let (path) - (while (setq path (ignore-errors (doom-cli-alias cli))) - (setq cli (doom-cli-get path t noload?))) - (unless cli - (signal 'doom-cli-command-not-found-error (or path command))) - cli)))) - -(defun doom-cli-path (cli &optional noload?) - "Return a list of `doom-cli's encountered while following CLI's aliases. - -If NOLOAD? is non-nil, don't autoload deferred CLIs (see `doom-cli-get')." - (when cli - (cons - cli (let (alias paths) - (while (setq alias (ignore-errors (doom-cli-alias cli))) - (and (setq cli (doom-cli-get alias t noload?)) - (push cli paths))) - (nreverse paths))))) - -(defun doom-cli-find (command &optional nopartials?) - "Find all CLIs assocated with COMMAND, including partials. - -COMMAND can be a command path (list of strings), a `doom-cli' struct, or a -`doom-cli-context' struct. - -Returned in the order they will execute. Includes pseudo CLIs." - (let* ((command (doom-cli--command command)) - (paths (nreverse (doom-cli--command-expand command t))) - results clis) - (push '(:after) results) - (dolist (path paths) - (push (cons :after path) results)) - (push command results) - (dolist (path (nreverse paths)) - (push (cons :before path) results)) - (push '(:before) results) - (dolist (result results (nreverse clis)) - (when-let ((cli (doom-cli-get result t)) - ((or (not nopartials?) - (doom-cli-type cli)))) - (cl-pushnew cli clis - :test #'equal - :key #'doom-cli-key))))) - -(defun doom-cli-prop (cli prop &optional null-value) - "Returns a PROPerty of CLI's plist, or NULL-VALUE if it doesn't exist." - (let ((plist (doom-cli-plist cli))) - (if (plist-member plist prop) - (plist-get plist prop) - null-value))) - -(cl-defun doom-cli-subcommands (command &optional (depth 9999) &key tree? all? predicate?) - "Return a list of subcommands, DEPTH levels deep, below COMMAND. - - If DEPTH is non-nil, list *all* subcommands, recursively. Otherwise it expects -an integer. - If TREE?, return commands in a tree structure. - If ALL?, include hidden commands (like aliases)." - (when (or (null depth) (> depth 0)) - (catch :predicate - (let* ((command (doom-cli--command command t)) - (prefixlen (length command)) - results) - (dolist (cli (hash-table-values doom-cli--table)) - (let ((clicmd (doom-cli-command cli))) - (when (and (not (doom-cli-type cli)) - (= (length clicmd) (1+ prefixlen)) - (equal command (seq-take clicmd prefixlen)) - (or all? (not (doom-cli-prop cli :hide)))) - (when predicate? - (throw :predicate t)) - (let* ((car (if tree? (car (last clicmd)) clicmd)) - (cdr (doom-cli-subcommands - clicmd (if depth (1- depth)) - :tree? tree? - :all? all?))) - (if tree? - (push (if cdr (cons car cdr) car) results) - (cl-callf nconc results (cons car cdr))))))) - (if tree? - (nreverse results) - results))))) - -(defun doom-cli-aliases (cli) - "Return all known `doom-cli's that are aliased to CLI. - -This cannot see autoloaded CLIs. Use `doom-cli-load' or `doom-cli-load-all' -to reach them." - (cl-loop with cli = (doom-cli-get cli) - with key = (doom-cli-key cli) - for rcli in (hash-table-values doom-cli--table) - if (equal key (doom-cli-key rcli)) - collect cli)) - -(defun doom-cli-short-docs (cli) - "Return the first line of CLI's documentation. - -Return nil if CLI (a `doom-cli') has no explicit documentation." - (ignore-errors (cdr (assoc "SUMMARY" (doom-cli-docs cli))))) - -(defun doom-cli--bindings (cli context &optional seen) - "Return a CLI with a value alist in a cons cell." - (let* ((optspec (doom-cli-options cli)) - (argspec (doom-cli-arguments cli)) - alist) - ;; Ensure all symbols are defined - (dolist (opt optspec) - (setf (alist-get (doom-cli-option-symbol opt) alist) - (doom-cli-option-default opt))) - (dolist (syms argspec) - (dolist (sym (cdr syms)) - (setf (alist-get sym alist) nil))) - ;; Populate options - (let ((options (doom-cli-context-options context))) - (dolist (opt optspec) - (when-let (option (cl-loop for flag in (doom-cli-option-switches opt) - if (cdr (assoc flag options)) - return (cons flag it))) - (unless (member (car option) seen) - (setf (alist-get (doom-cli-option-symbol opt) alist) - (cdr option)) - (push (car option) seen))))) - ;; Populate arguments - (let* ((arglist (doom-cli-context-arguments context)) - (rest (copy-sequence (map-elt arglist (doom-cli-command cli)))) - (args (copy-sequence (alist-get t arglist))) - (argc (length args)) - (required (alist-get '&required argspec)) - (optional (alist-get '&optional argspec)) - (spec (append required optional)) - (min (length required)) - (max (if (or (assq '&args argspec) - (assq '&rest argspec)) - most-positive-fixnum - (length spec)))) - (when (or (< argc min) - (> argc max)) - (signal 'doom-cli-wrong-number-of-arguments-error - (list (doom-cli-key cli) nil args min max))) - (dolist (sym spec) - (setf (alist-get sym alist) (if args (pop args)))) - (dolist (type `((&args . ,args) - (&cli . ,cli) - (&context . ,context) - (&input - . ,(if (doom-cli-context-pipe-p context :in t) - (with-current-buffer (doom-cli-context-stdin context) - (buffer-string)))) - (&rest . ,rest) - (&whole . ,(doom-cli-context-whole context)))) - (when-let (var (car (alist-get (car type) argspec))) - (setf (alist-get var alist) (cdr type))))) - alist)) - -(defun doom-cli--command (target &optional notype?) - "Fetch the normalized command from TARGET. - -If NOTYPE? is non-nil, omit any leading keywords from the command. - -TARGET can be a `doom-cli', `doom-cli-context', or a command list." - (cond ((doom-cli-p target) - (if notype? - (doom-cli-command target) - (doom-cli-key target))) - ((doom-cli-context-p target) - (doom-cli-context-command target)) - ((and target (not (listp target))) - (signal 'wrong-type-argument - (list '(doom-cli-p doom-cli-context-p listp) target))) - ((let ((target (doom-cli-command-normalize target))) - (if (and notype? (keywordp (car target))) - (cdr target) - target))))) - -(defun doom-cli--command-expand (commandspec &optional recursive?) - "Expand COMMANDSPEC into a list of commands. - -If RECURSIVE, includes breadcrumbs leading up to COMMANDSPEC." - (funcall (if recursive? - #'identity - (fn! (cl-loop with cmdlen = (length (car %)) - for command in % - while (= (length command) cmdlen) - collect command))) - (seq-reduce (lambda (init next) - (nconc (cl-loop with firstlen = (length (car init)) - for seg in (ensure-list next) - nconc - (cl-loop for command in init - while (= (length command) firstlen) - collect (append command (list seg)))) - init)) - (cdr commandspec) - `(,@(mapcar #'list (ensure-list (car commandspec))))))) - -(defun doom-cli--parse-docs (docs) - (when (and (stringp docs) - (not (equal docs "TODO"))) - (let ((re "^\\([A-Z0-9 _-]+\\):\n") sections) - (with-temp-buffer - (save-excursion - (insert "__DOOMDOCS__:\n") - (insert docs)) - (while (re-search-forward re nil t) - (push (cons (match-string 1) - (let ((buffer (current-buffer)) - (beg (match-end 0)) - (end (save-excursion - (if (re-search-forward re nil t) - (1- (match-beginning 0)) - (point-max))))) - (with-temp-buffer - (insert-buffer-substring buffer beg end) - (goto-char (point-min)) - (indent-rigidly (point-min) (point-max) (- (skip-chars-forward " "))) - (string-trim-right (buffer-string))))) - sections))) - (let ((lines (split-string (cdr (assoc "__DOOMDOCS__" sections)) "\n")) - (sections (assoc-delete-all "__DOOMDOCS__" sections))) - `(("SUMMARY" . ,(car lines)) - ("MAIN" . ,(string-trim (string-join (cdr lines) "\n"))) - ,@(nreverse sections)))))) - - -;; -;;; `doom-cli-option' - -(cl-defstruct doom-cli-option - "A switch specification dictating the characteristics of a recognized option." - (symbol nil :read-only t) - docs - multiple-p - flag-p - switches - arguments - default) - -(defun doom-cli-option-validate (option &rest values) - "Test if OPTION will accept VALUES, and conforms them if necessary. - -OPTION is a `doom-cli-option' struct. VALUES can be any arbitrary values. -Returns VALUES once mapped through their respective reader (as dictated by -`doom-cli-option-arg-types'). - -Throws `doom-cli-invalid-option-error' for illegal values." - (let ((args (doom-cli-option-arguments option)) - (values (copy-sequence values))) - (dotimes (i (length args) values) - (let ((value (nth i values)) - (types (ensure-list (nth i args))) - errors) - (catch 'done - (dolist (type types) - ;; REVIEW Use pcase-let + map.el when 27.x support is dropped - (cl-destructuring-bind (&key test read error &allow-other-keys) - (if (or (symbolp type) - (and (stringp type) - (string-match-p "^[A-Z0-9-_]+$" type))) - (cdr (assq (if (symbolp type) type (intern (downcase type))) - doom-cli-option-arg-types)) - (list 'str :test #'stringp)) - (condition-case-unless-debug e - (or (and (or (null test) - (if (stringp test) - (and (string-match-p test value) t) - (funcall test value))) - (or (null read) - (setf (nth i values) (funcall read value))) - (throw 'done t)) - (push error errors)) - ((invalid-regexp invalid-read-syntax) - (push (error-message-string e) errors))))) - (signal 'doom-cli-invalid-option-error - (list types option value errors))))))) - -(defun doom-cli--read-option-switches (optspec) - (delq - nil (cl-loop for spec in optspec - if (and (stringp spec) - (string-match-p "^-\\(?:-[a-zA-Z0-9]\\|[^-]$\\)" spec)) - collect spec))) - -(defun doom-cli--read-option-args (argspec) - (delq - nil (cl-loop for spec in argspec - if (or (and (stringp spec) - (not (string-match-p "^-\\(?:-[a-zA-Z0-9]\\|[^-]$\\)" spec))) - (keywordp spec) - (symbolp spec) - (listp spec)) - collect spec))) - -(defun doom-cli--make-option-generic (symbol spec &optional docs) - (make-doom-cli-option - :symbol symbol - :docs docs - :switches (doom-cli--read-option-switches spec) - :arguments (doom-cli--read-option-args spec))) - -(defun doom-cli--make-option-flag (symbol spec &optional docs) - (let ((switches (doom-cli--read-option-switches spec)) - (args (doom-cli--read-option-args spec))) - (when (and args - (not (or (memq :yes args) - (memq :no args)))) - (signal 'doom-cli-definition-error - (list "Argument type %s cannot accept arguments for: %s" - '&flag (mapconcat #'symbol-name spec ", ")))) - (make-doom-cli-option - :symbol symbol - :docs docs - :flag-p t - :switches switches - :default (car args)))) - -(defun doom-cli--make-option-multi (symbol spec &optional docs) - (make-doom-cli-option - :symbol symbol - :docs docs - :multiple-p t - :switches (doom-cli--read-option-switches spec) - :arguments (doom-cli--read-option-args spec))) - - -;; -;;; `doom-cli-context' - -(cl-defstruct doom-cli-context - "A CLI context, containing all state pertinent to the current session." - (init-time before-init-time) ; When this context was created - ;; A session-specific ID of the current context (defaults to number - (pid (if-let (pid (getenv "__DOOMPID")) - (string-to-number pid) - (emacs-pid))) - ;; Number of Emacs processes this context has been processed through - (step (if-let (step (getenv "__DOOMSTEP")) - (string-to-number step) - -1)) - ;; The geometry of the terminal window. - (geometry (save-match-data - (when-let* ((geom (getenv "__DOOMGEOM")) - ((string-match "^\\([0-9]+\\)x\\([0-9]+\\)$" geom))) - (cons (string-to-number (match-string 1 geom)) - (string-to-number (match-string 2 geom)))))) - ;; Whether the script is being piped into or out of - (pipes (cl-loop for (env . scope) in `((,(getenv "__DOOMGPIPE") . global) - (,(getenv "__DOOMPIPE") . local)) - if (stringp env) - for pipes = (string-to-list env) - nconc `(,@(if (memq ?0 pipes) `((:in . ,scope))) - ,@(if (memq ?1 pipes) `((:out . ,scope))))) - :skip t) - ;; If non-nil, suppress prompts and auto-accept their consequences. - suppress-prompts-p - (prefix "@") ; The basename of the script creating this context - meta-p ; Whether or not this is a help/meta request - error ; - (command nil :skip t) ; The full command that led to this context - (path nil :skip t) ; Breadcrumb list of resolved commands so far - (whole nil :skip t) ; Unfiltered and unprocessed list of arguments - (options nil :skip t) ; An alist of (flags . value) - (arguments nil :skip t) ; An alist of non-subcommand arguments, by command - (stdin (generate-new-buffer " *doom-cli stdin*") :type buffer) ; buffer containing anything piped into this session - (stdout (generate-new-buffer " *doom-cli stdout*") :type buffer) ; buffer containing user-visible output - (stderr (generate-new-buffer " *doom-cli stderr*") :type buffer) ; buffer containing all output, including debug output - ;; An alist of persistent and arbitrary elisp state - (state nil :type alist)) - -(defun doom-cli-context-execute (context) - "Execute a given CONTEXT. - -Use `doom-cli-context-parse' or `doom-cli-context-restore' to produce a valid, -executable context." - (let* ((command (doom-cli-context-command context)) - (cli (doom-cli-get command t)) - (prefix (doom-cli-context-prefix context))) - (doom-log "context-execute: %s" - (mapconcat #'doom-cli-command-string - (delq nil (list (car (doom-cli-context-path context)) command)) - " -> ")) - (cond ((null (or command (doom-cli-get (list prefix) t))) - (signal 'doom-cli-invalid-prefix-error (list prefix))) - - ((doom-cli-context-meta-p context) - (pcase (doom-cli-context-meta-p context) - ("--version" - (doom-cli-call `(:version ,@(cdr command)) context) - t) - ((or "-?" "--help") - (doom-cli-call `(:help ,@(cdr command)) context) - t) - (_ (error "In meta mode with no destination!")))) - - ((not (and cli (doom-cli-fn (doom-cli-get cli)))) - (signal 'doom-cli-command-not-found-error - (append command (alist-get t (doom-cli-context-arguments context))))) - - ((let ((seen '(t)) - runners) - (dolist (cli (doom-cli-find command (doom-cli-type cli))) - (push (cons (doom-cli-get cli) - (doom-cli--bindings cli context seen)) - runners)) - (pcase-dolist (`(,cli . ,bindings) (nreverse runners)) - (doom-cli-execute cli bindings)) - context))))) - -(defun doom-cli-context-restore (file context) - "Restore the last restarted context from FILE into CONTEXT." - (when (and (stringp file) - (file-exists-p file)) - (when-let (old-context (with-temp-buffer - (insert-file-contents file) - (read (current-buffer)))) - (unless (doom-cli-context-p old-context) - (error "An invalid context was restored from file: %s" file)) - (unless (equal (doom-cli-context-prefix context) - (doom-cli-context-prefix old-context)) - (error "Restored context belongs to another script: %s" - (doom-cli-context-prefix old-context))) - (pcase-dolist (`(,slot ,_ . ,plist) - (cdr (cl-struct-slot-info 'doom-cli-context))) - (unless (plist-get plist :skip) - (let* ((idx (cl-struct-slot-offset 'doom-cli-context slot)) - (old-value (aref old-context idx))) - (aset context idx - (pcase (plist-get plist :type) - (`alist - (dolist (entry old-value (aref context idx)) - (setf (alist-get (car entry) (aref context idx)) (cdr entry)))) - (`buffer - (with-current-buffer (aref context idx) - (insert old-value) - (current-buffer))) - (_ old-value)))))) - (run-hook-with-args 'doom-cli-create-context-functions context) - (delete-file file) - (doom-log "context-restore: %s" (doom-cli-context-pid context)))) - context) - -(defun doom-cli-context-parse (args context) - "Parse ARGS and update CONTEXT to reflect it." - (let* ((case-fold-search t) - (args (delq nil (copy-sequence args))) - (arguments) - rest? - arg) - (while args - (setq arg (pop args)) - (save-match-data - (cond - ((equal arg "--") - (doom-log "context-parse: found arg separator" arg) - (setq arguments (cdr args) - args nil)) - - ((and (stringp arg) - (string-match "^\\(-\\([^-]\\{2,\\}\\)\\)" arg)) - (let ((chars (split-string (match-string 2 arg) "" t))) - (dolist (ch (nreverse chars)) - (push (concat "-" ch) args)))) - - ((and (stringp arg) - (or (string-match "^\\(--\\w[a-z0-9-_]+\\)\\(?:=\\(.*\\)\\)?$" arg) - (string-match "^\\(-[^-]\\)$" arg))) - (doom-log "context-parse: found switch %S" arg) - (catch :skip - (let* ((fullflag (match-string 1 arg)) - (normflag (if (string-prefix-p "--no-" fullflag) - (concat "--" (substring fullflag 5)) - fullflag)) - (option (or (doom-cli-context-find-option context normflag) - (when (member fullflag '("-?" "--help" "--version")) - (doom-log "context-parse: found help switch %S" arg) - (setf (doom-cli-context-meta-p context) fullflag) - (throw :skip t)) - (when rest? - (push arg arguments) - (throw :skip t)) - (signal 'doom-cli-unrecognized-option-error - (list fullflag)))) - (explicit-arg (match-string 2 arg)) - (arity (length (doom-cli-option-arguments option))) - (key (if (doom-cli-option-multiple-p option) - (car (doom-cli-option-switches option)) - normflag))) - (doom-cli-context-put - context key - (let ((value (seq-take args arity))) - (when explicit-arg - (push explicit-arg value)) - (when (/= (length value) arity) - (signal 'doom-cli-wrong-number-of-arguments-error - (list (doom-cli--command context) - fullflag value arity arity))) - (setq args (seq-drop args arity) - value (apply #'doom-cli-option-validate option value)) - (cond ((doom-cli-option-flag-p option) - (if (string-prefix-p "--no-" fullflag) :no :yes)) - ((doom-cli-option-multiple-p option) - (append (doom-cli-context-get context key) - (if (doom-cli-option-arguments option) - (cl-loop for v in value - collect (cons fullflag v)) - (list fullflag)))) - ((= arity 1) (car value)) - ((> arity 1) value) - (fullflag))))))) - - ((when-let* - (((null arguments)) - ((not rest?)) - (command (append (doom-cli-context-command context) (list arg))) - (cli (doom-cli-get command t)) - (rcli (doom-cli-get command)) - (key (doom-cli-key rcli))) - (doom-log "context-parse: found command %s" command) - ;; Show warnings depending on CLI plists - (when (doom-cli-alias cli) - (dolist (pcli (doom-cli-path cli)) - (doom-log "context-parse: path += %s" (doom-cli-key pcli)) - (push (doom-cli-key pcli) (doom-cli-context-path context)))) - ;; Collect &rest for this command - (setf (doom-cli-context-command context) key - (map-elt (doom-cli-context-arguments context) - (doom-cli-command rcli)) - (copy-sequence args)) - ;; Initialize options associated with this command to a nil value; - ;; this simplifies existence validation later. - (dolist (cli (doom-cli-find key)) - (dolist (option (doom-cli-options cli)) - (dolist (switch (doom-cli-option-switches option)) - (unless (assoc switch (doom-cli-context-options context)) - (setf (map-elt (doom-cli-context-options context) switch) - nil))))) - ;; If this command uses &rest, stop processing commands from this - ;; point on and pass the rest (of the unprocessed arguments) to it. - (when (and (doom-cli-fn rcli) - (alist-get '&rest (doom-cli-arguments rcli))) - (setq rest? t)) - t)) - - ((push arg arguments) - (doom-log "context-parse: found arg %S" arg))))) - - (setf (alist-get t (doom-cli-context-arguments context)) - (append (alist-get t (doom-cli-context-arguments context)) - (nreverse arguments))) - (run-hook-with-args 'doom-cli-create-context-functions context) - context)) - -(defun doom-cli-context-get (context key &optional null-value) - "Fetch KEY from CONTEXT's options or state. - -Context objects are essentially persistent storage, and may contain arbitrary -state tied to switches (\"--foo\" or \"-x\") or arbitrary symbols (state). - -If KEY is a string, fetch KEY from context's OPTIONS (by switch). -If KEY is a symbol, fetch KEY from context's STATE. -Return NULL-VALUE if KEY does not exist." - (if-let (value - (if (stringp key) - (assoc key (doom-cli-context-options context)) - (assq key (doom-cli-context-state context)))) - (cdr value) - null-value)) - -(defun doom-cli-context-put (context key val) - "Set KEY in CONTEXT's options or state to VAL. - -Context objects contain persistent storage, and may contain arbitrary state tied -to switches (\"--foo\" or \"-x\") or arbitrary symbols (state). Use this to -register data into CONTEXT. - -If KEY is a string, set the value of a switch named KEY to VAL. -If KEY is a symbol, set the value of the context's STATE to VAL." - (setf (alist-get - key (if (stringp key) - (doom-cli-context-options context) - (doom-cli-context-state context)) - nil nil #'equal) - val)) - -(defun doom-cli-context-find-option (context switch) - "Return a `doom-cli-option' belonging to SWITCH in CONTEXT, if available. - -Returns nil if SWITCH isn't a valid option in CONTEXT or none of the associated -`doom-cli's have a `doom-cli-option' associated with SWITCH." - (when (assoc switch (doom-cli-context-options context)) - (cl-loop with command = (doom-cli-context-command context) - for cli in (doom-cli-find command) - if (seq-find (lambda (opt) - (let ((switches (doom-cli-option-switches opt))) - (or (member switch switches) - (and (doom-cli-option-flag-p opt) - (string-prefix-p "--no-" switch))))) - (doom-cli-options cli)) - return it))) - -(defun doom-cli-context-width (context) - "Return the width (in character units) of CONTEXT's original terminal." - (or (car (doom-cli-context-geometry context)) - 80)) - -(defun doom-cli-context-height (context) - "Return the height (in character units) of CONTEXT's original terminal." - (or (cdr (doom-cli-context-geometry context)) - 40)) - -(defun doom-cli-context-pipe-p (context type &optional global?) - "Return non-nil if TYPE is an active pipe in the local CONTEXT. - -TYPE can be one of `:in' (receiving input on stdin) or `:out' (output is piped -to another process), or any of `local-in', `local-out', `global-in', or -`global-out'. - -If GLOBAL? is non-nil, if TYPE is `:in' or `:out', the global context (the pipes -active in the super-session, rather than the local Emacs instance) will be -considered as well." - (let ((pipes (doom-cli-context-pipes context))) - (and (if global? - (assq type pipes) - (member (cons type 'local) pipes)) - t))) - -(defun doom-cli-context-sid (context &optional nodate?) - "Return a unique session identifier for CONTEXT." - (if nodate? - (doom-cli-context-pid context) - (format (format-time-string - "%y%m%d%H%M%S.%%s" (doom-cli-context-init-time context)) - (doom-cli-context-pid context)))) - - -;; -;;; Output management - -(defun doom-cli-debugger (type data &optional context) - "Print a more presentable backtrace to terminal and write it to file." - ;; HACK Works around a heuristic in eval.c for detecting errors in the - ;; debugger, which executes this handler again on subsequent calls. Taken - ;; from `ert--run-test-debugger'. - (cl-incf num-nonmacro-input-events) - (let* ((inhibit-read-only nil) - (inhibit-message nil) - (inhibit-redisplay nil) - (inhibit-trace t) - (executing-kbd-macro nil) - (load-read-function #'read) - (backtrace (doom-backtrace)) - (context (or context (make-doom-cli-context))) - (straight-error - (and (bound-and-true-p straight-process-buffer) - (or (member straight-process-buffer data) - (string-match-p (regexp-quote straight-process-buffer) - (error-message-string data))) - (with-current-buffer (straight--process-buffer) - (split-string (buffer-string) "\n" t)))) - (error-file (doom-cli--output-file 'error context))) - (cond - (straight-error - (print! (error "The package manager threw an error")) - (print! (error "Last %d lines of straight's error log:") - doom-cli-log-straight-error-lines) - (print-group! - (print! - "%s" (string-join - (seq-subseq straight-error - (max 0 (- (length straight-error) - doom-cli-log-straight-error-lines)) - (length straight-error)) - "\n"))) - (print! (warn "Wrote extended straight log to %s") - (path (let ((coding-system-for-write 'utf-8-auto)) - (with-file-modes #o600 - (with-temp-file error-file - (insert-buffer-substring (straight--process-buffer)))) - error-file)))) - ((eq type 'error) - (let* ((generic? (eq (car data) 'error)) - (doom-cli-log-backtrace-depth doom-cli-log-backtrace-depth) - (print-escape-newlines t)) - (if (doom-cli-context-p context) - (print! (error "There was an unexpected runtime error")) - (print! (bold (error "There was a fatal initialization error")))) - (print-group! - (print! "%s %s" (bold "Message:") - (if generic? - (error-message-string data) - (get (car data) 'error-message))) - (unless generic? - (print! "%s %s" (bold "Details:") - (let* ((print-level 4) - (print-circle t) - (print-escape-newlines t)) - (prin1-to-string (cdr data))))) - (when backtrace - (print! (bold "Backtrace:")) - (print-group! - (dolist (frame (seq-take backtrace doom-cli-log-backtrace-depth)) - (print! "%s" (truncate (prin1-to-string - (cons (backtrace-frame-fun frame) - (backtrace-frame-args frame))) - (- (doom-cli-context-width context) - doom-print-indent - 1) - "...")))) - (when-let (backtrace-file (doom-backtrace-write-to-file backtrace error-file)) - (print! (warn "Wrote extended backtrace to %s") - (path backtrace-file)))))))) - (exit! 255))) - -(defmacro doom-cli-redirect-output (context &rest body) - "Redirect output from BODY to the appropriate log buffers in CONTEXT." - (declare (indent 1)) - (let ((contextsym (make-symbol "doomctxt"))) - `(let* ((,contextsym ,context) - ;; Emit more user-friendly backtraces - (debugger (doom-rpartial #'doom-cli-debugger ,contextsym)) - (debug-on-error t)) - (with-output-to! `((>= notice ,(doom-cli-context-stdout ,contextsym)) - (t . ,(doom-cli-context-stderr ,contextsym))) - ,@body)))) - -(defun doom-cli--output-file (type context) - "Return a log file path for TYPE and CONTEXT. - -See `doom-cli-log-file-format' for details." - (format doom-cli-log-file-format - (doom-cli-context-prefix context) - (doom-cli-context-sid context) - type)) - -(defun doom-cli--output-write-logs-h (context) - "Write all log buffers to their appropriate files." - (when (/= doom-cli--exit-code 254) - ;; Delete the last `doom-cli-log-retain' logs - (mapc #'delete-file - (let ((prefix (doom-cli-context-prefix context))) - (append (butlast (doom-glob (format doom-cli-log-file-format prefix "*" "log")) - doom-cli-log-retain) - (butlast (doom-glob (format doom-cli-log-file-format prefix "*" "error")) - doom-cli-log-retain)))) - ;; Then write the log file, if necessary - (let* ((buffer (doom-cli-context-stderr context)) - (file (doom-cli--output-file "log" context))) - (when (> (buffer-size buffer) 0) - (with-file-modes #o700 - (make-directory (file-name-directory file) t)) - (with-file-modes #o600 - (with-temp-file file - (insert-buffer-substring buffer) - (ansi-color-filter-region (point-min) (point-max)))))))) - -(defun doom-cli--output-benchmark-h (context) - "Write this session's benchmark to stdout or stderr, depending. - -Will also output it to stdout if requested (CLI sets :benchmark to t) or the -command takes >5s to run. If :benchmark is explicitly set to nil (or -`doom-cli-log-benchmark-threshold' is nil), under no condition should a -benchmark be shown." - (doom-cli-redirect-output context - (doom-log "%s (GCs: %d, elapsed: %.6fs)" - (if (= doom-cli--exit-code 254) "Restarted" "Finished") - gcs-done gc-elapsed) - (when-let* ((init-time (doom-cli-context-init-time context)) - (cli (doom-cli-get context)) - (duration (float-time (time-subtract (current-time) init-time))) - (hours (/ (truncate duration) 60 60)) - (minutes (- (/ (truncate duration) 60) (* hours 60))) - (seconds (- duration (* hours 60 60) (* minutes 60)))) - (when (and (/= doom-cli--exit-code 254) - (or (eq (doom-cli-prop cli :benchmark) t) - (eq doom-cli-log-benchmark-threshold 'always) - (and (eq (doom-cli-prop cli :benchmark :null) :null) - (not (doom-cli-context-pipe-p context 'out t)) - (> duration (or doom-cli-log-benchmark-threshold - most-positive-fixnum))))) - (print! (success "Finished in %s") - (join (list (unless (zerop hours) (format "%dh" hours)) - (unless (zerop minutes) (format "%dm" minutes)) - (format (if (> duration 60) "%ds" "%.5fs") - seconds)))))))) - - -;; -;;; Session management - -(defun doom-cli-call (args context &optional error) - "Process ARGS (list of string shell arguments) with CONTEXT as the basis. - -If ERROR is provided, store the error in CONTEXT, in case a later CLI wants to -read/use it (e.g. like a :help CLI)." - (let ((oldcommand (doom-cli-context-command context))) - (if oldcommand - (doom-log "call: %s -> %s" oldcommand args) - (doom-log "call: %s" oldcommand args)) - (when error - (setf (doom-cli-context-error context) error)) - (setf (doom-cli-context-command context) nil - (doom-cli-context-arguments context) nil - (doom-cli-context-meta-p context) nil) - (doom-cli-context-execute - (doom-cli-context-parse args (or context doom-cli--context))))) - -(defun doom-cli--restart (args context) - "Restart the current CLI session. - -If CONTEXT is non-nil, this is written to file and restored in the next Doom -session. - -This is done by writing a temporary shell script, which is executed after this -session ends (see the shebang lines of this file). It's done this way because -Emacs' batch library lacks an implementation of the exec system call." - (cl-check-type context doom-cli-context) - (when (= (doom-cli-context-step context) -1) - (error "__DOOMSTEP envvar missing; extended `exit!' functionality will not work")) - (let* ((pid (doom-cli-context-pid context)) - (step (doom-cli-context-step context)) - (context-file (format (doom-path temporary-file-directory "doom.%s.%s.context") pid step)) - (script-file (format (doom-path temporary-file-directory "doom.%s.%s.sh") pid step)) - (command (if (listp args) (combine-and-quote-strings (remq nil args)) args)) - (persistent-files - (combine-and-quote-strings (delq nil (list script-file context-file)))) - (persisted-env - (save-match-data - (cl-loop with initial-env = (get 'process-environment 'initial-value) - for env in (seq-difference process-environment initial-env) - if (string-match "^\\([a-zA-Z0-9_][^=]+\\)=\\(.+\\)$" env) - collect (format "%s=%s" - (match-string 1 env) - (shell-quote-argument (match-string 2 env))))))) - (cl-incf (doom-cli-context-step context)) - (with-file-modes #o600 - (doom-log "restart: writing context to %s" context-file) - (doom-file-write - context-file (let ((newcontext (copy-doom-cli-context context)) - (print-level nil) - (print-length nil) - (print-circle nil) - (print-escape-newlines t)) - ;; REVIEW: Use `print-unreadable-function' when 28 support - ;; is dropped. - (letf! (defmacro convert-buffer (fn) - `(setf (,fn newcontext) (with-current-buffer (,fn context) - (buffer-string)))) - (convert-buffer doom-cli-context-stdin) - (convert-buffer doom-cli-context-stdout) - (convert-buffer doom-cli-context-stderr)) - newcontext)) - (doom-log "restart: writing post-script to %s" script-file) - (doom-file-write - script-file `("#!/usr/bin/env sh\n" - "trap _doomcleanup EXIT\n" - "_doomcleanup() {\n rm -f " ,persistent-files "\n}\n" - "_doomrun() {\n " ,command "\n}\n" - ,(string-join persisted-env " \\\n") - ,(cl-loop for (envvar . val) - in `(("DOOMPROFILE" . ,(ignore-errors (doom-profile->id doom-profile))) - ("EMACSDIR" . ,doom-emacs-dir) - ("DOOMDIR" . ,doom-user-dir) - ("DEBUG" . ,(if init-file-debug "1")) - ("__DOOMSTEP" . ,(number-to-string (doom-cli-context-step context))) - ("__DOOMCONTEXT" . ,context-file)) - if val - concat (format "%s=%s \\\n" envvar (shell-quote-argument val))) - ,(format "PATH=\"%s%s$PATH\" \\\n" - (doom-path doom-emacs-dir "bin") - path-separator) - "_doomrun \"$@\"\n"))) - (doom-log "_doomrun: %s %s" (string-join persisted-env " ") command) - (doom-log "_doomcleanup: %s" persistent-files) - ;; Error code 254 is special: it indicates to the caller that the - ;; post-script should be executed after this session ends. It's up to - ;; `doom-cli-run's caller to enforce this (see bin/doom's shebang for a - ;; comprehensive example). - (doom-cli--exit 254 context))) - -(defun doom-cli--exit (args context) - "Accepts one of the following: - - (CONTEXT [ARGS...]) - TODO - (STRING [ARGS...]) - TODO - (:restart [ARGS...]) - TODO - (:pager [FILE...]) - TODO - (:pager? [FILE...]) - TODO - (INT) +;;; Predefined CLIs (:help, :version, and :dump) + +(defvar doom-help-commands '("%p %c {-?,--help}") + "A list of help commands recognized for the running script. + +Recognizes %p (for the prefix) and %c (for the active command).") + +;; When __DOOMDUMP is set, doomscripts trigger this special handler. +(defcli! (:root :dump) + ((pretty? ("--pretty") "Pretty print output") + &context context + &args commands) + "Dump metadata to stdout for other commands to read." + (let* ((prefix (doom-cli-context-prefix context)) + (command (cons prefix commands))) + (funcall (if pretty? #'pp #'prin1) + (cond ((equal commands '("-")) (hash-table-values doom-cli--table)) + (commands (doom-cli-find command)) + ((doom-cli-find (list prefix))))) + (terpri) + ;; Kill manually so we don't save output to logs. + (let (kill-emacs) (kill-emacs 0)))) + +(defcli! (:root :help) + ((localonly? ("-g" "--no-global") "Hide global options") + (manpage? ("--manpage") "Generate in manpage format") + (commands? ("--commands") "List all known commands") + &multiple + (sections ("--synopsis" "--subcommands" "--similar" "--envvars" + "--postamble") + "Show only the specified sections.") + &context context + &args command) + "Show documentation for a Doom CLI command. + +OPTIONS: + --synopsis, --subcommands, --similar, --envvars, --postamble TODO" - (let ((command (or (car-safe args) args)) - (args (if (car-safe args) (cdr-safe args)))) - (pcase command - ;; If an integer, treat it as an exit code. - ((pred (integerp)) - (setq doom-cli--exit-code command) - (kill-emacs command)) - - ;; Otherwise, run a command verbatim. - ((pred (stringp)) - (doom-cli--restart (format "%s %s" command (combine-and-quote-strings args)) - context)) - - ;; Same with buffers. - ((pred (bufferp)) - (doom-cli--restart (with-current-buffer command (buffer-string)) - context)) - - ;; If a context is given, restart the current session with the new context. - ((pred (doom-cli-context-p)) - (doom-cli--exit-restart args command)) - - ;; Run a custom action, defined in `doom-cli-exit-commands'. - ((pred (keywordp)) - (if-let (fn (alist-get command doom-cli-exit-commands)) - (funcall fn args context) - (error "Invalid exit command: %s" command))) - - ;; Any other value is invalid. - (_ (error "Invalid exit code or command: %s" command))))) - -(defun doom-cli--exit-restart (args context) - "Restart the session, verbatim (persisting CONTEXT). - -ARGS are addiitonal arguments to pass to the sub-process (in addition to the -ones passed to this one). It may contain :omit -- all arguments after this will -be removed from the argument list. They may specify number of arguments in the -format: - - --foo=4 omits --foo plus four following arguments - --foo=1 omits --foo plus one following argument - --foo= equivalent to --foo=1 - --foo=* omits --foo plus all following arguments - -Arguments don't have to be switches either." - (let ((pred (fn! (not (keywordp %)))) - (args (append (doom-cli-context-whole context) - (flatten-list args)))) - (let ((argv (seq-take-while pred args)) - (omit (mapcar (fn! (seq-let (arg n) (split-string % "=") - (cons - arg (cond ((not (stringp n)) 0) - ((string-empty-p n) 1) - ((equal n "*") -1) - ((string-to-number n)))))) - (seq-take-while pred (cdr (memq :omit args))))) - newargs) - (when omit - (while argv - (let ((arg (pop argv))) - (if-let (n (cdr (assoc arg omit))) - (if (= n -1) - (setq argv nil) - (dotimes (i n) (pop argv))) - (push arg newargs))))) - (doom-cli--exit (cons "$1" (or (nreverse newargs) argv)) - context)))) - -(defun doom-cli--exit-pager (args context) - "Invoke pager on output unconditionally. - -ARGS are options passed to less. If DOOMPAGER is set, ARGS are ignored." - (let ((pager (or doom-cli-pager (getenv "DOOMPAGER")))) - (cond ((null (or pager (executable-find "less"))) - (user-error "No pager set or available") - (doom-cli--exit 1 context)) - - ((or (doom-cli-context-pipe-p context :out t) - (equal pager "")) - (doom-cli--exit 0 context)) - - ((let ((tmpfile (doom-cli--output-file 'output context)) - (coding-system-for-write 'utf-8)) - (with-file-modes #o700 - (make-directory (file-name-directory tmpfile) t)) - (with-file-modes #o600 - (with-temp-file tmpfile - (insert-buffer-substring (doom-cli-context-stdout context)))) - (doom-cli--restart - (format "%s <%s; rm -f%s %s" - (or pager - (format "less %s" - (combine-and-quote-strings - (append (if doom-print-backend '("-r")) ; process ANSI codes - (or (delq nil args) '("+g")))))) - (shell-quote-argument tmpfile) - (if init-file-debug "v" "") - (shell-quote-argument tmpfile)) - context)))))) - -(defun doom-cli--exit-pager-maybe (args context) - "Invoke pager if stdout is longer than TTY height * `doom-cli-pager-ratio'. - -ARGS are options passed to less. If DOOMPAGER is set, ARGS are ignored." - (doom-cli--exit - (let ((threshold (ceiling (* (doom-cli-context-height context) - doom-cli-pager-ratio)))) - (if (>= (let ((stdout (doom-cli-context-stdout context))) - (if (fboundp 'buffer-line-statistics) - (car (buffer-line-statistics stdout)) - (with-current-buffer stdout - (count-lines (point-min) (point-max))))) - threshold) - (cons :pager args) - 0)) - context)) - -;; (defun doom-cli--exit-editor (args context)) ; TODO Launch $EDITOR - -;; (defun doom-cli--exit-emacs (args context)) ; TODO Launch Emacs subsession - - - -;; -;;; Migration paths - -;; (defvar doom-cli-context-restore-functions -;; '(doom-cli-context--restore-legacy-fn) -;; "A list of functions intended to unserialize `doom-cli-context'. - -;; They all take one argument, the raw data saved to $__DOOMCONTEXT. Each function -;; must return the version string corresponding to the version of Doom they have -;; transformed it for.") - -;; (defun doom-cli-context-restore (file context) -;; "Restore the last restarted context from FILE into CONTEXT." -;; (when (and (stringp file) -;; (file-exists-p file)) -;; (when-let* ((data (with-temp-buffer -;; (insert-file-contents file) -;; (read (current-buffer)))) -;; (version (if (stringp (car data)) (car data) "0")) -;; (old-context (if (string (car data)) (cdr data) data)) -;; (new-context (make-doom-cli-context)) -;; (struct-info (cl-loop for (slot _initval . plist) in (cdr (cl-struct-slot-info 'doom-cli-context)) -;; collect (cons (cl-struct-slot-offset 'doom-cli-context slot) -;; (cons slot plist))))) - -;; ;; (let ((version (if (stringp (car data)) (car data) "0")) -;; ;; (data (if (string (car data)) (cdr data) data)) -;; ;; (newcontext (make-doom-cli-context))) -;; ;; (dolist (fn doom-cli-context-restore-functions) -;; ;; (setq newcontext (funcall fn newcontext data version)))) - -;; (unless (doom-cli-context-p old-context) -;; (error "An invalid context was restored from file: %s" file)) -;; (unless (equal (doom-cli-context-prefix context) -;; (doom-cli-context-prefix old-context)) -;; (error "Restored context belongs to another script: %s" -;; (doom-cli-context-prefix old-context))) -;; (pcase-dolist (`(,slot ,_ . ,plist) -;; (cdr (cl-struct-slot-info 'doom-cli-context))) -;; (unless (plist-get plist :skip) -;; (let* ((idx (cl-struct-slot-offset 'doom-cli-context slot)) -;; (old-value (aref old-context idx))) -;; (aset context idx -;; (pcase (plist-get plist :type) -;; (`alist -;; (dolist (entry old-value (aref context idx)) -;; (setf (alist-get (car entry) (aref context idx)) (cdr entry)))) -;; (`buffer -;; (with-current-buffer (aref context idx) -;; (insert old-value) -;; (current-buffer))) -;; (_ old-value)))))) -;; (run-hook-with-args 'doom-cli-create-context-functions context) -;; (delete-file file) -;; (doom-log "Restored context: %s" (doom-cli-context-pid context)) -;; context))) - -;; (defun doom-cli-context--restore-legacy-fn (data old-version) -;; "Update `doom-cli-context' from <3.0.0 to 3.0.0." -;; (when (or (equal old-version "3.0.0-dev") -;; (string-match-p "^2\\.0\\." old-version)) - -;; "3.0.0")) - -;; (defun doom-cli-context--restore-3.1.0-fn (data old-version)) - - -;; -;;; Misc - -(defun doom-cli-load (cli) - "If CLI is autoloaded, load it, otherwise return it unchanged." - (or (when-let* ((path (doom-cli-autoload cli)) - (path (locate-file-internal path doom-cli-load-path load-suffixes))) - (doom-log "load: autoload %s" path) - (let ((doom-cli--group-plist (doom-cli-plist cli))) - (doom-load path)) - (let* ((key (doom-cli-key cli)) - (cli (gethash key doom-cli--table))) - (when (doom-cli-autoload cli) - (signal 'doom-cli-autoload-error (list (doom-cli-command cli) path))) - cli)) - cli)) - -(defun doom-cli-load-all () - "Immediately load all autoloaded CLIs." - (dolist (key (hash-table-keys doom-cli--table)) - (doom-cli-load (gethash key doom-cli--table)))) - - -;; -;;; DSL - -(defmacro defcli! (commandspec arglist &rest body) - "Defines a CLI command. - -COMMANDSPEC is the specification for the command that will trigger this CLI. It -can either be a symbol or list of symbols (or nested symbols). Nested lists are -treated as a list of aliases for the command. For example: - - (defcli! doom () ...) ; invoked on 'doom' - (defcli! (doom foo) () ...) ; invoked on 'doom foo' - (defcli! (doom (foo bar)) () ...) ; invoked on 'doom foo' or 'doom bar' - -COMMANDSPEC may be prefixed with any of these special keywords: - - :root ... - This command will ignore any :prefix set by a parent `defcli-group!'. - :before ... - This command will run before the specified command(s). - :after ... - This command will run after the specified command(s). - :version - A special handler, executed when 'X --version' is called. Define your own, - if you don't want it spewing Doom's version information. - :help COMMAND... - A special handler, executed when help documentation is requested for a - command. E.g. 'doom help foo' or 'doom foo --help' will call (:help foo). - You can define your own global :help handler, or one for a specific command. - :dump COMMAND... - A special handler, executed when the __DOOMDUMP environment variable is set. - You can define one for a specific COMMAND, or omit it to redefine the - catch-all :dump handler. - - The default implementation (living in lisp/doom-cli.el) will either: - - a) Dump to stdout a list of `doom-cli' structs for the commands and pseudo - commands that would've been executed had __DOOMDUMP not been set. - b) Or, given only \"-\" as an argument, dump all of `doom-cli--table' to - stdout. This table contains all known `doom-cli's (after loading - autoloaded ones). - -To interpolate values into COMMANDSPEC (e.g. to dynamically generate commands), -use the comma operator: - - (let ((somevar 'bfg)) - (defcli! (doom ,somevar) ...)) - -DOCSTRING is a string description; its first line should be a short summary -(under 60 characters) of what the command does. It will be used in the cramped -command listings served by help commands. The rest of DOCSTRING lines should be -no longer than 80 columns, and should go into greater detail. This documentation -may use `quoting' to appropriately highlight ARGUMENTS, --options, or $ENVVARS. - -DOCSTRING may also contain sections denoted by a capitalized header ending with -a colon and newline, and its contents indented by 2 spaces. These will be -appended to the end of the help documentation for that command. These three -sections are special: - - ARGUMENTS: - Use this to specify longer-form documentation for arguments. They are - prepended to the documentation for commands. If pseudo CLIs specify their - own ARGUMENTS sections, they are joined with that of the root command's CLI - as well. E.g. ':before doom sync's ARGUMENTS will be prepended to 'doom - sync's. - OPTIONS: - Use this to specify longer-form documentation for options. They are appended - to the auto-generated section of the same name. Only the option needs to be - specified for its lookup behavior to work. See bin/doom's `doom' command as - an example. - EXAMPLES: - To list example uses of the containing script. These are appended to - SYNOPSIS in generated manpages, but treated as a normal section otherwise - (i.e. appended to 'doom help's output). - -DOCSTRING may use any of these format specifications: - - %p The running script's prefix. E.g. for 'doom ci deploy-hooks' the - prefix is 'doom'. - %c The parent command minus the prefix. E.g. for 'doom ci deploy-hooks', - the command is 'ci deploy-hooks'. - -ARGLIST is a specification for options and arguments that is accepted by this -command. Arguments are represented by either a symbol or a cons cell where -(SYMBOL . DOCUMENTATION), and option specifications are lists in the following -formats: - - ([TYPE] VAR (FLAGSPEC... [ARGSPEC...]) [DESCRIPTION]) - - TYPE - Optional. One of &flag or &multi (which correspond to &flags and &multiple, - respectively, and are used for specifying a type inline, if desired). - VAR - Is the symbol to bind that option's value to. - FLAGSPEC - A list of switches or sub-lists thereof. Each switch is a string, e.g. - \"--foo\" \"-b\" \"--baz\". - - Nested lists will be treated as logical groups of switches in documentation. - E.g. for - - With (\"--foo\" \"--bar\" [ARGSPEC...]) you get: - - --foo, --bar - [Documentation] - - With ((\"--foo\") (\"--bar\") [ARGSPEC...]) you get: - - --foo - --bar - [Documentation] - - Use this to logically group options that have many, but semantically - distinct switches. - ARGSPEC - A list of arguments or sub-lists thereof. Each argument is either a string - or symbol. - - If a string, they are used verbatim as the argument's documentation. Use - this to document more complex specifications, like \"[user@]host[:port]\". - Use reference `quotes' to highlight arguments appropriately. No input - validation is performed on these arguments. - - If a symbol, this is equivalent to (upcase (format \"`%s'\" SYMBOL)), but - its arguments will also be implicitly validated against - `doom-cli-option-arg-types'. - - A nested list indicates that an argument accepts multiple types, and are - implicitly joined into \"`ARG1'|`ARG2'|...\". Input validation is performed - on symbols only. - - WARNING: If this option is a &flag, the option must not accept arguments. - Instead, use ARGSPEC to specify a single, default value (one of `:yes' or - `:no'). - DESCRIPTION - A one-line description of the option. Use reference `quotes' to - appropriately highlight arguments, options, and envvars. A syntax exists for - adding long-form option documentation from the CLI's docstring. See - DOCSTRING above. - -ARGLIST may be segmented with the following auxiliary keywords: - - &args ARG - The rest of the literal arguments are stored in ARG. - &cli ARG - The called `doom-cli' struct is bound to ARG. - &context ARG - The active `doom-cli-context' struct is bound to ARG. - &flags OPTION... - An option '--foo' declared after &flags will implicitly include a - '--no-foo', and will appear as \"--[no-]foo\" in 'doom help' docs. - &multiple OPTION... - Options specified after &multiple may be passed to the command multiple - times. Its symbol will be bound to a list of cons cells containing (FLAG . - VALUE). - &optional ARG... - Indicates that the (literal) arguments after it are optional. - &input ARG - ARG will be bound to the input piped in from stdin, as a string, or nil if - unavailable. If you want access to the original buffer, use - (doom-cli-context-stdin context) instead. - &rest ARG - All switches and arguments, unprocessed, after this command. If given, any - unrecognized switches will not throw an error. This will also prevent - subcommands beneath this command from being recognized. Use with care! - - Any non-option arguments before &optional, &rest, or &args are required. - -BODY is a list of arbitrary elisp forms that will be executed when this command -is called. BODY may begin with a plist to set metadata about it. The recognized -properties: - - :alias (CMD...) - Designates this command is an alias to CMD, which is a command specification - identical to COMMANDSPEC. - :benchmark BOOL - If non-nil, display a benchmark after the command finishes. - :disable BOOL - If non-nil, the command will not be defined. - :docs STRING - An alternative to DOCSTRING for defining documentation for this command. - :group (STR...) - A breadcrumb of group names to file this command under. They will be - organized by category in the CLI documentation (available through SCRIPT - {--help,-?,help}). - :hide BOOL - If non-nil, don't display this command in the help menu or in {ba,z}sh - completion (though it will still be callable). - :partial BOOL - If non-nil, this command is treated as partial, an intermediary command - intended as a stepping stone toward a non-partial command. E.g. were you to - define (doom foo bar), two \"partial\" commands are implicitly created: - \"doom\" and \"doom foo\". When called directly, partials will list its - subcommands and complain that a subcommand is rqeuired, rather than display - an 'unknown command' error. - :prefix (STR...) - A command path to prepend to the command name. This is more useful as part - of `defcli-group!'s inheritance. - -The BODY of commands with a non-nil :alias, :disable, or :partial will be -ignored. - -\(fn COMMANDSPEC ARGLIST [DOCSTRING] &rest BODY...)" - (declare (indent 2) (doc-string 3)) - (let ((docstring (if (stringp (car body)) (pop body))) - (plist (cl-loop for (key val) on body by #'cddr - while (keywordp key) - collect (pop body) - collect (pop body))) - options arguments bindings) - (let ((type '&required)) - (dolist (arg arglist) - (cond ((listp arg) - (let* ((inline-type (cdr (assq (car arg) doom-cli-option-types))) - (type (or inline-type type)) - (args (if inline-type (cdr arg) arg))) - (push (apply (or (alist-get type doom-cli-option-generators) - (signal 'doom-cli-definition-error - (cons "Invalid option type" type))) - args) - options) - (push (car args) bindings))) - ((memq arg doom-cli-argument-types) - (setq type arg)) - ((string-prefix-p "&" (symbol-name arg)) - (signal 'doom-cli-definition-error (cons "Invalid argument specifier" arg))) - ((push arg bindings) - (push arg (alist-get type arguments)))))) - (dolist (arg arguments) - (setcdr arg (nreverse (cdr arg)))) - `(let (;; Define function early to prevent overcapturing - (fn ,(let ((clisym (make-symbol "cli")) - (alistsym (make-symbol "alist"))) - `(lambda (,clisym ,alistsym) - (let ,(cl-loop for arg in (nreverse bindings) - unless (string-prefix-p "_" (symbol-name arg)) - collect `(,arg (cdr (assq ',arg ,alistsym)))) - ,@body))))) - ;; `cl-destructuring-bind's will validate keywords, so I don't have to - (cl-destructuring-bind - (&whole plist &key - alias autoload _benchmark docs disable hide _group partial - _prefix) - (append (list ,@plist) doom-cli--group-plist) - (unless disable - (let* ((command (doom-cli-command-normalize (backquote ,commandspec) plist)) - (type (if (keywordp (car command)) (pop command))) - (commands (doom-cli--command-expand command t)) - (target (pop commands))) - (dolist (prop '(:autoload :alias :partial :hide)) - (cl-remf plist prop)) - (puthash (delq nil (cons type target)) - (make-doom-cli - :command target - :type type - :docs (doom-cli--parse-docs (or ',docstring docs)) - :arguments ',arguments - :options ',(nreverse options) - :autoload autoload - :alias (if alias (doom-cli-command-normalize alias plist)) - :plist (append plist (list :hide (and (or hide type) t))) - :fn (unless (or partial autoload) fn)) - doom-cli--table) - (let ((docs (doom-cli--parse-docs docs))) - (dolist (alias (cl-loop for c in commands - while (= (length c) (length target)) - collect (pop commands))) - (puthash (delq nil (cons type alias)) - (make-doom-cli - :command alias - :type type - :docs docs - :autoload autoload - :alias (unless autoload (delq nil (cons type target))) - :plist (append plist '(:hide t))) - doom-cli--table)) - (dolist (partial commands) - (let ((cli (gethash partial doom-cli--table))) - (when (or (null cli) (doom-cli-autoload cli)) - (puthash (delq nil (cons type partial)) - (make-doom-cli - :command partial - :type type - :docs docs - :plist (list :group (plist-get plist :group))) - doom-cli--table))))) - target)))))) - -(defmacro defcli-alias! (commandspec target &rest plist) - "Define a CLI alias for TARGET at COMMANDSPEC. - -See `defcli!' for information about COMMANDSPEC. -TARGET is not a command specification, and should be a command list." - `(defcli! ,commandspec () :alias ',target ,@plist)) - -(defmacro defcli-obsolete! (commandspec target when) - "Define an obsolete CLI COMMANDSPEC that refers users to NEW-COMMAND. - -See `defcli!' for information about COMMANDSPEC. -TARGET is simply a command list. -WHEN specifies what version this command was rendered obsolete." - `(let ((ncommand (doom-cli-command-normalize (backquote ,target) doom-cli--group-plist))) - (defcli! ,commandspec (&context _context &cli cli &rest args) - :docs (format "An obsolete alias for '%s'." (doom-cli-command-string ncommand)) - :hide t - (print! (warn "'%s' was deprecated in %s") - (doom-cli-command-string cli) - ,when) - (print! (warn "It will eventually be removed; use '%s' instead.") - (doom-cli-command-string ncommand)) - (call! ',target args)))) - -(defmacro defcli-stub! (commandspec &optional _argspec &rest body) - "Define a stub CLI, which will throw an error if invoked. - -Use this to define commands that will eventually be implemented, but haven't -yet. They won't be included in command listings (by help documentation)." - (declare (indent 2) (doc-string 3)) - `(defcli! ,commandspec (&rest _) - ,(concat "THIS COMMAND IS A STUB AND HAS NOT BEEN IMPLEMENTED YET." - (if (stringp (car body)) (concat "\n\n" (pop body)))) - :hide t - (user-error "Command not implemented yet"))) - -(defmacro defcli-autoload! (commandspec &optional path &rest plist) - "Defer loading of PATHS until PREFIX is called." - `(let* ((doom-cli--group-plist (append (list ,@plist) doom-cli--group-plist)) - (commandspec (doom-cli-command-normalize ',commandspec)) - (commands (doom-cli--command-expand commandspec)) - (path (or ,path - (when-let* ((cmd (car commands)) - (last (car (last cmd))) - (last (if (listp last) (car last) last))) - (format "%s" last)) - (error "Failed to deduce autoload path for: %s" spec))) - (cli (doom-cli-get (car commands) nil t))) - (when (or (null cli) - (doom-cli-autoload cli)) - (defcli! ,commandspec () :autoload path)))) - -(defmacro defcli-group! (&rest body) - "Declare common properties for any CLI commands defined in BODY." - (when (stringp (car body)) - (push :group body)) - `(let ((doom-cli--group-plist (copy-sequence doom-cli--group-plist))) - ,@(let (forms) - (while (keywordp (car body)) - (let ((key (pop body)) - (val (pop body))) - (push `(cl-callf plist-put doom-cli--group-plist - ,key ,(if (eq key :prefix) - `(append (plist-get doom-cli--group-plist ,key) - (ensure-list ,val)) - val)) - forms))) - (nreverse forms)) - ,@body)) - -(defun exit! (&rest args) - "Exits the current CLI session. - -With ARGS, you may specify a shell command or action (see -`doom-cli-exit-commands') to execute after this Emacs process has ended. For -example: - - (exit! \"$@\") or (exit! :restart) - This reruns the current command with the same arguments. - (exit! \"$@ -h -c\") - This reruns the current command with two new switches. - (exit! :restart \"-c\" :omit \"--foo=2\" \"--bar\") - This reruns the current command with one new switch (-c) and two switches - removed (--foo plus two arguments and --bar). - (exit! \"emacs -nw FILE\") - Opens Emacs on FILE - (exit! \"emacs\" \"-nw\" \"FILE\") - Opens Emacs on FILE, but each argument is escaped (and nils are ignored). - (exit! t) or (exit! nil) - A safe way to simply abort back to the shell with exit code 0 - (exit! 42) - Abort to shell with an explicit exit code. - (exit! context) - Restarts the current session, but with context (a `doom-cli-context' struct). - (exit! :pager [FILES...]) - Invoke $DOOMPAGER (or less) on the output of this session. If ARGS are given, launch the pager on those - (exit! :pager? [FILES...]) - Same as :pager, but does so only if output is longer than the terminal is - tall. - -See `doom-cli--restart' for implementation details." - (doom-cli--exit (flatten-list args) doom-cli--context)) - -(defun call! (&rest command) - "A convenience wrapper around `doom-cli-call'. - -Implicitly resolves COMMAND relative to the running CLI, and uses the active -context (so you don't have to pass a context)." - (doom-cli-call (doom-cli-command-normalize - (flatten-list command) - `(:prefix - ,(doom-cli-context-prefix doom-cli--context) - ,@(doom-cli-context-command doom-cli--context))) - doom-cli--context)) - -(defun run! (prefix &rest args) - "Parse and execute ARGS. - -This is the entry point for any shell script that rely on Doom's CLI framework. -It should be called once, at top-level, and never again (use `doom-cli-call' for -nested calls instead). - -PREFIX is the name (string) of the top-level shell script (i.e. $0). All -commands that belong to this shell session should use PREFIX as the first -segment in their command paths. - -ARGS is a list of string arguments to execute. - -See bin/doom's shebang for an example of what state needs to be initialized for -Doom's CLI framework. In a nutshell, Doom is expecting the following environment -variables to be set: - - __DOOMGEOM The dimensions of the current terminal (W . H) - __DOOMPIPE Must contain 0 if script is being piped into, 1 if piping it out - __DOOMGPIPE Like __DOOMPIPE, but is the pipe state of the super process - __DOOMPID A unique ID for this session and its exit script processes - __DOOMSTEP How many layers deep this session has gotten - -The script should also execute ${temporary-file-directory}/doom.sh if Emacs -exits with code 254. This script is auto-generated as needed, to simulate exec -syscalls. See `doom-cli--restart' for technical details. - -Once done, this function kills Emacs gracefully and writes output to log files -(stdout to `doom-cli--output-file', stderr to `doom-cli-debug-file', and any -errors to `doom-cli-error-file')." - (when doom-cli--context - (error "Cannot nest `run!' calls")) - (doom-run-hooks 'doom-after-init-hook) - (doom-context-with 'cli - (let* ((args (flatten-list args)) - (context (make-doom-cli-context :prefix prefix :whole args)) - (doom-cli--context context) - (write-logs-fn (doom-partial #'doom-cli--output-write-logs-h context)) - (show-benchmark-fn (doom-partial #'doom-cli--output-benchmark-h context))) - ;; Clone output to stdout/stderr buffers for logging. - (doom-cli-redirect-output context - (doom-log "run!: %s %s" prefix (combine-and-quote-strings args)) - (add-hook 'kill-emacs-hook show-benchmark-fn 94) - (add-hook 'kill-emacs-hook write-logs-fn 95) - (when (doom-cli-context-pipe-p context :out t) - (setq doom-print-backend nil)) - (when (doom-cli-context-pipe-p context :in) - (with-current-buffer (doom-cli-context-stdin context) - (while (if-let (in (ignore-errors (read-from-minibuffer ""))) - (insert in "\n") - (ignore-errors (delete-char -1)))))) - (doom-cli--exit - (condition-case e - (let* ((args (cons (if (getenv "__DOOMDUMP") :dump prefix) args)) - (context (doom-cli-context-restore (getenv "__DOOMCONTEXT") context)) - (context (doom-cli-context-parse args context))) - (run-hook-with-args 'doom-cli-before-run-functions context) - (let ((result (doom-cli-context-execute context))) - (run-hook-with-args 'doom-cli-after-run-functions context result)) - 0) - (doom-cli-wrong-number-of-arguments-error - (pcase-let ((`(,command ,flag ,args ,min ,max) (cdr e))) - (print! (red "Error: %S expected %s argument%s, but got %d") - (or flag (doom-cli-command-string - (if (keywordp (car command)) - command - (cdr command)))) - (if (or (= min max) - (= max most-positive-fixnum)) - min - (format "%d-%d" min max)) - (if (or (= min 0) (> min 1)) "s" "") - (length args)) - (doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e)) - 5) - (doom-cli-unrecognized-option-error - (print! (red "Error: unknown option %s") (cadr e)) - (doom-cli-call `(:help "--synopsis" "--postamble" ,@(cdr (doom-cli--command context))) context e) - 5) - (doom-cli-invalid-option-error - (pcase-let ((`(,types ,option ,value ,errors) (cdr e))) - (print! (red "Error: %s received invalid value %S") - (string-join (doom-cli-option-switches option) "/") - value) - (print! (bold "\nValidation errors:")) - (dolist (err errors) (print! (item "%s." (fill err))))) - (doom-cli-call `(:help "--postamble" ,@(cdr (doom-cli--command context))) context e) - 5) - (doom-cli-command-not-found-error - (let* ((command (cdr e)) - (cli (doom-cli-get command))) - (cond ((null cli) - (print! (red "Error: unrecognized command '%s'") - (doom-cli-command-string (or (cdr command) command))) - (doom-cli-call `(:help "--similar" "--postamble" ,@(cdr command)) context e)) - ((null (doom-cli-fn cli)) - (print! (red "Error: a subcommand is required")) - (doom-cli-call `(:help "--subcommands" "--postamble" ,@(cdr command)) context e)))) - 4) - (doom-cli-invalid-prefix-error - (let ((prefix (cadr e))) - (print! (red "Error: `run!' called with invalid prefix %S") prefix) - (if-let (suggested (cl-loop for cli being the hash-value of doom-cli--table - unless (doom-cli-type cli) - return (car (doom-cli-command cli)))) - (print! "Did you mean %S?" suggested) - (print! "There are no commands defined under %S." prefix))) - 4) - (user-error - (print! (red "Error: %s") (cadr e)) - (print! "\nAborting...") - 3)) - context))))) - -(defalias 'sh! #'doom-call-process) - -(defalias 'sh!! #'doom-exec-process) - -;; TODO Make `git!' into a more sophisticated wrapper around git -(defalias 'git! (doom-partial #'straight--process-run "git")) - - - -;; -;;; Predefined CLIs - -(load! "cli/meta") ; :help, :version, and :dump + (doom-cli-load-all) + (when (doom-cli-context-error context) + (terpri)) + (let* ((command (cons (doom-cli-context-prefix context) command)) + (cli (doom-cli-get command t)) + (rcli (doom-cli-get cli)) + (fallbackcli (cl-loop with targets = (doom-cli--command-expand (butlast command) t) + for cmd in (cons command targets) + if (doom-cli-get cmd t) + return it))) + (cond (commands? + (let ((cli (or cli (doom-cli-get (doom-cli-context-prefix context))))) + (print! "Commands under '%s':\n%s" + (doom-cli-command-string cli) + (indent (doom-cli-help--render-commands + (or (doom-cli-subcommands cli) + (user-error "No commands found")) + :prefix (doom-cli-command cli) + :inline? t + :docs? t))))) + ((null sections) + (if (null cli) + (signal 'doom-cli-command-not-found-error command) + (doom-cli-help--print cli context manpage? localonly?) + (exit! :pager?))) + ((dolist (section sections) + (unless (equal section (car sections)) (terpri)) + (pcase section + ("--synopsis" + (print! "%s" (doom-cli-help--render-synopsis + (doom-cli-help--synopsis cli) + "Usage: "))) + ("--subcommands" + (print! "%s\n%s" (bold "Available commands:") + (indent (doom-cli-help--render-commands + (doom-cli-subcommands rcli 1) + :prefix command + :grouped? t + :docs? t) + doom-print-indent-increment))) + ("--similar" + (unless command + (user-error "No command specified")) + (let ((similar (doom-cli-help-similar-commands command 0.4))) + (print! "Similar commands:") + (if (not similar) + (print! (indent (warn "Can't find any!"))) + (dolist (command (seq-take similar 10)) + (print! (indent (item "(%d%%) %s")) + (* (car command) 100) + (doom-cli-command-string (cdr command))))))) + ("--envvars" + (let* ((key "ENVIRONMENT VARIABLES") + (clis (if command (doom-cli-find command) (hash-table-values doom-cli--table))) + (clis (seq-remove #'doom-cli-alias clis)) + (clis (seq-filter (fn! (cdr (assoc key (doom-cli-docs %)))) clis)) + (clis (seq-group-by #'doom-cli-command clis))) + (print! "List of environment variables for %s:\n" command) + (if (null clis) + (print! (indent "None!")) + (dolist (group clis) + (print! (bold "%s%s:" + (doom-cli-command-string (car group)) + (if (doom-cli-fn (doom-cli-get (car group))) + "" " *"))) + (dolist (cli (cdr group)) + (print! (indent "%s") (markup (cdr (assoc key (doom-cli-docs cli)))))))))) + ("--postamble" + (print! "See %s for documentation." + (join (cl-loop with spec = + `((?p . ,(doom-cli-context-prefix context)) + (?c . ,(doom-cli-command-string (cdr (doom-cli-command (or cli fallbackcli)))))) + for cmd in doom-help-commands + for formatted = (trim (format-spec cmd spec)) + collect (replace-regexp-in-string + " +" " " (format "'%s'" formatted))) + " or "))))))))) + +(defcli! (:root :version) + ((simple? ("--simple")) + &context context) + "Show installed versions of Doom, Doom modules, and Emacs." + (doom/version) + (unless simple? + (terpri) + (with-temp-buffer + (insert-file-contents (doom-path doom-emacs-dir "LICENSE")) + (re-search-forward "^Copyright (c) ") + (print! "%s\n" (trim (thing-at-point 'line t))) + (print! (p "Doom Emacs uses the MIT license and is provided without warranty " + "of any kind. You may redistribute and modify copies if " + "given proper attribution. See the LICENSE file for details."))))) (provide 'doom-cli) ;;; doom-cli.el ends here From 1ec4bac75e01ddcc896b8c00d8264a3306a9149e Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 14:34:06 -0400 Subject: [PATCH 18/35] bump: :completion abo-abo/swiper@2a25a6fb5b08 -> abo-abo/swiper@8dc02d5b725f company-mode/company-mode@1a0fc12a9c3d -> company-mode/company-mode@e1d331a64ec3 elken/yasnippet-capf@744dedb7837d -> elken/yasnippet-capf@4c2e33d70cd1 emacs-helm/helm@f8949afd9b44 -> emacs-helm/helm@06e0cf01486a minad/cape@f61da109a9e4 -> minad/cape@9110956a5155 minad/consult-flycheck@754f5497d827 -> minad/consult-flycheck@3b999ae98390 minad/consult@fe4852280006 -> minad/consult@0c3f53916ea0 minad/corfu@cdc3e13ad312 -> minad/corfu@921dd7c97ec4 minad/marginalia@da72da4622c7 -> minad/marginalia@50a51c69f006 minad/vertico@ba650a7ab90d -> minad/vertico@c682ef50e622 oantolin/embark@9c166c4b96a0 -> oantolin/embark@19a13e344e04 oantolin/orderless@53f5204ad3f5 -> oantolin/orderless@49d1fdfb80b5 radian-software/prescient.el@0765418e4362 -> radian-software/prescient.el@2b8a8b41228b rainstormstudio/nerd-icons-completion@c2db8557a3c1 -> rainstormstudio/nerd-icons-completion@426a1d7c29a0 Close: #7977 Co-authored-by: LemonBreezes --- modules/completion/company/packages.el | 2 +- modules/completion/corfu/config.el | 39 +++++++++++++------------- modules/completion/corfu/packages.el | 6 ++-- modules/completion/helm/packages.el | 2 +- modules/completion/ivy/packages.el | 4 +-- modules/completion/vertico/packages.el | 16 +++++------ 6 files changed, 34 insertions(+), 35 deletions(-) diff --git a/modules/completion/company/packages.el b/modules/completion/company/packages.el index a0ad69ad0..fe44c0760 100644 --- a/modules/completion/company/packages.el +++ b/modules/completion/company/packages.el @@ -1,7 +1,7 @@ ;; -*- no-byte-compile: t; -*- ;;; completion/company/packages.el -(package! company :pin "1a0fc12a9c3d25e28c22f319e7b097f435b1c27d") +(package! company :pin "e1d331a64ec39fe28c5be28cabf812e3eaab5b0f") (package! company-dict :pin "cd7b8394f6014c57897f65d335d6b2bd65dab1f4") (when (modulep! +childframe) (package! company-box :pin "c4f2e243fba03c11e46b1600b124e036f2be7691")) diff --git a/modules/completion/corfu/config.el b/modules/completion/corfu/config.el index 11cf01504..60592c0a1 100644 --- a/modules/completion/corfu/config.el +++ b/modules/completion/corfu/config.el @@ -34,26 +34,6 @@ TAB/S-TAB.") (use-package! corfu :hook (doom-first-input . global-corfu-mode) - :init - (add-hook! 'minibuffer-setup-hook - (defun +corfu-enable-in-minibuffer () - "Enable Corfu in the minibuffer." - (when (pcase +corfu-want-minibuffer-completion - ('aggressive - (not (or (bound-and-true-p mct--active) - (bound-and-true-p vertico--input) - (and (featurep 'auth-source) - (eq (current-local-map) read-passwd-map)) - (and (featurep 'helm-core) (helm--alive-p)) - (and (featurep 'ido) (ido-active)) - (where-is-internal 'minibuffer-complete - (list (current-local-map))) - (memq #'ivy--queue-exhibit post-command-hook)))) - ('nil nil) - (_ (where-is-internal #'completion-at-point - (list (current-local-map))))) - (setq-local corfu-echo-delay nil) - (corfu-mode +1)))) :config (setq corfu-auto t corfu-auto-delay 0.24 @@ -80,6 +60,25 @@ TAB/S-TAB.") (add-to-list 'corfu-continue-commands #'+corfu/smart-sep-toggle-escape) (add-hook 'evil-insert-state-exit-hook #'corfu-quit) + (defun +corfu-enable-in-minibuffer-p () + "Return non-nil if Corfu should be enabled in the minibuffer. +See `+corfu-want-minibuffer-completion'." + (pcase +corfu-want-minibuffer-completion + ('nil nil) + ('aggressive + (not (or (bound-and-true-p mct--active) + (bound-and-true-p vertico--input) + (and (featurep 'auth-source) + (eq (current-local-map) read-passwd-map)) + (and (featurep 'helm-core) (helm--alive-p)) + (and (featurep 'ido) (ido-active)) + (where-is-internal 'minibuffer-complete + (list (current-local-map))) + (memq #'ivy--queue-exhibit post-command-hook)))) + (_ (where-is-internal #'completion-at-point + (list (current-local-map)))))) + (setq global-corfu-minibuffer #'+corfu-enable-in-minibuffer-p) + ;; HACK: If you want to update the visual hints after completing minibuffer ;; commands with Corfu and exiting, you have to do it manually. (defadvice! +corfu--insert-before-exit-minibuffer-a () diff --git a/modules/completion/corfu/packages.el b/modules/completion/corfu/packages.el index 9bc55ab8f..fe78eb17b 100644 --- a/modules/completion/corfu/packages.el +++ b/modules/completion/corfu/packages.el @@ -1,8 +1,8 @@ ;; -*- no-byte-compile: t; -*- ;;; completion/corfu/packages.el -(package! corfu :pin "cdc3e13ad312f5f12b3f78f842fff0b398eb4473") -(package! cape :pin "f61da109a9e4491614938c300291060fd8855c1b") +(package! corfu :pin "921dd7c97ec41fe8ef81dd5f5a08b0f717586c86") +(package! cape :pin "9110956a5155d5e3c460160fa1b4dac59322c229") (when (modulep! +icons) (package! nerd-icons-corfu :pin "7077bb76fefc15aed967476406a19dc5c2500b3c")) (when (and (not (modulep! :completion vertico)) @@ -14,4 +14,4 @@ (when (modulep! :os tty) (package! corfu-terminal :pin "501548c3d51f926c687e8cd838c5865ec45d03cc")) (when (modulep! :editor snippets) - (package! yasnippet-capf :pin "744dedb7837d0c7e07817d36ec752a0cd813f55c")) + (package! yasnippet-capf :pin "4c2e33d70cd1d95cf1e08d134b058a6dd90a99c9")) diff --git a/modules/completion/helm/packages.el b/modules/completion/helm/packages.el index 86826dea7..5fc216050 100644 --- a/modules/completion/helm/packages.el +++ b/modules/completion/helm/packages.el @@ -1,7 +1,7 @@ ;; -*- no-byte-compile: t; -*- ;;; completion/helm/packages.el -(package! helm :pin "f8949afd9b44de4a8149874ef40e1250826d40bd") +(package! helm :pin "06e0cf01486a430b1f6792af78297837d3d77d97") (package! helm-company :pin "4622b82353220ee6cc33468f710fa5b6b253b7f1") (package! helm-c-yasnippet :pin "c5880e740da101fde7a995e94a7b16c330e57583") (package! helm-descbinds :pin "ca03f02da4e54a1d0a2d5498b86e1639aa808d8c") diff --git a/modules/completion/ivy/packages.el b/modules/completion/ivy/packages.el index 244452ed4..b33d89e33 100644 --- a/modules/completion/ivy/packages.el +++ b/modules/completion/ivy/packages.el @@ -1,7 +1,7 @@ ;; -*- no-byte-compile: t; -*- ;;; completion/ivy/packages.el -(package! swiper :pin "2a25a6fb5b081cb141c5eccac8ee58ab1feeb747") +(package! swiper :pin "8dc02d5b725f78d1f80904807b46f5406f129674") (package! ivy) (package! ivy-hydra) (package! ivy-avy) @@ -13,7 +13,7 @@ (package! wgrep :pin "208b9d01cfffa71037527e3a324684b3ce45ddc4") (if (modulep! +prescient) - (package! ivy-prescient :pin "0765418e4362099db8788fcb745ce9b7602aa001") + (package! ivy-prescient :pin "2b8a8b41228bddb2e11eb1c200e98a9edd04797c") (when (modulep! +fuzzy) (package! flx :pin "4b1346eb9a8a76ee9c9dede69738c63ad97ac5b6"))) diff --git a/modules/completion/vertico/packages.el b/modules/completion/vertico/packages.el index 3f8583b27..0a67a9d6c 100644 --- a/modules/completion/vertico/packages.el +++ b/modules/completion/vertico/packages.el @@ -1,24 +1,24 @@ ;; -*- no-byte-compile: t; -*- ;;; completion/vertico/packages.el -(package! vertico :pin "ba650a7ab90d66686ba787937ac9e71f749c598e") +(package! vertico :pin "c682ef50e62237435e9fc287927ce4181b49be90") -(package! orderless :pin "53f5204ad3f541e11eb6eeb9b86584964b7a3678") +(package! orderless :pin "49d1fdfb80b55699a00b11bc916ad29c0447039b") -(package! consult :pin "fe4852280006e61be7f1374d021ee06155ce5a26") +(package! consult :pin "0c3f53916ea0db0c472c0a0c620a85cc1b00caf2") (package! consult-dir :pin "15891383f34d43acc5bb82bda92239b1f54cf178") (when (and (modulep! :checkers syntax) (not (modulep! :checkers syntax +flymake))) - (package! consult-flycheck :pin "754f5497d827f7d58009256a21af614cc44378a3")) -(package! embark :pin "9c166c4b96a0b1e85401bcc6fb95ce021e7b5013") -(package! embark-consult :pin "9c166c4b96a0b1e85401bcc6fb95ce021e7b5013") + (package! consult-flycheck :pin "3b999ae983900c16c0b5b5c30b7eca640d386a76")) +(package! embark :pin "19a13e344e04bbf861eaa74491b23da52b398672") +(package! embark-consult :pin "19a13e344e04bbf861eaa74491b23da52b398672") -(package! marginalia :pin "da72da4622c7b38741e6968678028f7e0564816c") +(package! marginalia :pin "50a51c69f006ec8b3ba1c570555d279d4cff6d99") (package! wgrep :pin "208b9d01cfffa71037527e3a324684b3ce45ddc4") (when (modulep! +icons) - (package! nerd-icons-completion :pin "c2db8557a3c1a9588d111f8c8e91cae96ee85010")) + (package! nerd-icons-completion :pin "426a1d7c29a04ae8e6ae9b55b0559f11a1e8b420")) (when (modulep! +childframe) (package! vertico-posframe From 63e9b112803b697a67261b3fd17d9401444acf93 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 14:48:36 -0400 Subject: [PATCH 19/35] feat(corfu): introduce +corfu-inhibit-auto-functions --- modules/completion/corfu/config.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/modules/completion/corfu/config.el b/modules/completion/corfu/config.el index 60592c0a1..49c49b814 100644 --- a/modules/completion/corfu/config.el +++ b/modules/completion/corfu/config.el @@ -28,6 +28,11 @@ TAB/S-TAB.") "If non-nil, prefer navigating org tables over cycling candidates with TAB/S-TAB.") +(defvar +corfu-inhibit-auto-functions () + "A list of predicate functions that take no arguments. + +If any return non-nil, `corfu-auto' will not invoke as-you-type completion.") + ;; ;;; Packages @@ -79,6 +84,14 @@ See `+corfu-want-minibuffer-completion'." (list (current-local-map)))))) (setq global-corfu-minibuffer #'+corfu-enable-in-minibuffer-p) + ;; HACK: Augments Corfu to respect `+corfu-inhibit-auto-functions'. + (defadvice! +corfu--post-command-a (fn &rest args) + "Refresh Corfu after last command." + (let ((corfu-auto + (if corfu-auto + (not (run-hook-with-args-until-success '+corfu-inhibit-auto-functions))))) + (apply fn args))) + ;; HACK: If you want to update the visual hints after completing minibuffer ;; commands with Corfu and exiting, you have to do it manually. (defadvice! +corfu--insert-before-exit-minibuffer-a () From fb2f79033c0572863a346e2e94bba608929cfba9 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 14:49:04 -0400 Subject: [PATCH 20/35] fix(corfu): disable corfu-auto in evil replace mode Ref: 63e9b112803b --- modules/completion/corfu/config.el | 4 ++++ 1 file changed, 4 insertions(+) diff --git a/modules/completion/corfu/config.el b/modules/completion/corfu/config.el index 49c49b814..b543393dd 100644 --- a/modules/completion/corfu/config.el +++ b/modules/completion/corfu/config.el @@ -92,6 +92,10 @@ See `+corfu-want-minibuffer-completion'." (not (run-hook-with-args-until-success '+corfu-inhibit-auto-functions))))) (apply fn args))) + (when (modulep! :editor evil) + ;; Modifying the buffer while in replace mode can be janky. + (add-to-list '+corfu-inhibit-auto-functions #'evil-replace-state-p)) + ;; HACK: If you want to update the visual hints after completing minibuffer ;; commands with Corfu and exiting, you have to do it manually. (defadvice! +corfu--insert-before-exit-minibuffer-a () From 76f738462184f6b0dbabe6eb5774ec46d41afcad Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 17:26:51 -0400 Subject: [PATCH 21/35] fix(cli): "void-function: doom-modules-initialize" error This reference to a function that doesn't exist (yet) snuck into 3bced4d. Amend: 3bced4dbbe78 --- lisp/doom-cli-lib.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/lisp/doom-cli-lib.el b/lisp/doom-cli-lib.el index 1ee45a8ab..4cf8e44f5 100644 --- a/lisp/doom-cli-lib.el +++ b/lisp/doom-cli-lib.el @@ -1845,7 +1845,7 @@ errors to `doom-cli-error-file')." (error "Cannot nest `run!' calls")) (doom-run-hooks 'doom-after-init-hook) (doom-context-with 'cli - (doom-modules-initialize) + ;; (doom-modules-initialize) (let* ((args (flatten-list args)) (context (make-doom-cli-context :prefix prefix :whole args)) (doom-cli--context context) From 308444d6128bac88e851c4d6fd86f1f4dce6e2e1 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 16:33:44 -0400 Subject: [PATCH 22/35] fix(literate): detect symlinked literate config files `file-in-directory-p` already resolves symlinks, but on the off chance that `+literate-config-file` points to a symlink living in a non-symlinked directory, this heuristic will fail to realize the current buffer belongs to your config. Close: #6704 --- modules/config/literate/autoload.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/config/literate/autoload.el b/modules/config/literate/autoload.el index 7ea7996b3..294809075 100644 --- a/modules/config/literate/autoload.el +++ b/modules/config/literate/autoload.el @@ -176,7 +176,7 @@ We assume any org file in `doom-user-dir' is connected to your literate config, and should trigger a recompile if changed." (and (file-in-directory-p (buffer-file-name (buffer-base-buffer)) - (file-name-directory +literate-config-file)) + (file-name-directory (file-truename +literate-config-file))) (+literate-tangle-h))) ;;; autoload.el ends here From 682f15117679920d2b4bd45ae4e6bb93c3170397 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 16:47:21 -0400 Subject: [PATCH 23/35] feat(vc): integrate smerge-mode Activates smerge-mode if the file contains merge conflict markers. Also turns binds the localleader to `smerge-mode-map` when it's active. Also removes an unused leader binding (which will never be set because :ui hydra was removed in b08c2c7). Amend: b08c2c745fd2 Close: #5954 --- modules/config/default/+evil-bindings.el | 2 -- modules/emacs/vc/config.el | 14 ++++++++++++++ 2 files changed, 14 insertions(+), 2 deletions(-) diff --git a/modules/config/default/+evil-bindings.el b/modules/config/default/+evil-bindings.el index 3bd46abca..7613a0a2a 100644 --- a/modules/config/default/+evil-bindings.el +++ b/modules/config/default/+evil-bindings.el @@ -510,8 +510,6 @@ :desc "Copy link to remote" "y" #'+vc/browse-at-remote-kill :desc "Copy link to homepage" "Y" #'+vc/browse-at-remote-kill-homepage :desc "Git time machine" "t" #'git-timemachine-toggle - (:when (modulep! :ui hydra) - :desc "SMerge" "m" #'+vc/smerge-hydra/body) (:when (modulep! :ui vc-gutter) :desc "Revert hunk at point" "r" #'+vc-gutter/revert-hunk :desc "stage hunk at point" "s" #'+vc-gutter/stage-hunk diff --git a/modules/emacs/vc/config.el b/modules/emacs/vc/config.el index dd2f47c7c..e8adb46dd 100644 --- a/modules/emacs/vc/config.el +++ b/modules/emacs/vc/config.el @@ -45,6 +45,20 @@ (set-evil-initial-state! 'vc-dir-mode 'emacs)) +(use-package! smerge-mode + :defer t + :init + (add-hook! 'find-file-hook + (defun +vc-init-smerge-mode-h () + (unless (bound-and-true-p smerge-mode) + (save-excursion + (goto-char (point-min)) + (when (re-search-forward "^<<<<<<< " nil t) + (smerge-mode 1)))))) + :config + (define-key smerge-mode-map (kbd doom-localleader-key) smerge-basic-map)) + + (after! git-timemachine ;; Sometimes I forget `git-timemachine' is enabled in a buffer, so instead of ;; showing revision details in the minibuffer, show them in From 0d405329fed6a46b28a9d5d0adebba2ae97e6e56 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 16:57:37 -0400 Subject: [PATCH 24/35] fix(literate): improve error handling while tangling Now emits more informative errors in the case that the user's config.org doesn't exist or contains no src blocks. Fix: #6717 --- modules/config/literate/autoload.el | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/modules/config/literate/autoload.el b/modules/config/literate/autoload.el index 294809075..7e3930b65 100644 --- a/modules/config/literate/autoload.el +++ b/modules/config/literate/autoload.el @@ -41,10 +41,19 @@ (org-confirm-babel-evaluate nil) ;; Say a little more (doom-print-message-level 'info)) - (if-let (files (org-babel-tangle-file target dest)) - (always (print! (success "Done tangling %d file(s)!" (length files)))) - (print! (error "Failed to tangle any blocks from your config.")) - nil)))))) + (cond ((not (file-exists-p target)) + (print! (warn "No org file at %s. Skipping...") (path target)) + nil) + ((with-temp-buffer + (insert-file-contents target) + (let ((case-fold-search t)) + (not (re-search-forward "^ *#\\+begin_src e\\(?:macs-\\)?lisp" nil t)))) + (print! (warn "No src blocks to tangle in %s. Skipping...") (path target)) + nil) + ((if-let (files (org-babel-tangle-file target dest)) + (always (print! (success "Done tangling %d file(s)!" (length files)))) + (print! (error "Failed to tangle any blocks from your config.")) + nil)))))))) (defun +literate-tangle--sync () "Tangles `+literate-config-file' if it has changed." From 295ab7ed3a20ba4619a142be15f5f2ef08d2adcf Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 17:38:33 -0400 Subject: [PATCH 25/35] feat(org): add "doom +org tangle" command Introduces a formal bin/doom command for tangling files, to replace the non-functional bin/org-capture binscript. Close: #6599 Close: #6267 --- bin/org-tangle | 159 ---------------------------------------- modules/lang/org/cli.el | 149 +++++++++++++++++++++++++++++++++++++ 2 files changed, 149 insertions(+), 159 deletions(-) delete mode 100755 bin/org-tangle create mode 100644 modules/lang/org/cli.el diff --git a/bin/org-tangle b/bin/org-tangle deleted file mode 100755 index b662ecbd5..000000000 --- a/bin/org-tangle +++ /dev/null @@ -1,159 +0,0 @@ -#!/usr/bin/env sh -":"; exec emacs --quick --script "$0" -- "$@" # -*- mode: emacs-lisp; lexical-binding: t; -*- -;;; bin/org-tangle - -;; Tangles source blocks from org files. Also expands #+INCLUDE directives, -;; unlike vanilla `ob-tangle'. Debug/info messages are directed to stderr and -;; can be ignored. -;; -;; -l/--lang LANG -;; Only include blocks in the specified language (e.g. emacs-lisp). -;; -a/--all -;; Tangle all blocks by default (unless it has :tangle nil set or a -;; :notangle: tag) -;; -t/--tag TAG -;; --and TAG -;; --or TAG -;; Only include blocks in trees that have these tags. Combine multiple --and -;; and --or's, or just use --tag (implicit --and). -;; -p/--print -;; Prints tangled code to stdout instead of to files -;; -;; Usage: org-tangle [[-l|--lang] LANG] some-file.org another.org -;; Examples: -;; org-tangle -l sh modules/some/module/README.org > install_module.sh -;; org-tangle -l sh modules/lang/go/README.org | sh -;; org-tangle --and tagA --and tagB my/literate/config.org - -(require 'cl-lib) -(require 'ox) -(require 'ob-tangle) - -(defun usage () - (with-temp-buffer - (insert (format "%s %s [OPTIONS] [TARGETS...]\n" - "Usage:" - (file-name-nondirectory load-file-name)) - "\n" - "A command line interface for tangling org-mode files. TARGETS can be\n" - "files or folders (which are searched for org files recursively).\n" - "\n" - "This is useful for literate configs that rely on command line\n" - "workflows to build it.\n" - "\n" - "Example:\n" - " org-tangle some-file.org\n" - " org-tangle literate/config/\n" - " org-tangle -p -l sh scripts.org > do_something.sh\n" - " org-tangle -p -l python -t tagA -t tagB file.org | python\n" - "\n" - "Options:\n" - " -a --all\t\tTangle all blocks by default\n" - " -l --lang LANG\tOnly tangle blocks written in LANG\n" - " -p --print\t\tPrint tangled output to stdout than to files\n" - " -t --tag TAG\n" - " --and TAG\n" - " --or TAG\n" - " Lets you tangle org blocks by tag. You may have more than one\n" - " of these options.\n") - (princ (buffer-string)))) - -(defun *org-babel-tangle (fn &rest args) - "Don't write tangled blocks to files, print them to stdout." - (cl-letf (((symbol-function 'write-region) - (lambda (start end filename &optional append visit lockname mustbenew) - (princ (buffer-string))))) - (apply fn args))) - -(defun *org-babel-tangle-collect-blocks (&optional language tangle-file) - "Like `org-babel-tangle-collect-blocks', but will ignore blocks that are in -trees with the :notangle: tag." - (let ((counter 0) last-heading-pos blocks) - (org-babel-map-src-blocks (buffer-file-name) - (let ((current-heading-pos - (org-with-wide-buffer - (org-with-limited-levels (outline-previous-heading))))) - (if (eq last-heading-pos current-heading-pos) (cl-incf counter) - (setq counter 1) - (setq last-heading-pos current-heading-pos))) - (unless (org-in-commented-heading-p) - (require 'org) - (let* ((tags (org-get-tags-at)) - (info (org-babel-get-src-block-info 'light)) - (src-lang (nth 0 info)) - (src-tfile (cdr (assq :tangle (nth 2 info))))) - (cond ((member "notangle" tags)) - - ((and (or or-tags and-tags) - (or (not and-tags) - (let ((a (cl-intersection and-tags tags :test #'string=)) - (b and-tags)) - (not (or (cl-set-difference a b :test #'equal) - (cl-set-difference b a :test #'equal))))) - (or (not or-tags) - (cl-intersection or-tags tags :test #'string=)) - t)) - - ((or (not (or all-blocks src-tfile)) - (string= src-tfile "no") ; tangle blocks by default - (and tangle-file (not (equal tangle-file src-tfile))) - (and language (not (string= language src-lang))))) - - ;; Add the spec for this block to blocks under its language. - ((let ((by-lang (assoc src-lang blocks)) - (block (org-babel-tangle-single-block counter))) - (if by-lang - (setcdr by-lang (cons block (cdr by-lang))) - (push (cons src-lang (list block)) blocks)))))))) - ;; Ensure blocks are in the correct order. - (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) blocks))) -(advice-add #'org-babel-tangle-collect-blocks - :override #'*org-babel-tangle-collect-blocks) - -(defvar all-blocks nil) -(defvar and-tags nil) -(defvar or-tags nil) -(let (lang srcs and-tags or-tags) - (pop argv) - (while argv - (let ((arg (pop argv))) - (pcase arg - ((or "-h" "--help") - (usage) - (error "")) - ((or "-a" "--all") - (setq all-blocks t)) - ((or "-l" "--lang") - (setq lang (pop argv))) - ((or "-p" "--print") - (advice-add #'org-babel-tangle :around #'*org-babel-tangle)) - ((or "-t" "--tag" "--and") - (push (pop argv) and-tags)) - ("--or" - (push (pop argv) or-tags)) - ((guard (string-match-p "^--lang=" arg)) - (setq lang (cadr (split-string arg "=" t t)))) - ((guard (file-directory-p arg)) - (setq srcs - (append (directory-files-recursively arg "\\.org$") - srcs))) - ((guard (file-exists-p arg)) - (push arg srcs)) - (_ (error "Unknown option or file: %s" arg))))) - - (dolist (file srcs) - (let ((backup (make-temp-file (file-name-base file) nil ".backup.org"))) - (unwind-protect - ;; Prevent slow hooks from interfering - (let (org-mode-hook org-confirm-babel-evaluate) - ;; We do the ol' switcheroo because `org-babel-tangle' writes - ;; changes to the current file, which would be imposing on the user. - (copy-file file backup t) - (with-current-buffer (find-file-noselect file) - ;; Tangling doesn't expand #+INCLUDE directives, so we do it - ;; ourselves, since includes are so useful for literate configs! - (org-export-expand-include-keyword) - (org-babel-tangle nil nil lang))) - (ignore-errors (copy-file backup file t)) - (ignore-errors (delete-file backup))))) - (kill-emacs 0)) diff --git a/modules/lang/org/cli.el b/modules/lang/org/cli.el new file mode 100644 index 000000000..8429eeab6 --- /dev/null +++ b/modules/lang/org/cli.el @@ -0,0 +1,149 @@ +;;; lang/org/cli.el -*- lexical-binding: t; -*- + +(defcli! () () + "Commands to invoke Org's powerful capabilities." + :partial t) + + +(defcli! (tangle) + ((all? ("-a" "--all") "Tangle all src blocks, unconditionally") + (print? ("-p" "--print") "Print the tangled results to stdout (implies -q/--quiet)") + (quiet? ("-q" "--quiet") "Don't log any status messages to stdout") + (lang ("-l" "--lang" lang)) + &multiple + (tags ("-t" "--tag" "--and" "--or" tag) "Target blocks under headers with specific tags") + &args paths) + "Tangle an org file in `PATHS'. + +`PATHS' can be files or folders (which are searched for org files, +recursively). + +EXAMPLES: + %p %c some-file.org + %p %c literate/config/ + %p %c `-p' `-l' sh scripts.org > script.sh + %p %c `-p' `-l' python `-t' tagA `-t' tagB file.org | python" + (unless paths + (user-error "No paths to org files provided.")) + ;; Prefer module's version of org, if available. + ;; TODO: Handle this upstream. + (add-to-list + 'load-path + (cl-find-if #'file-exists-p + (list (doom-path straight-base-dir "straight" straight-build-dir "org") + (doom-path straight-base-dir "straight" "repos" "org")))) + (require 'org) + (require 'ox) + (require 'ob-tangle) + (letf! ((defun org-babel-tangle-collect-blocks (&optional language tangle-file) + "Ignore blocks that are in trees with the :notangle: tag." + (let ((counter 0) last-heading-pos blocks) + (org-babel-map-src-blocks (buffer-file-name) + (let ((current-heading-pos + (if (org-element--cache-active-p) + (or (org-element-property :begin (org-element-lineage (org-element-at-point) '(headline) t)) 1) + (org-with-wide-buffer + (org-with-limited-levels (outline-previous-heading)))))) + (if (eq last-heading-pos current-heading-pos) (cl-incf counter) + (setq counter 1) + (setq last-heading-pos current-heading-pos))) + (unless (or (org-in-commented-heading-p) + (org-in-archived-heading-p)) + (let* ((tags (org-get-tags-at)) + (info (org-babel-get-src-block-info 'no-eval)) + (src-lang (nth 0 info)) + (src-tfile (cdr (assq :tangle (nth 2 info))))) + (cond ((member "notangle" tags)) + + ((let* ((tags (seq-group-by (fn! (equal (car %) "--or")) tags)) + (or-tags (mapcar #'cdr (cdr (assq t tags)))) + (and-tags (mapcar #'cdr (cdr (assq nil tags)))) + (all-tags (append or-tags and-tags))) + (and (or or-tags and-tags) + (or (not and-tags) + (let ((a (cl-intersection and-tags all-tags :test #'string=)) + (b and-tags)) + (not (or (cl-set-difference a b :test #'equal) + (cl-set-difference b a :test #'equal))))) + (or (not or-tags) + (cl-intersection or-tags all-tags :test #'string=)) + t))) + + ((or (not src-tfile) + (string= src-tfile "no") ; tangle blocks by default + (if tangle-file (not (equal tangle-file src-tfile))) + (if language (not (string= language src-lang))))) + + ;; Add the spec for this block to blocks under its language. + ((let* ((block (org-babel-tangle-single-block counter)) + (src-tfile (cdr (assq :tangle (nth 4 block)))) + (file-name (org-babel-effective-tangled-filename + (nth 1 block) src-lang src-tfile)) + (by-fn (assoc file-name blocks))) + (if by-fn + (setcdr by-fn (cons (cons src-lang block) (cdr by-fn))) + (push (cons file-name (list (cons src-lang block))) + blocks)))))))) + ;; Ensure blocks are in the correct order. + (mapcar (lambda (b) (cons (car b) (nreverse (cdr b)))) + (nreverse blocks)))) + (success nil)) + (if print? (setq quiet? t)) + (when (and all? (not quiet?)) + (print! (warn "Tangling all blocks, unconditionally..."))) + (dolist (file (cl-loop for path in (mapcar #'expand-file-name paths) + if (file-directory-p path) + append (doom-files-in path :type 'files :match "\\.org\\'") + else if (file-exists-p path) + collect path + else do (print! (error "Can't find %s. Skipping..." (path path)))) + (or success (exit! 1))) + (unless quiet? + (print! (start "Reading %s...") (path file))) + (let ((backup (make-temp-file (file-name-base file) nil ".backup.org")) + ;; Prevent slow initialization from interfering + (org-startup-indented nil) + (org-startup-folded nil) + (vc-handled-backends nil) + ;; Prevent unwanted entries in recentf, or formatters, or + ;; anything that could be on these hooks, really. Nothing else + ;; should be touching these files (particularly in interactive + ;; sessions). + (write-file-functions nil) + (before-save-hook nil) + (after-save-hook nil) + ;; Prevent infinite recursion due to recompile-on-save hooks + ;; later, and speed up `org-mode' init. + (org-mode-hook nil) + (org-inhibit-startup t) + ;; Allow evaluation of src blocks at tangle-time (would abort + ;; them otherwise). This is a security hazard, but Doom will + ;; trust that you know what you're doing! + (org-confirm-babel-evaluate nil) + ;; Tangle everything by default. + (org-babel-default-header-args (copy-sequence org-babel-default-header-args))) + (when all? + (setf (alist-get :tangle org-babel-default-header-args) "yes")) + (unwind-protect + (progn + ;; Do the ol' switcheroo because `org-babel-tangle' writes changes + ;; to the current file, which would be imposing on the user. + (copy-file file backup t) + (with-current-buffer (delay-mode-hooks (find-file-noselect file)) + ;; Tangling doesn't expand #+INCLUDE directives, so we do it + ;; ourselves, since includes are so useful for literate configs! + (org-export-expand-include-keyword) + (if-let ((results (reverse (org-babel-tangle nil nil lang)))) + (dolist (file results) + (if (not quiet?) + (print-group! + (setq success t) + (print! (success "Tangled to %s") (path file))) + (when print? + (print! "%s" (doom-file-read file)) + (delete-file file)))) + (unless quiet? + (print-group! + (print! (warn "Nothing to tangle from %s") (path file))))))) + (ignore-errors (copy-file backup file t)) + (ignore-errors (delete-file backup))))))) From 70fd17ebfdde0a429e280429652fb23acafba8bb Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 18:25:37 -0400 Subject: [PATCH 26/35] fix(vc): smerge localleader keybinds The keybinding in 682f151 was being overwritten. I'll simply copy the keymap into the module, until I can devise a more elegant solution. Amend: 682f15117679 Ref: #5954 --- modules/emacs/vc/config.el | 20 +++++++++++++++++++- 1 file changed, 19 insertions(+), 1 deletion(-) diff --git a/modules/emacs/vc/config.el b/modules/emacs/vc/config.el index e8adb46dd..5006e19e9 100644 --- a/modules/emacs/vc/config.el +++ b/modules/emacs/vc/config.el @@ -56,7 +56,25 @@ (when (re-search-forward "^<<<<<<< " nil t) (smerge-mode 1)))))) :config - (define-key smerge-mode-map (kbd doom-localleader-key) smerge-basic-map)) + (map! :map smerge-mode-map + :localleader + "n" #'smerge-next + "p" #'smerge-prev + "r" #'smerge-resolve + "a" #'smerge-keep-all + "b" #'smerge-keep-base + "o" #'smerge-keep-lower + "l" #'smerge-keep-lower + "m" #'smerge-keep-upper + "u" #'smerge-keep-upper + "E" #'smerge-ediff + "C" #'smerge-combine-with-next + "R" #'smerge-refine + "C-m" #'smerge-keep-current + (:prefix "=" + "<" #'smerge-diff-base-upper + ">" #'smerge-diff-base-lower + "=" #'smerge-diff-upper-lower))) (after! git-timemachine From 86ee1537860ed4125d3f23d2985f863236820156 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 23:25:51 -0400 Subject: [PATCH 27/35] refactor(default): move +*-bindings.el loaders into config.el No need for the extra indirection. --- modules/config/default/+emacs.el | 26 ------------------------ modules/config/default/+evil.el | 21 -------------------- modules/config/default/config.el | 34 +++++++++++++++++++++++++++++--- 3 files changed, 31 insertions(+), 50 deletions(-) delete mode 100644 modules/config/default/+emacs.el delete mode 100644 modules/config/default/+evil.el diff --git a/modules/config/default/+emacs.el b/modules/config/default/+emacs.el deleted file mode 100644 index a68711bb2..000000000 --- a/modules/config/default/+emacs.el +++ /dev/null @@ -1,26 +0,0 @@ -;;; config/default/+emacs.el -*- lexical-binding: t; -*- - -(require 'projectile) ; we need its keybinds immediately - - -;; -;;; Reasonable defaults - -(setq shift-select-mode t) -(delete-selection-mode +1) - -(use-package! expand-region - :commands (er/contract-region er/mark-symbol er/mark-word) - :config - (defadvice! doom--quit-expand-region-a (&rest _) - "Properly abort an expand-region region." - :before '(evil-escape doom/escape) - (when (memq last-command '(er/expand-region er/contract-region)) - (er/contract-region 0)))) - - -;; -;;; Keybinds - -(when (modulep! +bindings) - (load! "+emacs-bindings")) diff --git a/modules/config/default/+evil.el b/modules/config/default/+evil.el deleted file mode 100644 index a5ddc3099..000000000 --- a/modules/config/default/+evil.el +++ /dev/null @@ -1,21 +0,0 @@ -;;; config/default/+evil.el -*- lexical-binding: t; -*- - -(defun +default-disable-delete-selection-mode-h () - (delete-selection-mode -1)) -(add-hook 'evil-insert-state-entry-hook #'delete-selection-mode) -(add-hook 'evil-insert-state-exit-hook #'+default-disable-delete-selection-mode-h) - - -;; -;;; Keybindings - -;; This section is dedicated to "fixing" certain keys so that they behave -;; sensibly (and consistently with similar contexts). - -;; Make SPC u SPC u [...] possible (#747) -(map! :map universal-argument-map - :prefix doom-leader-key "u" #'universal-argument-more - :prefix doom-leader-alt-key "u" #'universal-argument-more) - -(when (modulep! +bindings) - (load! "+evil-bindings")) diff --git a/modules/config/default/config.el b/modules/config/default/config.el index 850ef4f45..a3368b0cd 100644 --- a/modules/config/default/config.el +++ b/modules/config/default/config.el @@ -565,6 +565,34 @@ Continues comments if executed from a commented line." ;; ;;; Bootstrap configs -(if (featurep 'evil) - (load! "+evil") - (load! "+emacs")) +(cond + ((modulep! :editor evil) + (defun +default-disable-delete-selection-mode-h () + (delete-selection-mode -1)) + (add-hook 'evil-insert-state-entry-hook #'delete-selection-mode) + (add-hook 'evil-insert-state-exit-hook #'+default-disable-delete-selection-mode-h) + + ;; Make SPC u SPC u [...] possible (#747) + (map! :map universal-argument-map + :prefix doom-leader-key "u" #'universal-argument-more + :prefix doom-leader-alt-key "u" #'universal-argument-more) + + (when (modulep! +bindings) + (load! "+evil-bindings"))) + + (t + (add-hook 'doom-first-buffer-hook #'delete-selection-mode) + (setq shift-select-mode t) + + (use-package! expand-region + :commands (er/contract-region er/mark-symbol er/mark-word) + :config + (defadvice! doom--quit-expand-region-a (&rest _) + "Properly abort an expand-region region." + :before '(evil-escape doom/escape) + (when (memq last-command '(er/expand-region er/contract-region)) + (er/contract-region 0)))) + + (when (modulep! +bindings) + (require 'projectile nil t) ; we need its keybinds immediately + (load! "+emacs-bindings")))) From 816db4a62addf7ac5e658123ba081069d224d310 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Sun, 1 Sep 2024 23:28:02 -0400 Subject: [PATCH 28/35] refactor!(default): drag-stuff: make non-evil only BREAKING CHANGE: This makes the drag-stuff package and its keybinds only available to non-evil users. This was done because the package doesn't bring much value for evil users, where text-objects are more powerful. Plus, drag-stuff doesn't interact well with visual block or line modes in evil, rendering drag-stuff-{left,right} not useful enough to warrant keeping. --- modules/config/default/config.el | 8 ++++++++ modules/config/default/packages.el | 2 +- 2 files changed, 9 insertions(+), 1 deletion(-) diff --git a/modules/config/default/config.el b/modules/config/default/config.el index a3368b0cd..5873b54a9 100644 --- a/modules/config/default/config.el +++ b/modules/config/default/config.el @@ -584,6 +584,14 @@ Continues comments if executed from a commented line." (add-hook 'doom-first-buffer-hook #'delete-selection-mode) (setq shift-select-mode t) + (use-package! drag-stuff + :defer t + :init + (map! "" #'drag-stuff-up + "" #'drag-stuff-down + "" #'drag-stuff-left + "" #'drag-stuff-right)) + (use-package! expand-region :commands (er/contract-region er/mark-symbol er/mark-word) :config diff --git a/modules/config/default/packages.el b/modules/config/default/packages.el index 99bdda060..063ebc83a 100644 --- a/modules/config/default/packages.el +++ b/modules/config/default/packages.el @@ -2,8 +2,8 @@ ;;; config/default/packages.el (package! avy :pin "be612110cb116a38b8603df367942e2bb3d9bdbe") -(package! drag-stuff :pin "6d06d846cd37c052d79acd0f372c13006aa7e7c8") (package! link-hint :pin "9153eafc776549376bb85d9ff555fef83aca8285") (unless (modulep! :editor evil) + (package! drag-stuff :pin "6d06d846cd37c052d79acd0f372c13006aa7e7c8") (package! expand-region :pin "e8f4e0fe9c9a80a6a26e2b438502aba9a799d580")) From 8f60a1bc46b3b1ef7987aa85764f35ee2249721d Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Mon, 2 Sep 2024 00:37:55 -0400 Subject: [PATCH 29/35] fix(python): type error on loading conda.el When conda.el evaluates `conda-anaconda-home's initial value, and none of `conda-home-candidates` exist on the user's system, `nil` will be passed to `expand-file-name`, which requires a string argument, thus throwing a type error, so we've got to set `conda-anaconda-home` to nil to prevent it, then reinvent the wheel later. This should be resolved upstream, but conda.el hasn't been updated in some time... Fix: #7283 --- modules/lang/python/config.el | 35 +++++++++++++++++++++-------------- 1 file changed, 21 insertions(+), 14 deletions(-) diff --git a/modules/lang/python/config.el b/modules/lang/python/config.el index a44b56011..b307f72bd 100644 --- a/modules/lang/python/config.el +++ b/modules/lang/python/config.el @@ -259,6 +259,26 @@ (use-package! conda :when (modulep! +conda) :after python + :preface + ;; HACK: `conda-anaconda-home's initialization can throw an error if none of + ;; `conda-home-candidates' exist, so unset it early. + ;; REVIEW: Fix this upstream. + (setq conda-anaconda-home nil + conda-home-candidates + (list "~/.anaconda" + "~/.anaconda3" + "~/.miniconda" + "~/.miniconda3" + "~/.miniforge3" + "~/anaconda3" + "~/miniconda3" + "~/miniforge3" + "~/opt/miniconda3" + "/usr/bin/anaconda3" + "/usr/local/anaconda3" + "/usr/local/miniconda3" + "/usr/local/Caskroom/miniconda/base" + "~/.conda")) :config ;; The location of your anaconda home will be guessed from a list of common ;; possibilities, starting with `conda-anaconda-home''s default value (which @@ -267,20 +287,7 @@ ;; If none of these work for you, `conda-anaconda-home' must be set ;; explicitly. Afterwards, run M-x `conda-env-activate' to switch between ;; environments - (or (cl-loop for dir in (list conda-anaconda-home - "~/.anaconda" - "~/.miniconda" - "~/.miniconda3" - "~/.miniforge3" - "~/anaconda3" - "~/miniconda3" - "~/miniforge3" - "~/opt/miniconda3" - "/usr/bin/anaconda3" - "/usr/local/anaconda3" - "/usr/local/miniconda3" - "/usr/local/Caskroom/miniconda/base" - "~/.conda") + (or (cl-loop for dir in (cons conda-anaconda-home conda-home-candidates) if (file-directory-p dir) return (setq conda-anaconda-home (expand-file-name dir) conda-env-home-directory (expand-file-name dir))) From d6bc2b0f19e51fa57e57c38f622b8c91fdddf0c0 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Mon, 2 Sep 2024 01:10:58 -0400 Subject: [PATCH 30/35] fix(python): respect $ANACONDA_HOME Amend: 8f60a1bc46b3 --- modules/lang/python/config.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/modules/lang/python/config.el b/modules/lang/python/config.el index b307f72bd..3fbc0345c 100644 --- a/modules/lang/python/config.el +++ b/modules/lang/python/config.el @@ -263,7 +263,7 @@ ;; HACK: `conda-anaconda-home's initialization can throw an error if none of ;; `conda-home-candidates' exist, so unset it early. ;; REVIEW: Fix this upstream. - (setq conda-anaconda-home nil + (setq conda-anaconda-home (getenv "ANACONDA_HOME") conda-home-candidates (list "~/.anaconda" "~/.anaconda3" From f81798eb0a55cee1ef70ef0280813aa2c055bccf Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Mon, 2 Sep 2024 06:25:10 -0400 Subject: [PATCH 31/35] module: undeprecate :editor god The god-mode package is maintained now. Amend: 9ada400805e2 --- modules/editor/god/README.org | 4 ---- 1 file changed, 4 deletions(-) diff --git a/modules/editor/god/README.org b/modules/editor/god/README.org index 38bc0f7de..4104be739 100644 --- a/modules/editor/god/README.org +++ b/modules/editor/god/README.org @@ -3,10 +3,6 @@ #+created: October 13, 2021 #+since: 21.12.0 -#+begin_quote -  *This module is deprecated.* ~god-mode~ is EOL and no longer maintained. -#+end_quote - * Description :unfold: Adds [[doom-package:god-mode]] support to Doom Emacs, allowing for entering commands without modifier keys, similar to Vim's modality, separating command mode and insert From 84230a437dfca913ba94c39f7a61c41d24a7cfbd Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Mon, 2 Sep 2024 16:59:29 -0400 Subject: [PATCH 32/35] fix(corfu): `global-corfu-minibuffer` predicate not respected As mentioned in #7977, `global-corfu-modes` overrides any predicate function in `global-corfu-minibuffer`. This is a stopgap until the issue is resolved upstream. Fix: #7977 Close: #8039 Co-authored-by: LemonBreezes --- modules/completion/corfu/config.el | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/modules/completion/corfu/config.el b/modules/completion/corfu/config.el index b543393dd..df9a0a48d 100644 --- a/modules/completion/corfu/config.el +++ b/modules/completion/corfu/config.el @@ -43,12 +43,17 @@ If any return non-nil, `corfu-auto' will not invoke as-you-type completion.") (setq corfu-auto t corfu-auto-delay 0.24 corfu-auto-prefix 2 - global-corfu-modes '((not erc-mode - circe-mode - help-mode - gud-mode - vterm-mode) - t) + global-corfu-modes + '((not erc-mode + circe-mode + help-mode + gud-mode + vterm-mode + ;; Needed for `+corfu-want-minibuffer-completion' to be + ;; respected. See #7977. + minibuffer-mode + minibuffer-inactive-mode) + t) corfu-cycle t corfu-preselect 'prompt corfu-count 16 From 8083d398c5bff2759b651cfa020a684492c42e4f Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Tue, 3 Sep 2024 00:46:35 -0400 Subject: [PATCH 33/35] refactor(tabs): remove unused variable Hasn't been needed since 4f4718e. Amend: 4f4718e6d151 --- modules/ui/tabs/config.el | 6 ------ 1 file changed, 6 deletions(-) diff --git a/modules/ui/tabs/config.el b/modules/ui/tabs/config.el index 8f4bf68f8..b4d2b9124 100644 --- a/modules/ui/tabs/config.el +++ b/modules/ui/tabs/config.el @@ -1,11 +1,5 @@ ;;; ui/tabs/config.el -*- lexical-binding: t; -*- -(defcustom +tabs-buffer-update-groups-delay 0.1 - "Minimum wait time (in seconds) before tab groups are recalculated." - :type 'float - :group 'doom) - - ;; ;;; Packages From 5c7f6f5c41bc2a2fa0cf8c7f55ccfe8041f90d80 Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Tue, 3 Sep 2024 03:55:34 -0400 Subject: [PATCH 34/35] fix(cli): don't native-comp site-files without --aot Amend: e3fdfee1c54b Ref: #6811 --- lisp/cli/packages.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/lisp/cli/packages.el b/lisp/cli/packages.el index bf113d5a2..eb0f57889 100644 --- a/lisp/cli/packages.el +++ b/lisp/cli/packages.el @@ -352,7 +352,8 @@ list remains lean." (error (signal 'doom-package-error (list package e))))))) (progn - (when (featurep 'native-compile) + (when (and (featurep 'native-compile) + straight--native-comp-available) (doom-packages--compile-site-files) (doom-packages--wait-for-native-compile-jobs) (doom-packages--write-missing-eln-errors)) From 559e5b6a966fa82bf8322f89d78a00ef4181812a Mon Sep 17 00:00:00 2001 From: Henrik Lissner Date: Tue, 3 Sep 2024 04:01:37 -0400 Subject: [PATCH 35/35] docs(cli): doom gc: corrections To reflect changes made to this command when it was renamed 'doom gc' (from 'doom purge'). --- lisp/cli/packages.el | 11 +++++------ 1 file changed, 5 insertions(+), 6 deletions(-) diff --git a/lisp/cli/packages.el b/lisp/cli/packages.el index eb0f57889..70b19ece4 100644 --- a/lisp/cli/packages.el +++ b/lisp/cli/packages.el @@ -23,16 +23,15 @@ (noelpa-p ("-p" "--no-elpa") "Don't purge ELPA packages") (norepos-p ("-r" "--no-repos") "Don't purge unused straight repos") (noeln-p ("-e" "--no-eln") "Don't purge old ELN bytecode") - (noregraft-p ("-g" "--no-regraft") "Regraft git repos (ie. compact them)")) + (noregraft-p ("-g" "--no-regraft") "Don't regraft git repos (ie. compact them)")) "Deletes orphaned packages & repos, and compacts them. Purges all installed ELPA packages (as they are considered temporary). Purges -all orphaned package repos and builds. If -g/--regraft is supplied, the git -repos among them will be regrafted and compacted to ensure they are as small as -possible. +all orphaned package repos and builds. Also regrafts and compacts package repos +to ensure they are as small as possible. -It is a good idea to occasionally run this doom purge -g to ensure your package -list remains lean." +It is a good idea to occasionally run this command to ensure your package list +remains lean." :benchmark t (require 'comp nil t) (doom-initialize-core-packages)