diff options
Diffstat (limited to 'modules/system-lib.el')
| -rw-r--r-- | modules/system-lib.el | 71 |
1 files changed, 60 insertions, 11 deletions
diff --git a/modules/system-lib.el b/modules/system-lib.el index f1049c02..c6021c9c 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -8,7 +8,8 @@ ;; Eager reason: low-level helpers (executable lookup, process output, silent ;; logging) used by many eager modules during startup. ;; Top-level side effects: none. -;; Runtime requires: none (auth-source loaded on demand inside the helper). +;; Runtime requires: none at load (auth-source is required on demand inside +;; `cj/auth-source-secret-value', so the cost lands only on callers that use it). ;; Direct test load: yes (pure helpers; batch-safe). ;; ;; This module provides low-level system utility functions for checking @@ -125,21 +126,51 @@ This does so without echoing in the minibuffer." With USER, also match on the login. Resolves a function-valued secret \(the netrc backend returns the secret as a function\) by calling it. Callers that must have a secret layer their own error on top." + ;; Loaded here rather than at the top of the file, so a module that merely + ;; requires system-lib does not pay for auth-source. It has to be loaded + ;; *somewhere*, though: `declare-function' only quiets the byte-compiler. + ;; An interactive Emacs always has auth-source in by the time anyone calls + ;; here, which hid the omission until a batch `-Q' sync tried to resolve a + ;; `:secret-host' feed and died on a void `auth-source-search'. + ;; + ;; Guarded on `fboundp' rather than calling `require' unconditionally: a + ;; bare require re-loads auth-source.el over whatever is already in place, + ;; which replaces a caller's stubbed `auth-source-search' mid-call and sends + ;; a test that meant to fake the lookup out to the real authinfo instead. + (unless (fboundp 'auth-source-search) + (require 'auth-source)) (let* ((spec (append (list :host host :require '(:secret) :max 1) (when user (list :user user)))) (secret (plist-get (car (apply #'auth-source-search spec)) :secret))) (if (functionp secret) (funcall secret) secret))) -;; ---------------------------- Strong Confirmation ---------------------------- +;; -------------------------- Destructive Confirmation ------------------------- -(defun cj/confirm-strong (prompt) - "Ask PROMPT, requiring a full typed \"yes\" or \"no\" answer. -For irreversible actions -- file destruction, overwrites, power-off. The -global default makes `yes-or-no-p' a single keystroke (`use-short-answers' -is t); this binds it to nil for the one call so the prompt demands the -long-form answer, keeping a stray RET or space from confirming." - (let ((use-short-answers nil)) - (yes-or-no-p prompt))) +(defun cj/confirm-destructive (prompt) + "Ask PROMPT for an irreversible action. Return non-nil for yes. + +One keystroke, y or n. Nothing else answers: a stray RET or space +re-prompts rather than confirming, so the accidental-confirm protection +survives without the answer costing four keystrokes. + +Pending input is discarded first, and that line is load-bearing. +`read-char-choice' reads from the input queue, so without it a keystroke +typed before the prompt appeared would confirm a shutdown or a file +deletion instantly. The typed-\"yes\" form this replaced absorbed such a +key harmlessly, and dropping the guard without replacing it would have +traded a rare annoyance for a rare catastrophe. + +This used to demand a typed \"yes\", and that was a worse trade than it +looked. On 2026-07-31 one such prompt went unanswered -- a second agent +session held the selected window while the prompt waited in another frame, +so keystrokes went to a terminal instead of the minibuffer, and the session +was killed with buffers unsaved. A single keystroke does not make a prompt +reachable when focus is elsewhere; C-g is still the escape either way. What +it changes is the cost of the situation, and losing unsaved buffers is a far +bigger hazard than a mis-keyed confirm." + (discard-input) + (eq ?y (downcase (read-char-choice (concat prompt "(y or n) ") + '(?y ?Y ?n ?N))))) (defun cj/--font-lock-global-modes-excluding (current mode) "Return CURRENT `font-lock-global-modes' with MODE added to the exclusion. @@ -164,6 +195,22 @@ contributes its own modes regardless of load order." (setq font-lock-global-modes (cj/--font-lock-global-modes-excluding font-lock-global-modes mode)))) +;; Declared special here for the compiler; marginalia owns the defvar. +(defvar marginalia-annotator-registry) + +(defun cj/completion-ensure-marginalia-align (category) + "Register CATEGORY with marginalia as builtin-annotated, once. +A custom completion category bypasses marginalia entirely, so the table's +own annotation function renders unaligned even with `marginalia-align' +set. A builtin registry entry tells marginalia to use the table's +annotation function inside its aligned field, so custom annotations line +up like every stock category. A category that already has an entry is +left alone (someone chose its annotators deliberately). Silent no-op +when marginalia isn't loaded." + (when (and (boundp 'marginalia-annotator-registry) + (not (assq category marginalia-annotator-registry))) + (push (list category 'builtin 'none) marginalia-annotator-registry))) + (defun cj/completion-table (category collection) "Return a completion table over COLLECTION tagged with completion CATEGORY. COLLECTION is anything `completing-read' accepts (list, alist, obarray, hash @@ -180,7 +227,9 @@ the candidates match one; marginalia then annotates them with no further work." "Like `cj/completion-table' but also attach ANNOTATE as the annotation function. ANNOTATE is called with a candidate string and returns its annotation suffix, or nil. Use this for a custom CATEGORY that marginalia has no built-in annotator -for: marginalia falls back to the table's own annotation function." +for; the category is registered with marginalia (builtin) so ANNOTATE's output +renders right-aligned like stock annotations." + (cj/completion-ensure-marginalia-align category) (lambda (string predicate action) (if (eq action 'metadata) `(metadata (category . ,category) |