diff options
Diffstat (limited to 'modules')
106 files changed, 5483 insertions, 5266 deletions
diff --git a/modules/ai-config.el b/modules/ai-config.el deleted file mode 100644 index e439ab5c9..000000000 --- a/modules/ai-config.el +++ /dev/null @@ -1,567 +0,0 @@ -;;; ai-config.el --- Configuration for AI Integrations -*- lexical-binding: t; coding: utf-8; -*- -;; author Craig Jennings <c@cjennings.net> -;; -;;; Commentary: -;; -;; Layer: 3 (Domain Workflow). -;; Category: D/P. -;; Load shape: eager. -;; Eager reason: registers the cj/ai-keymap (C-; a); GPTel itself should load on -;; command, a Phase 5 deferral candidate. -;; Top-level side effects: defines cj/ai-keymap, registers it under cj/custom-keymap. -;; Runtime requires: keybindings, system-lib. -;; Direct test load: yes (requires keybindings explicitly). -;; -;; Configuration for AI integrations in Emacs, focused on GPTel. -;; -;; Main Features: -;; - Quick toggle for AI assistant window (C-; a t) -;; - Custom keymap (C-; a prefix) for AI-related commands. -;; - Enhanced org-mode conversation formatting with timestamps -;; allows switching models and easily compare and track responses. -;; - Various specialized AI directives (coder, reviewer, etc.) -;; - Context management for adding files/buffers to conversations -;; - Conversation persistence with save/load functionality -;; - Integration with Magit for code review -;; -;; Basic Workflow -;; -;; Using a side-chat window: -;; - Launch GPTel via C-; a t, and chat in the AI-Assistant side window (C-<return> to send) -;; - Change system prompt (expertise, personalities) with C-; a p -;; - Add context from files (C-; a f) or current buffer (C-; a .) -;; - Save conversations with C-; a s, load previous ones with C-; a l -;; - Clear the conversation and start over with C-; a x -;; Or in any buffer: -;; - Add directive as above, and select a region to rewrite with C-; a r. -;; - -;;; Code: - -(require 'keybindings) ;; provides cj/custom-keymap -(require 'system-lib) ;; provides cj/auth-source-secret-value -(require 'cj-window-toggle-lib) ;; side-window size memory for the panel - -(autoload 'cj/gptel-save-conversation "ai-conversations" "Save the AI conversation to a file." t) -(autoload 'cj/gptel-load-conversation "ai-conversations" "Load a saved AI conversation." t) -(autoload 'cj/gptel-delete-conversation "ai-conversations" "Delete a saved AI conversation." t) -(autoload 'cj/gptel-autosave-toggle "ai-conversations" "Toggle autosave in the current GPTel buffer." t) -(autoload 'cj/gptel-quick-ask "ai-quick-ask" "One-shot quick-ask in a transient buffer." t) -(autoload 'cj/gptel-rewrite-with-directive "ai-rewrite" "Pick a directive and run gptel-rewrite on the region." t) -(autoload 'cj/gptel-rewrite-redo-with-different-directive "ai-rewrite" "Re-run the previous rewrite with a different directive." t) -(autoload 'cj/gptel-browse-conversations "ai-conversations-browser" "Browse saved GPTel conversations." t) - -;;; ------------------------- AI Config Helper Functions ------------------------ - -;; Define variables upfront -(defvar cj/anthropic-api-key-cached nil "Cached Anthropic API key.") -(defvar cj/openai-api-key-cached nil "Cached OpenAI API key.") -(defvar gptel-claude-backend nil "Claude backend, lazy-initialized.") -(defvar gptel-chatgpt-backend nil "ChatGPT backend, lazy-initialized.") - -(defcustom cj/gptel-tools-directory - (expand-file-name "gptel-tools/" user-emacs-directory) - "Directory containing optional local GPTel tool modules." - :type 'directory - :group 'cj) - -(defcustom cj/gptel-local-tool-features - '(read_buffer - read_text_file - write_text_file - update_text_file - list_directory_files - move_to_trash - git_status - git_log - git_diff - web_fetch) - "Feature symbols for optional local GPTel tool modules." - :type '(repeat symbol) - :group 'cj) - -(defun cj/gptel-load-local-tools - (&optional tools-directory tool-features) - "Load optional GPTel tools from TOOLS-DIRECTORY. -TOOL-FEATURES defaults to `cj/gptel-local-tool-features'. Return a list -of loaded feature symbols. Missing directories or individual optional -tools are reported with `message' and do not signal." - (let ((dir (file-name-as-directory - (expand-file-name (or tools-directory cj/gptel-tools-directory)))) - (features (or tool-features cj/gptel-local-tool-features)) - (loaded nil)) - (cond - ((not (file-directory-p dir)) - (message "GPTel tools directory not found: %s" dir) - nil) - (t - (add-to-list 'load-path dir) - (dolist (feature features) - (condition-case err - (if (require feature nil 'noerror) - (push feature loaded) - (message "Optional GPTel tool not found: %s" feature)) - (error - (message "Failed to load GPTel tool %s: %s" - feature - (error-message-string err))))) - (nreverse loaded))))) - -(with-eval-after-load 'gptel - (require 'ai-conversations) - (cj/gptel-load-local-tools)) - -(defun cj/auth-source-secret (host user) - "Fetch a required secret from auth-source for HOST and USER. - -HOST and USER must be strings that identify the credential to return. -Errors when no secret is found." - (or (cj/auth-source-secret-value host user) - (error "No usable secret found for host %s and user %s" host user))) - -(defun cj/anthropic-api-key () - "Return the Anthropic API key, caching the result after first retrieval." - (or cj/anthropic-api-key-cached - (setq cj/anthropic-api-key-cached - (cj/auth-source-secret "api.anthropic.com" "apikey")))) - -(defun cj/openai-api-key () - "Return the OpenAI API key, caching the result after first retrieval." - (or cj/openai-api-key-cached - (setq cj/openai-api-key-cached - (cj/auth-source-secret "api.openai.com" "apikey")))) - -(defun cj/--gptel-load-backend-libs () - "Require the gptel backend libraries so their `gptel-make-*' constructors exist. -The local fork (`:load-path \"~/code/gptel\"', `:ensure nil') ships no generated -autoloads, so requiring `gptel' alone never loads `gptel-anthropic' / -`gptel-openai', where the constructors are defined." - (require 'gptel-anthropic) - (require 'gptel-openai)) - -(defun cj/ensure-gptel-backends () - "Initialize GPTel backends if they are not already available. -Loads the backend libraries first so the `gptel-make-*' constructors are -defined even when gptel is the local fork without generated autoloads." - (cj/--gptel-load-backend-libs) - (unless gptel-claude-backend - (setq gptel-claude-backend - (gptel-make-anthropic - "Claude" - :key (cj/anthropic-api-key) - :models '( - "claude-opus-4-7" - "claude-sonnet-4-6" - "claude-haiku-4-5-20251001" - ) - :stream t))) - (unless gptel-chatgpt-backend - (setq gptel-chatgpt-backend - (gptel-make-openai - "ChatGPT" - :key (cj/openai-api-key) - :models '( - "gpt-5.5" - "gpt-5.4-mini" - "o3" - ) - :stream t))) - ;; Set default backend and model - (unless gptel-backend - (setq gptel-backend (or gptel-chatgpt-backend gptel-claude-backend)) - (setq gptel-model 'gpt-5.5))) - -;; ------------------ GPTel Conversation And Utility Commands ------------------ - -(defun cj/gptel--available-backends () - "Return an alist of (NAME . BACKEND). -Ensures gptel and backends are initialized." - (unless (featurep 'gptel) - (require 'gptel)) - (cj/ensure-gptel-backends) - (delq nil - (list (and (bound-and-true-p gptel-claude-backend) - (cons "Anthropic - Claude" gptel-claude-backend)) - (and (bound-and-true-p gptel-chatgpt-backend) - (cons "OpenAI - ChatGPT" gptel-chatgpt-backend))))) - -(defun cj/gptel--model-to-string (m) - "Return model M as a string regardless of its type." - (cond - ((stringp m) m) - ((symbolp m) (symbol-name m)) - (t (format "%s" m)))) - -;; Backend/model switching helpers (pure logic, extracted for testability) - -(defun cj/gptel--build-model-list (backends model-fn) - "Build a flat list of all models across BACKENDS. -BACKENDS is an alist of (NAME . BACKEND-OBJECT). MODEL-FN is called -with each backend object and should return a list of model identifiers. -Returns a list of entries: (DISPLAY-STRING BACKEND MODEL-STRING BACKEND-NAME) -where DISPLAY-STRING is \"Backend: model\" for use in completing-read." - (mapcan - (lambda (pair) - (let* ((backend-name (car pair)) - (backend (cdr pair)) - (models (funcall model-fn backend))) - (mapcar (lambda (m) - (list (format "%s: %s" backend-name (cj/gptel--model-to-string m)) - backend - (cj/gptel--model-to-string m) - backend-name)) - models))) - backends)) - -(defun cj/gptel--current-model-selection (backends current-backend current-model) - "Format the current backend/model as a display string. -BACKENDS is the alist from `cj/gptel--available-backends'. -CURRENT-BACKEND and CURRENT-MODEL are the active gptel settings. -Returns a string like \"Anthropic - Claude: claude-opus-4-7\"." - (let ((backend-name (car (rassoc current-backend backends)))) - (format "%s: %s" - (or backend-name "AI") - (cj/gptel--model-to-string current-model)))) - -;; Backend/model switching commands -(defun cj/gptel-change-model () - "Change the GPTel backend and select a model from that backend. -Present all available models from every backend, switching backends when -necessary. Prompt for whether to apply the selection globally or buffer-locally." - (interactive) - (let* ((backends (cj/gptel--available-backends)) - (all-models (cj/gptel--build-model-list - backends - (lambda (b) - (when (fboundp 'gptel-backend-models) - (gptel-backend-models b))))) - (current-selection (cj/gptel--current-model-selection - backends - (bound-and-true-p gptel-backend) - (bound-and-true-p gptel-model))) - (scope (completing-read "Set model for: " '("buffer" "global") nil t)) - (selected (completing-read - (format "Select model (current: %s): " current-selection) - (mapcar #'car all-models) nil t nil nil current-selection))) - (let* ((model-info (assoc selected all-models)) - (backend (nth 1 model-info)) - (model (intern (nth 2 model-info))) - (backend-name (nth 3 model-info))) - (if (string= scope "global") - (progn - (setq gptel-backend backend) - (setq gptel-model model) - (message "Changed to %s model: %s (global)" backend-name model)) - (setq-local gptel-backend backend) - (setq-local gptel-model (if (stringp model) (intern model) model)) - (message "Changed to %s model: %s (buffer-local)" backend-name model))))) - -(defun cj/gptel-switch-backend () - "Switch the GPTel backend and then choose one of its models." - (interactive) - (let* ((backends (cj/gptel--available-backends)) - (choice (completing-read "Select GPTel backend: " (mapcar #'car backends) nil t)) - (backend (cdr (assoc choice backends)))) - (unless backend - (user-error "Invalid GPTel backend: %s" choice)) - (let* ((models (when (fboundp 'gptel-backend-models) - (gptel-backend-models backend))) - (model (completing-read (format "Select %s model: " choice) - (mapcar #'cj/gptel--model-to-string models) - nil t nil nil (cj/gptel--model-to-string (bound-and-true-p gptel-model))))) - (setq gptel-backend backend - gptel-model model) - (message "Switched to %s with model: %s" choice model)))) - -;; Clear assistant buffer (moved out so it's always available) -(defun cj/gptel-clear-buffer () - "Erase the current GPTel buffer while preserving the initial Org heading. -Operate only when `gptel-mode' is active in an Org buffer so the heading -can be reinserted." - (interactive) - (let ((is-gptel (bound-and-true-p gptel-mode)) - (is-org (derived-mode-p 'org-mode))) - (if (and is-gptel is-org) - (progn - (erase-buffer) - (when (fboundp 'cj/gptel--fresh-org-prefix) - (insert (cj/gptel--fresh-org-prefix))) - (message "GPTel buffer cleared and heading reset")) - (message "Not a GPTel buffer in org-mode. Nothing cleared.")))) - -;; ----------------------------- Context Management ---------------------------- - -(defun cj/gptel--add-file-to-context (file-path) - "Add FILE-PATH to the GPTel context. -Returns t on success, nil on failure. -Provides consistent user feedback about the context state." - (when (and file-path (file-exists-p file-path)) - (gptel-add-file file-path) - (let ((context-count (if (boundp 'gptel-context--alist) - (length gptel-context--alist) - 0))) - (message "Added %s to GPTel context (%d sources total)" - (file-name-nondirectory file-path) - context-count)) - t)) - -(defun cj/gptel-add-file () - "Add a file to the GPTel context. -If inside a Projectile project, prompt from that project's file list. -Otherwise, prompt with `read-file-name'." - (interactive) - (let* ((in-proj (and (featurep 'projectile) - (fboundp 'projectile-project-p) - (projectile-project-p))) - (file-name (if in-proj - (let ((cands (projectile-current-project-files))) - (if (fboundp 'projectile-completing-read) - (projectile-completing-read "GPTel add file: " cands) - (completing-read "GPTel add file: " cands nil t))) - (read-file-name "GPTel add file: "))) - (file-path (if in-proj - (expand-file-name file-name (projectile-project-root)) - file-name))) - (unless (cj/gptel--add-file-to-context file-path) - (error "Failed to add file: %s" file-path)))) - -(defun cj/gptel-add-buffer-file () - "Select a buffer and add its associated file to the GPTel context. -Lists all open buffers for selection. If the selected buffer is visiting -a file, that file is added to the GPTel context. Otherwise, an error -message is displayed." - (interactive) - (let* ((buffers (mapcar #'buffer-name (buffer-list))) - (selected-buffer-name (completing-read "Add file from buffer: " buffers nil t)) - (selected-buffer (get-buffer selected-buffer-name)) - (file-path (and selected-buffer - (buffer-file-name selected-buffer)))) - (if file-path - (cj/gptel--add-file-to-context file-path) - (message "Buffer '%s' is not visiting a file" selected-buffer-name)))) - -(defun cj/gptel-add-this-buffer () - "Add the current buffer to the GPTel context. -Works for any buffer, whether it's visiting a file or not." - (interactive) - ;; Load gptel-context if needed - (unless (featurep 'gptel-context) - (require 'gptel-context)) - ;; Use gptel-add with prefix arg '(4) to add current buffer - (gptel-add '(4)) - (message "Added buffer '%s' to GPTel context" (buffer-name))) - -;;; -------------------------- Org Header Construction -------------------------- - -(defun cj/gptel--fresh-org-prefix () - "Generate a fresh org-mode header with current timestamp for user messages." - (concat "* " user-login-name " " (format-time-string "[%Y-%m-%d %H:%M:%S]") "\n")) - -(defun cj/gptel--refresh-org-prefix (&rest _) - "Update the org-mode prefix with fresh timestamp before sending message." - (setf (alist-get 'org-mode gptel-prompt-prefix-alist) - (cj/gptel--fresh-org-prefix))) - -(defun cj/gptel-backend-and-model () - "Return backend, model, and timestamp as a single string." - (let* ((backend (pcase (bound-and-true-p gptel-backend) - ((and v (pred vectorp)) (aref v 1)) - (_ "AI"))) - (model (format "%s" (or (bound-and-true-p gptel-model) ""))) - (ts (format-time-string "[%Y-%m-%d %H:%M:%S]"))) - (format "%s: %s %s" backend model ts))) - -(defun cj/gptel-insert-model-heading (response-begin-pos _response-end-pos) - "Insert an Org heading for the AI reply at RESPONSE-BEGIN-POS." - (save-excursion - (goto-char response-begin-pos) - (insert (format "* %s\n" (cj/gptel-backend-and-model))))) - -;;; ---------------------------- GPTel Configuration ---------------------------- - -(use-package gptel - :load-path "~/code/gptel" - :ensure nil - :defer t - :commands (gptel gptel-send gptel-menu) - :bind - (:map gptel-mode-map - ("C-<return>" . gptel-send)) - :custom - (gptel-default-mode 'org-mode) - (gptel-expert-commands t) - (gptel-track-media t) - ;; Options: t (include + resend), 'ignore (show but don't resend), - ;; nil (discard), or a buffer name to redirect reasoning to - (gptel-include-reasoning "*AI-Reasoning*") - (gptel-log-level 'info) - (gptel--debug nil) - :config - (cj/ensure-gptel-backends) - ;; Set ChatGPT (gpt-5.5) as default after initialization. Model - ;; must be a symbol -- gptel's modeline-display code calls `symbolp' - ;; on it and signals `wrong-type-argument' otherwise. - (setq gptel-backend gptel-chatgpt-backend) - (setq gptel-model 'gpt-5.5) - - (setq gptel-confirm-tool-calls nil) ;; allow tool access by default - - ;; Initialize org-mode user prefix and wire up hooks - (setf (alist-get 'org-mode gptel-prompt-prefix-alist) - (cj/gptel--fresh-org-prefix)) - (advice-add 'gptel-send :before #'cj/gptel--refresh-org-prefix) - (add-hook 'gptel-post-response-functions #'cj/gptel-insert-model-heading)) - -;;; ---------------------------- Toggle GPTel Window ---------------------------- - -(defvar cj/ai-assistant-window-width 0.4 - "Default fraction of frame width for the *AI-Assistant* side window. -Used until the panel is resized and toggled off this session; after that, -the toggled-off width is remembered in `cj/--ai-assistant-width'.") - -(defvar cj/--ai-assistant-width nil - "Last width fraction the *AI-Assistant* side window was toggled off at. -nil falls back to `cj/ai-assistant-window-width'. Shared by the panel's -entry points (toggle, load-conversation, quick-ask escalation) so the -panel reopens at one consistent width. In-memory only -- resets each -Emacs session.") - -(defun cj/toggle-gptel () - "Toggle the visibility of the AI-Assistant buffer, and place point at its end. -The panel opens at `cj/ai-assistant-window-width'; once it has been resized -and toggled off this session, it reopens at that remembered width." - (interactive) - (let* ((buf-name "*AI-Assistant*") - (buffer (get-buffer buf-name)) - (win (and buffer (get-buffer-window buffer)))) - (if win - (progn - (cj/side-window-capture-size win 'right 'cj/--ai-assistant-width) - (delete-window win)) - ;; Ensure GPTel and our backends are initialized before creating the buffer - (unless (featurep 'gptel) - (require 'gptel)) - (cj/ensure-gptel-backends) - (unless buffer - ;; Pass backend, not model - (gptel buf-name gptel-backend)) - (setq buffer (get-buffer buf-name)) - (setq win - (cj/side-window-display - buffer 'right 'cj/--ai-assistant-width - cj/ai-assistant-window-width)) - (select-window win) - (with-current-buffer buffer - (goto-char (point-max)))))) - -;; ------------------------------- Clear Context ------------------------------- - -(defun cj/gptel-context-clear () - "Clear all GPTel context sources, with compatibility across GPTel versions." - (interactive) - (cond - ((fboundp 'gptel-context-remove-all) - (call-interactively 'gptel-context-remove-all) - (message "GPTel context cleared")) - ((fboundp 'gptel-context-clear) - (call-interactively 'gptel-context-clear) - (message "GPTel context cleared")) - ((boundp 'gptel-context--alist) - (setq gptel-context--alist nil) - (message "GPTel context cleared")) - (t - (message "No known GPTel context clearing function available")))) - -;;; -------------------------------- GPTel-Magit -------------------------------- - -;; Each integration point waits on its actual dependency, not on `magit' -;; broadly. `magit.el' calls `(provide 'magit)' BEFORE its -;; `cl-eval-when (load eval) ...' block requires `magit-commit' and -;; `magit-stash', so a single `with-eval-after-load 'magit' fires while -;; the transient prefixes the wiring references are still undefined. -;; `transient-append-suffix' silently no-ops on missing prefixes (it -;; calls `message' unless `transient-error-on-insert-failure' is set), -;; which is how the failure stayed invisible. -;; -;; Keys: -;; M-g — generate commit message (in commit message buffer) -;; g — generate commit (in magit-commit transient) -;; x — explain diff (in magit-diff transient) - -(use-package gptel-magit - :defer t - :commands (gptel-magit-generate-message - gptel-magit-commit-generate - gptel-magit-diff-explain) - :init - (with-eval-after-load 'git-commit - (define-key git-commit-mode-map (kbd "M-g") #'gptel-magit-generate-message)) - (with-eval-after-load 'magit-commit - (transient-append-suffix 'magit-commit #'magit-commit-create - '("g" "Generate commit" gptel-magit-commit-generate))) - (with-eval-after-load 'magit-diff - (transient-append-suffix 'magit-diff #'magit-stash-show - '("x" "Explain" gptel-magit-diff-explain)))) - -;; ------------------------------ GPTel Directives ----------------------------- - -(use-package gptel-prompts - :load-path (lambda () (expand-file-name "custom/" user-emacs-directory)) - :after gptel - :if (file-exists-p (expand-file-name "custom/gptel-prompts.el" user-emacs-directory)) - :custom - (gptel-prompts-directory (concat user-emacs-directory "ai-prompts")) - :config - (gptel-prompts-update) - (gptel-prompts-add-update-watchers) - ;; gptel--system-message is set at gptel load time, before gptel-prompts - ;; replaces the default directive. Re-apply it now. - (when-let* ((dir (alist-get 'default gptel-directives))) - (setq gptel--system-message dir))) - -;;; --------------------------------- AI Keymap --------------------------------- - -(defvar-keymap cj/ai-keymap - :doc "Keymap for gptel and other AI operations." - "A" #'cj/gptel-autosave-toggle ;; toggle autosave on the current GPTel buffer - "B" #'cj/gptel-switch-backend ;; change the backend (OpenAI, Anthropic, etc. - "M" #'gptel-menu ;; gptel's transient menu - "d" #'cj/gptel-delete-conversation ;; delete conversation - "." #'cj/gptel-add-this-buffer ;; add buffer to context - "f" #'cj/gptel-add-file ;; add a file to context - "b" #'cj/gptel-browse-conversations ;; browse saved conversations - "l" #'cj/gptel-load-conversation ;; load and continue conversation - "m" #'cj/gptel-change-model ;; change the LLM model - "p" #'gptel-system-prompt ;; change prompt - "q" #'cj/gptel-quick-ask ;; one-shot quick ask - "r" #'cj/gptel-rewrite-with-directive ;; rewrite region with a chosen directive - "R" #'cj/gptel-rewrite-redo-with-different-directive ;; redo last rewrite, new directive - "c" #'cj/gptel-context-clear ;; clear all context - "s" #'cj/gptel-save-conversation ;; save conversation - "t" #'cj/toggle-gptel ;; toggles the ai-assistant window - "x" #'cj/gptel-clear-buffer) ;; clears the assistant buffer -(cj/register-prefix-map "a" cj/ai-keymap) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "C-; a" "AI assistant menu" - "C-; a A" "toggle autosave" - "C-; a B" "switch backend" - "C-; a M" "gptel menu" - "C-; a b" "browse conversations" - "C-; a d" "delete conversation" - "C-; a ." "add buffer" - "C-; a f" "add file" - "C-; a l" "load conversation" - "C-; a m" "change model" - "C-; a p" "change prompt" - "C-; a q" "quick ask" - "C-; a r" "rewrite region (directive)" - "C-; a R" "redo rewrite, new directive" - "C-; a c" "clear context" - "C-; a s" "save conversation" - "C-; a t" "toggle window" - "C-; a x" "clear buffer")) - -(provide 'ai-config) -;;; ai-config.el ends here. diff --git a/modules/ai-conversations-browser.el b/modules/ai-conversations-browser.el deleted file mode 100644 index 9f2a7de43..000000000 --- a/modules/ai-conversations-browser.el +++ /dev/null @@ -1,241 +0,0 @@ -;;; ai-conversations-browser.el --- Browse saved GPTel conversations -*- lexical-binding: t; coding: utf-8; -*- - -;; Author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; Provides `cj/gptel-browse-conversations': a dired-style buffer -;; listing saved conversations in `cj/gptel-conversations-directory'. -;; Each row shows date, time, topic, and a short preview of the most -;; recent message. Single-key bindings load / delete / rename a -;; conversation in place. -;; -;; RET, l Load the conversation under point -;; d Delete the conversation under point -;; r Rename the conversation under point (renames the file) -;; g Refresh the listing -;; n / p Move to next / previous row -;; q Quit the browser window - -;;; Code: - -(require 'cl-lib) -(require 'subr-x) - -(declare-function cj/gptel-load-conversation "ai-conversations" ()) -(declare-function cj/gptel--slugify-topic "ai-conversations" (s)) -(declare-function cj/gptel--timestamp-from-filename "ai-conversations" (filename)) - -(defcustom cj/gptel-browser-preview-length 60 - "Number of preview characters shown per row in the browser." - :type 'integer - :group 'cj/ai-conversations) - -(defconst cj/gptel-browser--buffer-name "*GPTel-Conversations*" - "Buffer name for the saved-conversations browser.") - -(defvar-keymap cj/gptel-browser-mode-map - :doc "Keymap for `cj/gptel-browser-mode'." - "RET" #'cj/gptel-browser-load - "l" #'cj/gptel-browser-load - "d" #'cj/gptel-browser-delete - "r" #'cj/gptel-browser-rename - "g" #'cj/gptel-browser-refresh - "n" #'next-line - "p" #'previous-line - "q" #'quit-window) - -(define-derived-mode cj/gptel-browser-mode special-mode "GPTel-Browser" - "Major mode for browsing saved GPTel conversations." - (setq-local truncate-lines t)) - -;; -------------------------- helpers (pure where possible) - -(defun cj/gptel-browser--topic-from-filename (filename) - "Return the topic slug from FILENAME, or nil if it isn't a gptel file." - (when (string-match "\\`\\(.+\\)_[0-9]\\{8\\}-[0-9]\\{6\\}\\.gptel\\'" filename) - (match-string 1 filename))) - -(defun cj/gptel-browser--strip-headers (text) - "Drop the org #+STARTUP / #+VISIBILITY headers from TEXT and return the rest." - (let ((s text)) - (while (string-match "\\`#\\+\\(STARTUP\\|VISIBILITY\\):.*\n" s) - (setq s (substring s (match-end 0)))) - (while (and (> (length s) 0) (eq (aref s 0) ?\n)) - (setq s (substring s 1))) - s)) - -(defun cj/gptel-browser--last-message (text) - "Return a short preview of the last user/AI message in TEXT. -Returns the empty string when no message body is present." - (let* ((stripped (cj/gptel-browser--strip-headers text)) - ;; Last org-mode top-level heading body, or the whole text if - ;; there isn't one. - (body (if (string-match "\\`\\*+[^\n]*\n\\(\\(?:.\\|\n\\)*\\)\\'" stripped) - (let* ((all-text stripped) - ;; Walk backward to find the last '* ' or '** ' heading - (idx (or (cl-loop for i from (1- (length all-text)) downto 0 - when (and (or (zerop i) - (eq (aref all-text (1- i)) ?\n)) - (eq (aref all-text i) ?*)) - return i) - 0))) - (substring all-text idx)) - stripped))) - ;; Drop the heading line itself, then collapse whitespace. - (when (string-match "\\`\\*+[^\n]*\n" body) - (setq body (substring body (match-end 0)))) - (setq body (replace-regexp-in-string "[\n\t ]+" " " body)) - (string-trim body))) - -(defun cj/gptel-browser--preview (text length) - "Return a LENGTH-char preview from TEXT, ellipsized when truncated." - (let* ((line (cj/gptel-browser--last-message text)) - (max-len (max 1 length))) - (cond - ((string-empty-p line) "") - ((> (length line) max-len) - (concat (substring line 0 (1- max-len)) "…")) - (t line)))) - -(defun cj/gptel-browser--row-for-file (file dir) - "Return a propertized row string for FILE under DIR, or nil." - (let* ((filename (file-name-nondirectory file)) - (topic (cj/gptel-browser--topic-from-filename filename)) - (ts (and topic (cj/gptel--timestamp-from-filename filename)))) - (when (and topic ts) - (let* ((preview (with-temp-buffer - (ignore-errors (insert-file-contents file)) - (cj/gptel-browser--preview - (buffer-string) cj/gptel-browser-preview-length))) - (row (format "%s %-22s %s" - (format-time-string "%Y-%m-%d %H:%M" ts) - topic preview))) - (propertize row - 'cj/gptel-browser-file filename - 'cj/gptel-browser-topic topic))))) - -(defun cj/gptel-browser--rows () - "Return propertized row strings for every conversation in the directory." - (when (and (boundp 'cj/gptel-conversations-directory) - (file-directory-p cj/gptel-conversations-directory)) - (let ((dir cj/gptel-conversations-directory)) - (delq nil - (mapcar (lambda (f) (cj/gptel-browser--row-for-file f dir)) - (directory-files dir t "\\.gptel\\'")))))) - -(defun cj/gptel-browser--render () - "Replace the current buffer's contents with the conversation listing. -Sort newest first." - (let ((inhibit-read-only t) - (rows (sort (cj/gptel-browser--rows) - (lambda (a b) - (string> (substring-no-properties a 0 16) - (substring-no-properties b 0 16)))))) - (erase-buffer) - (insert (propertize - "Saved GPTel conversations -- RET/l load d delete r rename g refresh q quit\n\n" - 'face 'header-line)) - (cond - ((null rows) - (insert " (no saved conversations)\n")) - (t - (dolist (row rows) - (insert row "\n")))) - (goto-char (point-min)) - (forward-line 2))) - -;; -------------------------- entry point - -;;;###autoload -(defun cj/gptel-browse-conversations () - "Open the saved GPTel conversations browser." - (interactive) - (let ((buf (get-buffer-create cj/gptel-browser--buffer-name))) - (with-current-buffer buf - (cj/gptel-browser-mode) - (cj/gptel-browser--render)) - (pop-to-buffer buf))) - -(defun cj/gptel-browser-refresh () - "Re-read the conversations directory and refresh the browser." - (interactive) - (cj/gptel-browser--render)) - -;; -------------------------- row-level actions - -(defun cj/gptel-browser--filename-at-point () - "Return the conversation filename on the current line, or nil." - (get-text-property (line-beginning-position) 'cj/gptel-browser-file)) - -(defun cj/gptel-browser--filepath-at-point () - "Return the absolute filepath for the row at point, or nil." - (when-let ((filename (cj/gptel-browser--filename-at-point))) - (expand-file-name filename cj/gptel-conversations-directory))) - -(defun cj/gptel-browser-load () - "Load the conversation on the current row via `cj/gptel-load-conversation'. -The browser is buried after the load fires." - (interactive) - (let ((filepath (cj/gptel-browser--filepath-at-point))) - (unless filepath - (user-error "No conversation on this line")) - (let ((filename (file-name-nondirectory filepath))) - ;; Stand in for cj/gptel-load-conversation's completing-read so - ;; the user doesn't get prompted twice. - (cl-letf (((symbol-function 'completing-read) - (lambda (_p cands &rest _) - (or (car (cl-find filename cands - :key (lambda (c) (cdr c)) - :test #'equal)) - (caar cands)))) - ((symbol-function 'y-or-n-p) (lambda (&rest _) nil))) - (cj/gptel-load-conversation))) - (quit-window))) - -(defun cj/gptel-browser-delete () - "Delete the conversation file on the current row, after confirmation." - (interactive) - (let ((filepath (cj/gptel-browser--filepath-at-point))) - (unless filepath - (user-error "No conversation on this line")) - (let ((filename (file-name-nondirectory filepath))) - (when (y-or-n-p (format "Delete %s? " filename)) - (delete-file filepath) - (message "Deleted %s" filename) - (cj/gptel-browser--render))))) - -(defun cj/gptel-browser--rename-target (filepath new-topic) - "Compute the renamed FILEPATH for NEW-TOPIC, preserving the timestamp. -NEW-TOPIC is slugified. Returns the new absolute filepath." - (let* ((dir (file-name-directory filepath)) - (filename (file-name-nondirectory filepath)) - (timestamp (and (string-match "_\\([0-9]\\{8\\}-[0-9]\\{6\\}\\)\\.gptel\\'" - filename) - (match-string 1 filename))) - (slug (cj/gptel--slugify-topic new-topic))) - (unless timestamp - (error "Cannot extract timestamp from filename: %s" filename)) - (expand-file-name (format "%s_%s.gptel" slug timestamp) dir))) - -(defun cj/gptel-browser-rename () - "Rename the conversation file on the current row, preserving its timestamp." - (interactive) - (let ((filepath (cj/gptel-browser--filepath-at-point))) - (unless filepath - (user-error "No conversation on this line")) - (let* ((old (file-name-nondirectory filepath)) - (current-topic (cj/gptel-browser--topic-from-filename old)) - (new-topic (read-string - (format "New topic (was %s): " current-topic) - current-topic)) - (target (cj/gptel-browser--rename-target filepath new-topic))) - (when (equal target filepath) - (user-error "Topic unchanged")) - (when (file-exists-p target) - (user-error "Target already exists: %s" (file-name-nondirectory target))) - (rename-file filepath target) - (message "Renamed to %s" (file-name-nondirectory target)) - (cj/gptel-browser--render)))) - -(provide 'ai-conversations-browser) -;;; ai-conversations-browser.el ends here diff --git a/modules/ai-conversations.el b/modules/ai-conversations.el deleted file mode 100644 index 839af9ad3..000000000 --- a/modules/ai-conversations.el +++ /dev/null @@ -1,375 +0,0 @@ -;;; ai-conversations.el --- GPTel conversation persistence and autosave -*- lexical-binding: t; coding: utf-8; -*- -;; Author: Craig Jennings <c@cjennings.net> -;; Maintainer: Craig Jennings <c@cjennings.net> -;; Version 0.1 -;; Package-Requires: ((emacs "27.1")) -;; Keywords: convenience, tools -;; -;;; Commentary: -;; Provides conversation save/load/delete, autosave after responses, and -;; org-visibility headers for GPTel-powered assistant buffers. -;; -;; Loads lazily via autoloads for the interactive entry points. - -;;; Code: - -(require 'cj-window-toggle-lib) ;; cj/side-window-display - -;; Shared *AI-Assistant* remembered-width state, owned by ai-config.el. -;; Forward-declared so loading a conversation reopens the panel at the same -;; width as the F-key toggle without a circular require. -(defvar cj/--ai-assistant-width) - -(defgroup cj/ai-conversations nil - "Conversation persistence for GPTel (save/load/delete, autosave)." - :group 'gptel - :prefix "cj/") - -(defcustom cj/gptel-conversations-directory - (expand-file-name "ai-conversations" user-emacs-directory) - "Directory where GPTel conversations are stored." - :type 'directory - :group 'cj/ai-conversations) - -(defcustom cj/gptel-conversations-window-side 'right - "Side to display the AI-Assistant buffer when loading a conversation." - :type '(choice (const :tag "Right" right) - (const :tag "Left" left) - (const :tag "Bottom" bottom) - (const :tag "Top" top)) - :group 'cj/ai-conversations) - -(defcustom cj/gptel-conversations-window-width 0.4 - "Set the side window width when loading a conversation. - -If displaying on the top or bottom, treat this value as a height fraction." - :type 'number - :group 'cj/ai-conversations) - -(defcustom cj/gptel-conversations-sort-order 'newest-first - "Sort order for conversation selection prompts." - :type '(choice (const :tag "Newest first" newest-first) - (const :tag "Oldest first" oldest-first)) - :group 'cj/ai-conversations) - -(defvar-local cj/gptel-autosave-enabled nil - "Non-nil means auto-save after each AI response in GPTel buffers.") - -(defvar-local cj/gptel-autosave-filepath nil - "File path used for auto-saving the conversation buffer.") - -(defvar-local cj/gptel-autosave--timer nil - "Repeating timer used to auto-save the current GPTel buffer.") - -(defcustom cj/gptel-autosave-interval 60 - "Seconds between periodic GPTel conversation autosaves." - :type 'number - :group 'cj/ai-conversations) - -(defvar cj/gptel-autosave-mode-line-format - '(:eval (when (bound-and-true-p cj/gptel-autosave-enabled) " [AS]")) - "Mode-line construct that surfaces autosave state in GPTel buffers.") -(put 'cj/gptel-autosave-mode-line-format 'risky-local-variable t) - -(defun cj/gptel--autosave-active-p () - "Return non-nil when the current buffer has an autosave target." - (and (bound-and-true-p gptel-mode) - cj/gptel-autosave-enabled - (stringp cj/gptel-autosave-filepath) - (> (length cj/gptel-autosave-filepath) 0))) - -(defun cj/gptel--autosave-stop-timer () - "Cancel the current buffer's periodic autosave timer, if any." - (when cj/gptel-autosave--timer - (cancel-timer cj/gptel-autosave--timer) - (setq-local cj/gptel-autosave--timer nil))) - -(defun cj/gptel--autosave-timer-callback (buffer) - "Auto-save BUFFER from a periodic timer when autosave is still active." - (when (buffer-live-p buffer) - (with-current-buffer buffer - (if (cj/gptel--autosave-active-p) - (condition-case err - (cj/gptel--save-buffer-to-file (current-buffer) cj/gptel-autosave-filepath) - (error (message "cj/gptel periodic autosave failed: %s" - (error-message-string err)))) - (cj/gptel--autosave-stop-timer))))) - -(defun cj/gptel--autosave-start-timer () - "Start the current buffer's periodic autosave timer when autosave is active." - (when (and (cj/gptel--autosave-active-p) - (not cj/gptel-autosave--timer)) - (setq-local cj/gptel-autosave--timer - (run-with-timer cj/gptel-autosave-interval - cj/gptel-autosave-interval - #'cj/gptel--autosave-timer-callback - (current-buffer))))) - -(defun cj/gptel-autosave-toggle () - "Toggle autosave on/off in the current GPTel buffer. -Flips `cj/gptel-autosave-enabled' and forces a mode-line redisplay so -the [AS] indicator updates immediately. When turning autosave ON -without a configured filepath, prompt to save the conversation first -so a path exists to autosave to." - (interactive) - (unless (bound-and-true-p gptel-mode) - (user-error "Not a GPTel buffer")) - (if cj/gptel-autosave-enabled - (progn - (setq-local cj/gptel-autosave-enabled nil) - (cj/gptel--autosave-stop-timer) - (message "Autosave disabled")) - (cond - ((and (stringp cj/gptel-autosave-filepath) - (> (length cj/gptel-autosave-filepath) 0)) - (setq-local cj/gptel-autosave-enabled t) - (cj/gptel--autosave-start-timer) - (message "Autosave enabled (saving to %s)" - (file-name-nondirectory cj/gptel-autosave-filepath))) - ((y-or-n-p "No save target yet. Save conversation first? ") - (call-interactively #'cj/gptel-save-conversation)) - (t - (message "Autosave not enabled (no save target)")))) - (force-mode-line-update)) - -(defcustom cj/gptel-conversations-autosave-on-send t - "Non-nil means auto-save the conversation immediately after `gptel-send'." - :type 'boolean - :group 'cj/ai-conversations) - -(defun cj/gptel--autosave-after-send (&rest _args) - "Auto-save current GPTel buffer right after `gptel-send' if enabled." - (when (and cj/gptel-conversations-autosave-on-send - (bound-and-true-p gptel-mode) - cj/gptel-autosave-enabled - (stringp cj/gptel-autosave-filepath) - (> (length cj/gptel-autosave-filepath) 0)) - (condition-case err - (cj/gptel--save-buffer-to-file (current-buffer) cj/gptel-autosave-filepath) - (error (message "cj/gptel autosave-on-send failed: %s" (error-message-string err)))))) - -(with-eval-after-load 'gptel - (unless (advice-member-p #'cj/gptel--autosave-after-send #'gptel-send) - (advice-add 'gptel-send :after #'cj/gptel--autosave-after-send))) - -(defun cj/gptel--install-autosave-mode-line () - "Add the [AS] autosave indicator to the current buffer's mode-line. -Idempotent: re-running in the same buffer does not duplicate the -construct." - (unless (member 'cj/gptel-autosave-mode-line-format mode-line-format) - (setq-local mode-line-format - (append mode-line-format - (list 'cj/gptel-autosave-mode-line-format))))) - -(defun cj/gptel--install-autosave-buffer-hooks () - "Install buffer-local cleanup hooks for GPTel autosave." - (add-hook 'kill-buffer-hook #'cj/gptel--autosave-stop-timer nil t)) - -(with-eval-after-load 'gptel - (add-hook 'gptel-mode-hook #'cj/gptel--install-autosave-mode-line) - (add-hook 'gptel-mode-hook #'cj/gptel--install-autosave-buffer-hooks)) - -(defun cj/gptel--slugify-topic (s) - "Return a filesystem-friendly slug for topic string S." - (let* ((down (downcase (or s ""))) - (repl (replace-regexp-in-string "[^a-z0-9]+" "-" down)) - (trim (replace-regexp-in-string "^-+\\|-+$" "" repl))) - (or (and (> (length trim) 0) trim) "conversation"))) - -(defun cj/gptel--existing-topics () - "Return topic slugs, without timestamps, present in the conversations directory." - (when (file-exists-p cj/gptel-conversations-directory) - (let* ((files (directory-files cj/gptel-conversations-directory nil "\\.gptel$"))) - (delete-dups - (mapcar - (lambda (f) - (replace-regexp-in-string "_[0-9]\\{8\\}-[0-9]\\{6\\}\\.gptel$" "" f)) - files))))) - -(defun cj/gptel--latest-file-for-topic (topic-slug) - "Return the newest saved conversation filename for TOPIC-SLUG, or nil." - (let* ((rx (format "^%s_[0-9]\\{8\\}-[0-9]\\{6\\}\\.gptel$" - (regexp-quote topic-slug))) - (files (and (file-exists-p cj/gptel-conversations-directory) - (directory-files cj/gptel-conversations-directory nil rx)))) - (car (sort files #'string>)))) - -(defun cj/gptel--timestamp-from-filename (filename) - "Return an Emacs timestamp extracted from FILENAME, or nil. - -Expect FILENAME to match _YYYYMMDD-HHMMSS.gptel." - (when (string-match "_\\([0-9]\\{8\\}\\)-\\([0-9]\\{6\\}\\)\\.gptel\\'" filename) - (let* ((date (match-string 1 filename)) - (time (match-string 2 filename)) - (Y (string-to-number (substring date 0 4))) - (M (string-to-number (substring date 4 6))) - (D (string-to-number (substring date 6 8))) - (h (string-to-number (substring time 0 2))) - (m (string-to-number (substring time 2 4))) - (s (string-to-number (substring time 4 6)))) - (encode-time s m h D M Y)))) - -(defun cj/gptel--conversation-candidates () - "Return conversation candidates sorted per `cj/gptel-conversations-sort-order'." - (unless (file-exists-p cj/gptel-conversations-directory) - (user-error "Conversations directory doesn't exist: %s" cj/gptel-conversations-directory)) - (let* ((files (directory-files cj/gptel-conversations-directory nil "\\.gptel$")) - (enriched - (mapcar - (lambda (f) - (let* ((full (expand-file-name f cj/gptel-conversations-directory)) - (ptime (or (cj/gptel--timestamp-from-filename f) - (nth 5 (file-attributes full)))) - (disp (format "%s [%s]" f (format-time-string "%Y-%m-%d %H:%M" ptime)))) - (list :file f :time ptime :display disp))) - files)) - (sorted - (sort enriched - (lambda (a b) - (let ((ta (plist-get a :time)) - (tb (plist-get b :time))) - (if (eq cj/gptel-conversations-sort-order 'newest-first) - (time-less-p tb ta) ;; tb earlier than ta => a first - (time-less-p ta tb)))))) - (cands (mapcar (lambda (pl) - (cons (plist-get pl :display) - (plist-get pl :file))) - sorted))) - cands)) - -(defun cj/gptel--save-buffer-to-file (buffer filepath) - "Save BUFFER content to FILEPATH with Org visibility properties." - (with-current-buffer buffer - (let ((content (buffer-string))) - (with-temp-buffer - (insert "#+STARTUP: showeverything\n") - (insert "#+VISIBILITY: all\n\n") - (insert content) - (write-region (point-min) (point-max) filepath nil 'silent)))) - filepath) - -(defun cj/gptel--ensure-ai-buffer () - "Return the *AI-Assistant* buffer, creating it via `gptel' if needed." - (let* ((buf-name "*AI-Assistant*") - (buffer (get-buffer buf-name))) - (unless buffer - (gptel buf-name)) - (or (get-buffer buf-name) - (user-error "Could not create or find *AI-Assistant* buffer")))) - -(defun cj/gptel-save-conversation () - "Save the current AI-Assistant buffer to a .gptel file. - -Enable autosave for subsequent AI responses to the same file." - (interactive) - (let ((buf (get-buffer "*AI-Assistant*"))) - (unless buf - (user-error "No AI-Assistant buffer found")) - (unless (file-exists-p cj/gptel-conversations-directory) - (make-directory cj/gptel-conversations-directory t) - (message "Created directory: %s" cj/gptel-conversations-directory)) - (let* ((topics (or (cj/gptel--existing-topics) '())) - (input (completing-read "Conversation topic: " topics nil nil)) - (topic-slug (cj/gptel--slugify-topic input)) - (latest (cj/gptel--latest-file-for-topic topic-slug)) - (use-existing (and latest - (y-or-n-p (format "Update existing file %s? " latest)))) - (filepath (if use-existing - (expand-file-name latest cj/gptel-conversations-directory) - (let* ((timestamp (format-time-string "%Y%m%d-%H%M%S")) - (filename (format "%s_%s.gptel" topic-slug timestamp))) - (expand-file-name filename cj/gptel-conversations-directory))))) - (cj/gptel--save-buffer-to-file buf filepath) - (with-current-buffer buf - (setq-local cj/gptel-autosave-filepath filepath) - (setq-local cj/gptel-autosave-enabled t) - (cj/gptel--autosave-start-timer)) - (message "Conversation saved to: %s" filepath)))) - -(defun cj/gptel-delete-conversation () - "Delete a saved GPTel conversation file (chronologically sorted candidates)." - (interactive) - (unless (file-exists-p cj/gptel-conversations-directory) - (user-error "Conversations directory doesn't exist: %s" cj/gptel-conversations-directory)) - (let* ((cands (cj/gptel--conversation-candidates))) - (unless cands - (user-error "No saved conversations found in %s" cj/gptel-conversations-directory)) - (let* ((completion-extra-properties '(:display-sort-function identity - :cycle-sort-function identity)) - (selection (completing-read "Delete conversation: " cands nil t)) - (filename (cdr (assoc selection cands))) - (filepath (and filename - (expand-file-name filename cj/gptel-conversations-directory)))) - (unless filename - (user-error "No conversation selected")) - (when (y-or-n-p (format "Really delete %s? " filename)) - (delete-file filepath) - (message "Deleted conversation: %s" filename))))) - -(defun cj/gptel--strip-visibility-headers () - "Strip org visibility headers at the top of the current buffer if present." - (save-excursion - (goto-char (point-min)) - (while (looking-at "^#\\+\\(STARTUP\\|VISIBILITY\\):.*\n") - (delete-region (match-beginning 0) (match-end 0))) - (when (looking-at "^\n+") - (delete-region (point) (match-end 0))))) - -(defun cj/gptel-load-conversation () - "Load a saved GPTel conversation into the AI-Assistant buffer. - -Prompt to save the current conversation first when appropriate, then -enable autosave." - (interactive) - (let ((ai-buffer (get-buffer-create "*AI-Assistant*"))) - (when (and (with-current-buffer ai-buffer (> (buffer-size) 0)) - (with-current-buffer ai-buffer (bound-and-true-p gptel-mode))) - (when (y-or-n-p "Save current conversation before loading new one? ") - (with-current-buffer ai-buffer - (call-interactively #'cj/gptel-save-conversation))))) - (unless (file-exists-p cj/gptel-conversations-directory) - (user-error "Conversations directory doesn't exist: %s" cj/gptel-conversations-directory)) - (let* ((cands (cj/gptel--conversation-candidates))) - (unless cands - (user-error "No saved conversations found in %s" cj/gptel-conversations-directory)) - (let* ((completion-extra-properties '(:display-sort-function identity - :cycle-sort-function identity)) - (selection (completing-read "Load conversation: " cands nil t)) - (filename (cdr (assoc selection cands))) - (filepath (and filename - (expand-file-name filename cj/gptel-conversations-directory)))) - (unless filename - (user-error "No conversation selected")) - (with-current-buffer (cj/gptel--ensure-ai-buffer) - (erase-buffer) - (insert-file-contents filepath) - (cj/gptel--strip-visibility-headers) - (goto-char (point-max)) - (set-buffer-modified-p t) - (setq-local cj/gptel-autosave-filepath filepath) - (setq-local cj/gptel-autosave-enabled t) - (cj/gptel--autosave-start-timer)) - (let ((buf (get-buffer "*AI-Assistant*"))) - (unless (get-buffer-window buf) - (cj/side-window-display - buf cj/gptel-conversations-window-side - 'cj/--ai-assistant-width cj/gptel-conversations-window-width))) - (select-window (get-buffer-window "*AI-Assistant*")) - (message "Loaded conversation from: %s" filepath)))) - -(defun cj/gptel--autosave-after-response (&rest _args) - "Auto-save the current GPTel buffer when enabled." - (when (and (bound-and-true-p gptel-mode) - cj/gptel-autosave-enabled - (stringp cj/gptel-autosave-filepath) - (> (length cj/gptel-autosave-filepath) 0)) - (condition-case err - (cj/gptel--save-buffer-to-file (current-buffer) cj/gptel-autosave-filepath) - (error (message "cj/gptel autosave failed: %s" (error-message-string err)))))) - -(with-eval-after-load 'gptel - (unless (member #'cj/gptel--autosave-after-response gptel-post-response-functions) - (add-hook 'gptel-post-response-functions #'cj/gptel--autosave-after-response))) - -(provide 'ai-conversations) -;;; ai-conversations.el ends here diff --git a/modules/ai-mcp.el b/modules/ai-mcp.el deleted file mode 100644 index 3b552d8dc..000000000 --- a/modules/ai-mcp.el +++ /dev/null @@ -1,416 +0,0 @@ -;;; ai-mcp.el --- MCP server integration for GPTel -*- lexical-binding: t; coding: utf-8; -*- -;; Author: Craig Jennings <c@cjennings.net> -;; Maintainer: Craig Jennings <c@cjennings.net> -;; Version 0.1 -;; Package-Requires: ((emacs "30.1") (mcp "0.1.0") (gptel "0.9.8")) -;; Keywords: convenience, tools, ai -;; -;;; Commentary: -;; Wires mcp.el's MCP server inventory into GPTel. GPTel agents gain -;; access to the MCP servers Claude Code already uses (linear, notion, -;; figma, slack-deepsat, drawio, google-calendar, google-docs-personal, -;; google-docs-work, google-keep), with write-confirmation gating and a -;; doctor for diagnosing prerequisites. -;; -;; Design doc: docs/design/mcp-el-gptel-integration.org -;; -;; File organization (seven sections, populated by phases): -;; 1. Constants and defcustoms <- this phase -;; 2. Public commands <- later phase -;; 3. Pure helpers <- this phase -;; 4. mcp.el compatibility layer <- later phase -;; 5. Registration pipeline <- later phase -;; 6. Async state machine <- later phase -;; 7. UI <- later phase - -;;; Code: - -(require 'cl-lib) -(require 'json) - -;;;; --- 1. Constants and defcustoms ----------------------------------- - -(defgroup cj/ai-mcp nil - "MCP server integration for GPTel." - :group 'gptel - :prefix "cj/") - -(defcustom cj/mcp-claude-config - (expand-file-name "~/.claude.json") - "Path to the Claude Code config that holds MCP server env vars. -The config is read at server-spawn time and cached by mtime." - :type 'file - :group 'cj/ai-mcp) - -(defconst cj/mcp-server-specs - '((:name "linear" - :transport http - :url "https://mcp.linear.app/mcp" - :auth in-protocol - :risk write-capable) - (:name "notion" - :transport http - :url "https://mcp.notion.com/mcp" - :auth in-protocol - :risk write-capable) - (:name "figma" - :transport stdio - :command "npx" - :args ("-y" "figma-developer-mcp" "--stdio") - :secret-args ("--figma-api-key" :figma-api-key) - :auth args-token - :risk arg-leak) - (:name "slack-deepsat" - :transport sse - :url "http://127.0.0.1:13080/sse" - :auth local - :risk write-capable) - (:name "drawio" - :transport stdio - :command "npx" - :args ("-y" "@drawio/mcp") - :auth none - :risk none) - (:name "google-calendar" - :transport stdio - :command "npx" - :args ("-y" "@cocal/google-calendar-mcp") - :env (:GOOGLE_OAUTH_CREDENTIALS t) - :auth oauth - :risk write-capable) - (:name "google-docs-personal" - :transport stdio - :command "npx" - :args ("-y" "@a-bonus/google-docs-mcp") - :env (:GOOGLE_CLIENT_ID t :GOOGLE_CLIENT_SECRET t :GOOGLE_MCP_PROFILE t) - :auth oauth - :risk write-capable) - (:name "google-docs-work" - :transport stdio - :command "npx" - :args ("-y" "@a-bonus/google-docs-mcp") - :env (:GOOGLE_CLIENT_ID t :GOOGLE_CLIENT_SECRET t :GOOGLE_MCP_PROFILE t) - :auth oauth - :risk write-capable) - (:name "google-keep" - :transport stdio - :command "uvx" - :args ("--from" "keep-mcp" "python" "-m" "server.cli") - :env (:GOOGLE_EMAIL t :GOOGLE_MASTER_TOKEN t) - :auth token - :risk write-capable)) - "Static, secret-free description of the MCP servers we wire to GPTel. -Each entry is a plist describing one server. `:env' values are -placeholders (t) replaced at spawn time from `cj/mcp-claude-config'. -`:secret-args' (e.g. for figma) names the flag whose value is pulled -from the Claude config's args at spawn time.") - -(defcustom cj/mcp-enabled-servers - (mapcar (lambda (s) (plist-get s :name)) cj/mcp-server-specs) - "List of MCP server names to start. -Defaults to every server in `cj/mcp-server-specs'. Set to a -shorter list to disable specific servers without editing the -spec. Changes take effect on next `cj/mcp-restart-failed' or -Emacs restart." - :type '(repeat string) - :group 'cj/ai-mcp) - -(defcustom cj/mcp-start-on-entry-points - '(toggle-gptel) - "GPTel entry points that trigger MCP startup. -Symbols correspond to commands: `toggle-gptel', `gptel-send', -`gptel-quick-ask', `gptel-rewrite-with-directive', -`gptel-magit-generate-message'. Default: only full chat -\(`toggle-gptel')." - :type '(repeat symbol) - :group 'cj/ai-mcp) - -(defcustom cj/mcp-startup-timeout 30 - "Seconds before a still-starting MCP server is marked failed." - :type 'integer - :group 'cj/ai-mcp) - -(defcustom cj/mcp-tool-timeout 60 - "Seconds before an in-flight MCP tool call times out." - :type 'integer - :group 'cj/ai-mcp) - -(defcustom cj/mcp-tool-confirm-overrides nil - "Per-tool confirmation overrides. -Alist mapping fully qualified MCP tool name (e.g., -\"mcp__linear__create_issue\") to t or nil. Wins over the -pattern-based classifier in `cj/mcp--confirm-p'." - :type '(alist :key-type string :value-type boolean) - :group 'cj/ai-mcp) - -(defcustom cj/mcp-tool-audit-log-enabled t - "When non-nil, append metadata for every MCP tool call to the audit log." - :type 'boolean - :group 'cj/ai-mcp) - -;; Classifier patterns: name prefixes that indicate read vs write. - -(defconst cj/mcp--write-name-patterns - '("\\`create\\b" "\\`update\\b" "\\`delete\\b" "\\`remove\\b" - "\\`send\\b" "\\`post\\b" "\\`add\\b" "\\`move\\b" - "\\`invite\\b" "\\`share\\b" "\\`upload\\b" "\\`set\\b" - "\\`patch\\b" "\\`import\\b" "\\`sync\\b" "\\`merge\\b" - "\\`close\\b" "\\`reopen\\b" "\\`archive\\b" "\\`unarchive\\b" - "\\`approve\\b" "\\`reject\\b" "\\`label\\b" "\\`assign\\b" - "\\`reply\\b" "\\`comment\\b" "\\`trash\\b" "\\`restore\\b" - "\\`pin\\b" "\\`unpin\\b" "\\`copy\\b" "\\`rename\\b") - "Tool-name prefixes that indicate a write/mutate operation. -Matched after the `mcp__SERVER__' prefix is stripped.") - -(defconst cj/mcp--read-name-patterns - '("\\`get\\b" "\\`list\\b" "\\`read\\b" "\\`search\\b" - "\\`find\\b" "\\`fetch\\b" "\\`view\\b" "\\`query\\b" - "\\`describe\\b" "\\`show\\b" "\\`check\\b") - "Tool-name prefixes that indicate a read-only operation.") - -;; Secret-pattern list for redaction. Each entry is (REGEX -;; . GROUP-NUMBER); the substring matched by GROUP-NUMBER is replaced -;; with "***". - -(defconst cj/mcp--secret-redaction-patterns - '(("\\(--token\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(--secret\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(--password\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(--figma-api-key\\)\\(=\\|\\s-+\\)\\(\\S-+\\)" . 3) - ("\\(Authorization:\\s-*\\)\\(\\S-[^\"\n]*\\)" . 2) - ("\\([?&]token=\\)\\([^&[:space:]\"]+\\)" . 2)) - "List of (REGEX . GROUP-NUMBER) for masking secrets in user-facing strings. -Applied in order by `cj/mcp--redact'.") - -;;;; --- 3. Pure helpers ----------------------------------------------- - -;; ---- secrets redaction ---- - -(defun cj/mcp--redact (str) - "Return STR with known secret patterns replaced by `***'. -Returns nil when STR is not a string. See -`cj/mcp--secret-redaction-patterns' for the matched patterns." - (when (stringp str) - (let ((result str)) - (dolist (entry cj/mcp--secret-redaction-patterns result) - (let ((re (car entry)) - (group (cdr entry)) - (start 0)) - (while (and (< start (length result)) - (string-match re result start)) - (setq result - (concat (substring result 0 (match-beginning group)) - "***" - (substring result (match-end group)))) - (setq start (+ (match-beginning group) 3)))))))) - -;; ---- confirm-policy classifier ---- - -(defun cj/mcp--strip-name-prefix (name) - "Strip the `mcp__SERVER__' prefix from NAME, if present." - (replace-regexp-in-string "\\`mcp__[^_]+__" "" name)) - -(defun cj/mcp--name-matches-p (name patterns) - "Non-nil if NAME matches any regexp in PATTERNS." - (cl-some (lambda (p) (string-match-p p name)) patterns)) - -(defun cj/mcp--confirm-p (gptel-name &optional remote-name) - "Return non-nil if a tool should register with `:confirm t'. -GPTEL-NAME is the fully qualified `mcp__SERVER__TOOL' string. -REMOTE-NAME, if provided, overrides the prefix-strip of GPTEL-NAME. - -Decision order: -1. `cj/mcp-tool-confirm-overrides' alist entry wins. -2. Bare name matches a write pattern → t. -3. Bare name matches a read pattern → nil. -4. Neither → t (fail closed)." - (let ((override (assoc gptel-name cj/mcp-tool-confirm-overrides))) - (cond - (override (cdr override)) - (t - (let ((bare (or remote-name (cj/mcp--strip-name-prefix gptel-name)))) - (cond - ((cj/mcp--name-matches-p bare cj/mcp--write-name-patterns) t) - ((cj/mcp--name-matches-p bare cj/mcp--read-name-patterns) nil) - (t t))))))) - -;; ---- description normalizer ---- - -(defun cj/mcp--normalize-description (server-name raw-tool) - "Return a normalized description string for RAW-TOOL from SERVER-NAME. -Prefix `[SERVER]' for reads, `[SERVER WRITE]' for writes, -`[SERVER ?]' for unknown classification, then the upstream -description unchanged." - (let* ((remote-name (plist-get raw-tool :name)) - (upstream (or (plist-get raw-tool :description) - "(no description provided by server)")) - (suffix (cond - ((cj/mcp--name-matches-p remote-name - cj/mcp--write-name-patterns) - " WRITE") - ((cj/mcp--name-matches-p remote-name - cj/mcp--read-name-patterns) - "") - (t " ?")))) - (format "[%s%s] %s" server-name suffix upstream))) - -;; ---- Claude config reader (mtime-cached, structured returns) ---- - -(defvar cj/mcp--config-cache nil - "Cache for the parsed Claude config. -Plist of (:path P :mtime M :data PARSED) or nil when empty.") - -(defun cj/mcp--invalidate-config-cache () - "Force the next `cj/mcp--read-claude-config' call to reparse." - (setq cj/mcp--config-cache nil)) - -(defun cj/mcp--read-claude-config (&optional path) - "Return a structured plist describing the Claude config state. -PATH defaults to `cj/mcp-claude-config'. - -Result shape: - (:ok t :data PLIST) - (:ok nil :reason missing-file) - (:ok nil :reason unreadable) - (:ok nil :reason malformed-json :message STR) - -The parsed result is cached by (PATH, MTIME); subsequent calls -reparse only if the file has changed." - (let ((path (or path cj/mcp-claude-config))) - (cond - ((not (file-exists-p path)) - (list :ok nil :reason 'missing-file)) - ((not (file-readable-p path)) - (list :ok nil :reason 'unreadable)) - (t - (let ((mtime (file-attribute-modification-time - (file-attributes path)))) - (if (and cj/mcp--config-cache - (equal (plist-get cj/mcp--config-cache :path) path) - (equal (plist-get cj/mcp--config-cache :mtime) mtime)) - (list :ok t :data (plist-get cj/mcp--config-cache :data)) - (condition-case err - (let* ((json-object-type 'plist) - (json-array-type 'list) - (data (with-temp-buffer - (insert-file-contents path) - (goto-char (point-min)) - (json-read)))) - (setq cj/mcp--config-cache - (list :path path :mtime mtime :data data)) - (list :ok t :data data)) - (error - (setq cj/mcp--config-cache nil) - (list :ok nil :reason 'malformed-json - :message (error-message-string err)))))))))) - -;; ---- env / secret-args resolution ---- - -(defun cj/mcp--get-server-entry (server-name &optional config-result) - "Return the parsed Claude-config entry plist for SERVER-NAME. -CONFIG-RESULT, if provided, is a return value from -`cj/mcp--read-claude-config' (avoids re-reading). Returns nil -when the config is unavailable or SERVER-NAME is unknown." - (let ((result (or config-result (cj/mcp--read-claude-config)))) - (when (plist-get result :ok) - (let* ((data (plist-get result :data)) - (servers (plist-get data :mcpServers)) - (server-key (intern (concat ":" server-name)))) - (plist-get servers server-key))))) - -(defun cj/mcp--get-env (server-name &optional config-result) - "Return the env plist for SERVER-NAME from the parsed Claude config. -CONFIG-RESULT, if provided, is reused to avoid re-reading the -config. Returns nil when the config is unavailable, the server -is unknown, or the server has no env section." - (plist-get (cj/mcp--get-server-entry server-name config-result) :env)) - -(defun cj/mcp--get-secret-arg (server-name flag &optional config-result) - "Return the secret value for SERVER-NAME's FLAG from the Claude config. -FLAG is the option name (e.g. \"--figma-api-key\"). Returns the -value following `FLAG=' in the server entry's args, or nil if -not found." - (let* ((entry (cj/mcp--get-server-entry server-name config-result)) - (args (plist-get entry :args)) - (prefix (concat flag "="))) - (cl-some - (lambda (a) - (when (and (stringp a) (string-prefix-p prefix a)) - (substring a (length prefix)))) - args))) - -;; ---- server-alist builder (pure transform from specs + config) ---- - -(defun cj/mcp--resolve-env (env-spec server-name config-result) - "Return a flat (KEY1 VAL1 KEY2 VAL2 ...) list for ENV-SPEC. -ENV-SPEC is a plist of `(:VAR1 t :VAR2 t)`. Values come from -SERVER-NAME's env subtree in the parsed Claude config. Vars -without a value are omitted." - (let ((source-env (cj/mcp--get-env server-name config-result)) - (result nil)) - (cl-loop for (key _placeholder) on env-spec by #'cddr - do (let ((value (plist-get source-env key))) - (when value - (push key result) - (push value result)))) - (nreverse result))) - -(defun cj/mcp--resolve-args (args secret-args-spec server-name config-result) - "Return ARGS with `:secret-args' placeholders filled in. -SECRET-ARGS-SPEC is (FLAG-STRING SLOT-KEYWORD). When the value is -available in the Claude config, append `FLAG=VALUE' to ARGS; -otherwise return ARGS unchanged." - (if (not secret-args-spec) - args - (let* ((flag (car secret-args-spec)) - (value (cj/mcp--get-secret-arg server-name flag config-result))) - (if value - (append args (list (format "%s=%s" flag value))) - args)))) - -(defun cj/mcp--spec-to-alist-entry (spec config-result) - "Translate one SPEC plist into a `(NAME . PLIST)' alist entry. -Pulls env values from CONFIG-RESULT; splices `:secret-args' into -`:args' for stdio specs that declare one." - (let* ((name (plist-get spec :name)) - (transport (plist-get spec :transport)) - (entry (list :type (symbol-name transport))) - (env-spec (plist-get spec :env)) - (secret-args-spec (plist-get spec :secret-args))) - (pcase transport - ('stdio - (setq entry (append entry - (list :command (plist-get spec :command) - :args (cj/mcp--resolve-args - (plist-get spec :args) - secret-args-spec - name - config-result))))) - ((or 'http 'sse) - (setq entry (append entry - (list :url (plist-get spec :url)))))) - (when env-spec - (let ((env-pairs (cj/mcp--resolve-env env-spec name config-result))) - (when env-pairs - (setq entry (append entry (list :env env-pairs)))))) - (cons name entry))) - -(defun cj/mcp--build-server-alist (&optional specs enabled-names config-result) - "Return an alist suitable for `mcp-hub-servers'. -SPECS defaults to `cj/mcp-server-specs'. ENABLED-NAMES defaults -to `cj/mcp-enabled-servers'. CONFIG-RESULT, if provided, is a -parsed Claude-config result (reused for env/secret resolution). -Does not mutate SPECS." - (let* ((specs (or specs cj/mcp-server-specs)) - (enabled-names (or enabled-names cj/mcp-enabled-servers)) - (config-result (or config-result (cj/mcp--read-claude-config)))) - (delq nil - (mapcar - (lambda (spec) - (let ((name (plist-get spec :name))) - (when (member name enabled-names) - (cj/mcp--spec-to-alist-entry spec config-result)))) - specs)))) - -(provide 'ai-mcp) -;;; ai-mcp.el ends here diff --git a/modules/ai-quick-ask.el b/modules/ai-quick-ask.el deleted file mode 100644 index 16f3afae4..000000000 --- a/modules/ai-quick-ask.el +++ /dev/null @@ -1,141 +0,0 @@ -;;; ai-quick-ask.el --- One-shot GPTel quick-ask -*- lexical-binding: t; coding: utf-8; -*- - -;; Author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; Provides `cj/gptel-quick-ask': read a single prompt in the -;; minibuffer, stream the response into a transient *GPTel-Quick* -;; buffer. The transient buffer is dismissible with q or escape and -;; can be escalated with c into a full *AI-Assistant* conversation -;; seeded with the prompt + response. -;; -;; Designed for impromptu help where the conversation thread doesn't -;; matter. Doesn't touch the *AI-Assistant* side window unless the -;; user explicitly escalates, doesn't autosave anywhere. - -;;; Code: - -(require 'cj-window-toggle-lib) ;; cj/side-window-display - -;; Shared *AI-Assistant* panel-width state, owned by ai-config.el. Forward- -;; declared here so the escalation reopens the panel at the same remembered -;; width as the F-key toggle without a circular require. -(defvar cj/ai-assistant-window-width) -(defvar cj/--ai-assistant-width) - -(defvar-local cj/gptel-quick--prompt nil - "Buffer-local: the prompt used for the current *GPTel-Quick* session.") - -(defconst cj/gptel-quick--buffer-name "*GPTel-Quick*" - "Buffer used for one-shot quick-ask Q&A.") - -(defconst cj/gptel-quick--response-marker "A: " - "String inserted before the response in the quick-ask buffer.") - -(defvar-keymap cj/gptel-quick-mode-map - :doc "Keymap for `cj/gptel-quick-mode'." - "q" #'cj/gptel-quick-dismiss - "<escape>" #'cj/gptel-quick-dismiss - "c" #'cj/gptel-quick-continue) - -(define-derived-mode cj/gptel-quick-mode special-mode "GPTel-Quick" - "Major mode for the one-shot *GPTel-Quick* buffer." - ;; Allow gptel-request to stream into the buffer despite the - ;; special-mode read-only default. - (setq-local buffer-read-only nil)) - -(defun cj/gptel-quick--initial-text (prompt) - "Return the initial buffer body for a quick-ask of PROMPT. -The result is \"Q: <prompt>\\n\\nA: \", with the response marker at -the end so the streamed response lands right after it." - (format "Q: %s\n\n%s" prompt cj/gptel-quick--response-marker)) - -(defun cj/gptel-quick--extract-response (text) - "Return the response portion of TEXT, or nil if not found. -TEXT is the contents of a *GPTel-Quick* buffer. The response is -everything after the first occurrence of `cj/gptel-quick--response-marker' -on its own line. Returns nil when the marker is absent." - (when (string-match - (concat "^" (regexp-quote cj/gptel-quick--response-marker)) - text) - (substring text (match-end 0)))) - -(defun cj/gptel-quick--seed-text (prompt response) - "Format a *AI-Assistant* seed from PROMPT and RESPONSE. -Matches the org-heading shape that `cj/gptel--fresh-org-prefix' and -`cj/gptel-insert-model-heading' produce: a user heading followed by -the prompt body, followed by an AI heading followed by the response." - (let ((ts (format-time-string "[%Y-%m-%d %H:%M:%S]"))) - (format "* %s %s\n%s\n\n* AI %s\n%s\n" - user-login-name ts prompt - ts (or response "")))) - -;;;###autoload -(defun cj/gptel-quick-ask (prompt) - "Read a one-shot PROMPT in the minibuffer and stream the answer. -The response lands in a transient *GPTel-Quick* buffer. Press q or -escape to dismiss, or c to escalate into a full *AI-Assistant* -conversation seeded with the prompt and response." - (interactive (list (read-string "Quick ask: "))) - (when (string-empty-p prompt) - (user-error "Empty prompt")) - (let ((buf (get-buffer-create cj/gptel-quick--buffer-name))) - (with-current-buffer buf - (cj/gptel-quick-mode) - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (cj/gptel-quick--initial-text prompt)) - (setq-local cj/gptel-quick--prompt prompt))) - (unless (featurep 'gptel) - (require 'gptel)) - (when (fboundp 'cj/ensure-gptel-backends) - (cj/ensure-gptel-backends)) - (gptel-request prompt - :buffer buf - :position (with-current-buffer buf (point-max)) - :stream t) - (display-buffer buf - '((display-buffer-reuse-window - display-buffer-pop-up-window) - (window-height . 0.3))) - buf)) - -(defun cj/gptel-quick-dismiss () - "Kill the *GPTel-Quick* buffer if it exists." - (interactive) - (when-let ((buf (get-buffer cj/gptel-quick--buffer-name))) - (when-let ((win (get-buffer-window buf))) - (delete-window win)) - (kill-buffer buf))) - -(defun cj/gptel-quick-continue () - "Escalate the current quick-ask into a full *AI-Assistant* conversation. -Reads the prompt and response from the *GPTel-Quick* buffer, seeds -them into *AI-Assistant* under proper org headings, displays the -side window, then dismisses the quick buffer." - (interactive) - (unless (eq major-mode 'cj/gptel-quick-mode) - (user-error "Not in a *GPTel-Quick* buffer")) - (let* ((prompt cj/gptel-quick--prompt) - (response (cj/gptel-quick--extract-response (buffer-string))) - (seed (cj/gptel-quick--seed-text prompt response))) - (unless prompt - (user-error "No prompt recorded in this buffer")) - ;; Ensure *AI-Assistant* exists in gptel-mode. - (unless (featurep 'gptel) - (require 'gptel)) - (let ((ai-buf (get-buffer "*AI-Assistant*"))) - (unless ai-buf - (when (fboundp 'cj/ensure-gptel-backends) - (cj/ensure-gptel-backends)) - (gptel "*AI-Assistant*") - (setq ai-buf (get-buffer "*AI-Assistant*"))) - (with-current-buffer ai-buf - (goto-char (point-max)) - (insert seed)) - (cj/side-window-display - ai-buf 'right 'cj/--ai-assistant-width cj/ai-assistant-window-width) - (cj/gptel-quick-dismiss)))) - -(provide 'ai-quick-ask) -;;; ai-quick-ask.el ends here diff --git a/modules/ai-rewrite.el b/modules/ai-rewrite.el deleted file mode 100644 index fb25c1379..000000000 --- a/modules/ai-rewrite.el +++ /dev/null @@ -1,108 +0,0 @@ -;;; ai-rewrite.el --- Directive-picker wrappers for gptel-rewrite -*- lexical-binding: t; coding: utf-8; -*- - -;; Author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; Adds two ergonomic wrappers around `gptel-rewrite': -;; -;; cj/gptel-rewrite-with-directive Pick a named directive, -;; then rewrite the region. -;; cj/gptel-rewrite-redo-with-different-directive -;; Re-run the previous region -;; with a different directive. -;; -;; A directive is a short system-message snippet attached to a name -;; (e.g. "terse", "fix-grammar"). The directive body is injected -;; into the rewrite via `gptel-rewrite-directives-hook' just for that -;; call -- no global state changes. - -;;; Code: - -;; Declare the hook variable special so our `let'-binding below is -;; dynamic (visible across the `call-interactively' that follows) -;; rather than lexical when this file is byte-compiled. -(defvar gptel-rewrite-directives-hook) - -(defcustom cj/gptel-rewrite-directives - '(("terse" - . "Rewrite the text to be as terse as possible without losing meaning.\nDo not add commentary. Return only the rewritten text.") - ("fix-grammar" - . "Fix grammar and spelling errors only. Do not rephrase, restructure,\nor change tone. Return only the corrected text.") - ("refactor-readability" - . "Refactor the code for readability. Improve naming, split long\nfunctions when appropriate, remove unnecessary complexity, and preserve\nbehavior exactly. Return only the refactored code.") - ("add-docstring" - . "Add or improve docstrings for every function in the region. Use the\nidiomatic docstring style for the language. Do not change executable\ncode. Return the whole region with the updated docstrings.") - ("explain-as-comment" - . "Replace the region with the original code, preceded by a concise\nblock comment explaining what the code does. Use the language's\nidiomatic comment syntax. Return code + comment, nothing else.") - ("shorten" - . "Shorten the text while preserving meaning, technical accuracy, and\nthe author's voice. Remove rhetorical padding. Return only the\nshortened text.")) - "Named system-message directives for `cj/gptel-rewrite-with-directive'. -Each entry is a (NAME . BODY) pair where NAME is the directive label -presented in the completing-read prompt and BODY is the system -message injected into the next `gptel-rewrite' call." - :type '(alist :key-type string :value-type string) - :group 'cj) - -(defvar-local cj/gptel-rewrite--last-region nil - "Cons (BEG-MARKER . END-MARKER) of the last directive-driven rewrite.") - -(defvar-local cj/gptel-rewrite--last-directive nil - "Name of the directive used in the last directive-driven rewrite.") - -(defun cj/gptel-rewrite--call-with-directive (directive-name beg end) - "Run `gptel-rewrite' over BEG..END with DIRECTIVE-NAME's system message. -Stores the region (as markers) and directive name on buffer-local -variables so `cj/gptel-rewrite-redo-with-different-directive' can -revisit them." - (let ((body (alist-get directive-name cj/gptel-rewrite-directives - nil nil #'equal))) - (unless body - (user-error "Unknown rewrite directive: %s" directive-name)) - (setq-local cj/gptel-rewrite--last-region - (cons (copy-marker beg) (copy-marker end))) - (setq-local cj/gptel-rewrite--last-directive directive-name) - (let ((gptel-rewrite-directives-hook - (cons (lambda () body) gptel-rewrite-directives-hook))) - (save-excursion - (goto-char beg) - (push-mark end t t) - (call-interactively #'gptel-rewrite))))) - -;;;###autoload -(defun cj/gptel-rewrite-with-directive (directive-name) - "Pick DIRECTIVE-NAME from `cj/gptel-rewrite-directives' and rewrite the region. -Requires an active region. The directive is applied only to this -call -- it does not modify global `gptel-directives'." - (interactive - (progn - (unless (use-region-p) - (user-error "No region selected")) - (list (completing-read - "Rewrite directive: " - (mapcar #'car cj/gptel-rewrite-directives) nil t)))) - (cj/gptel-rewrite--call-with-directive - directive-name (region-beginning) (region-end))) - -;;;###autoload -(defun cj/gptel-rewrite-redo-with-different-directive () - "Re-run the previous directive-driven rewrite with a different directive. -The region is restored from the markers captured at the last call; -the user picks a new directive from the remaining choices." - (interactive) - (unless cj/gptel-rewrite--last-region - (user-error "No previous rewrite to redo in this buffer")) - (let* ((beg-mk (car cj/gptel-rewrite--last-region)) - (end-mk (cdr cj/gptel-rewrite--last-region)) - (current cj/gptel-rewrite--last-directive) - (others (cl-remove - current - (mapcar #'car cj/gptel-rewrite-directives) - :test #'equal)) - (chosen (completing-read - (format "Re-rewrite with (was %s): " current) - others nil t))) - (cj/gptel-rewrite--call-with-directive - chosen (marker-position beg-mk) (marker-position end-mk)))) - -(provide 'ai-rewrite) -;;; ai-rewrite.el ends here diff --git a/modules/ai-term.el b/modules/ai-term.el index 1384f8124..6dfb669a9 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -1,4 +1,4 @@ -;;; ai-term.el --- In-Emacs AI-agent launcher with vertical-split terminal -*- lexical-binding: t; -*- +;;; ai-term.el --- AI-agent terminals backed by EAT and tmux -*- lexical-binding: t; -*- ;; Author: Craig Jennings <c@cjennings.net> @@ -7,62 +7,18 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D. ;; Load shape: eager. -;; Eager reason: registers four global keys for the AI-agent terminal launcher; a -;; command-loaded deferral candidate. -;; Top-level side effects: four global key bindings. -;; Runtime requires: cl-lib, seq, cj-window-geometry-lib, cj-window-toggle-lib, -;; host-environment. +;; Eager reason: binds M-SPC and the C-; a AI-agent prefix. +;; Top-level side effects: global M-SPC binding and C-; a prefix map. +;; Runtime requires: cl-lib, seq, window-toggle/geometry helpers, host-environment. ;; Direct test load: yes. ;; -;; Picks an AI-agent project (a dir under ~/.emacs.d, ~/code/*, or -;; ~/projects/* containing .ai/protocols.org), opens or reuses a terminal -;; buffer named "agent [<basename>]", sends the agent's startup -;; instruction to it, and routes the buffer to a side window via -;; display-buffer-alist. When the frame already has a window forming the -;; half the agent would occupy (a right column on a desktop, a bottom row -;; on a laptop), the agent reuses that slot rather than splitting a third -;; window in; toggling off restores the displaced buffer to the slot. -;; Otherwise placement is a host-aware split: a right-side split at 50% -;; width on a desktop, a bottom split at 75% height on a laptop (see -;; `cj/--ai-term-default-direction'). Multiple -;; projects produce multiple coexisting buffers that share the same -;; slot; switching among them is a buffer-switch, not a -;; kill-and-recreate. +;; Opens project-scoped AI agents in EAT buffers backed by tmux sessions. Project +;; candidates come from configured roots that contain .ai/protocols.org. ;; -;; Each project's agent runs inside a tmux session named -;; "<cj/ai-term-tmux-session-prefix><basename>" (default prefix "aiv-"). -;; The prefix lets `tmux ls' be filtered to AI-term's own sessions, so -;; after an Emacs crash the project picker can match surviving sessions -;; back to their directories: matched projects sort to the top of the -;; picker (flagged "[detached]" -- session alive, no Emacs buffer -- or -;; "[running]" when a live terminal buffer exists), the rest follow in -;; alphabetical order. -;; -;; Four F-key entry points: -;; -;; - F9 `cj/ai-term' -- DWIM dispatch. If an agent buffer is -;; currently displayed in this frame, F9 toggles it off: when it -;; took over an existing window (a reused slot) the buffer it -;; displaced returns to that slot, when it was split into its own -;; window that window is removed, and when it fills the frame it -;; is buried. Otherwise, if exactly one agent buffer is alive, -;; F9 re-displays it; if zero or two-plus are alive, F9 falls -;; through to the project picker. -;; - C-F9 `cj/ai-term-pick-project' -- always show the project -;; picker, even when an agent buffer is currently displayed. -;; Used when the user wants to start a new project session -;; instead of toggling the current one. -;; - M-F9 `cj/ai-term-close' -- gracefully close an agent: kill its -;; tmux session (stopping the agent process), then its terminal -;; buffer and window. Confirms first. Targets the current -;; agent, the sole live agent, or prompts among several. -;; - C-S-F9 `cj/ai-term-close' -- same close command, second binding. -;; (M-F9 is the primary; C-S-F9 may be swallowed by the -;; Wayland/PGTK layer on some machines.) -;; -;; Existing windmove (Shift-arrows) handles code <-> agent focus -;; toggling. Buffer-move (C-M-arrows) handles side-swap. Neither -;; needs anything new from this module. +;; Agent display reuses the host-appropriate side slot when possible, otherwise +;; splits right on desktop frames and below on laptop frames. Attached buffers +;; and detached tmux sessions share the same rotation; selecting a detached +;; agent recreates its EAT buffer and attaches to the live session. ;;; Code: @@ -71,17 +27,15 @@ (require 'cj-window-geometry-lib) (require 'cj-window-toggle-lib) (require 'host-environment) +(require 'keybindings) ;; provides cj/register-prefix-map (C-; a) -(declare-function ghostel "ghostel" (&optional arg)) -(declare-function ghostel-send-string "ghostel" (string)) -(declare-function ghostel--rebuild-semi-char-keymap "ghostel" ()) -(defvar ghostel-keymap-exceptions) -(defvar ghostel-mode-map) -(defvar ghostel-buffer-name) -(defvar ghostel-buffer-name-function) +(declare-function eat "eat" (&optional program arg)) +(declare-function cj/make-buffer-pattern-undead "undead-buffers") +(defvar eat-buffer-name) +(defvar eat-semi-char-mode-map) (defgroup ai-term nil - "In-Emacs AI-agent launcher with a vertical-split ghostel terminal." + "In-Emacs AI-agent launcher with a vertical-split EAT terminal." :group 'tools) (defcustom cj/ai-term-agent-command @@ -93,15 +47,6 @@ agent you run (aider, an open-source LLM TUI, etc.)." :type 'string :group 'ai-term) -(defvar cj/--ai-term-suppress-tmux nil - "When non-nil, the generic ghostel tmux-launch hook skips its auto-tmux step. - -ai-term dynamically binds this around `(ghostel)' so the hook in -term-config.el doesn't send a bare \"tmux\\n\" before the named -session launch command runs. The hook reads the variable via -`bound-and-true-p' so loading order between the two modules doesn't -matter.") - (defcustom cj/ai-term-project-roots (list (expand-file-name "~/.emacs.d")) "Directories that are themselves AI-agent projects. @@ -179,13 +124,47 @@ recently-selected first. Non-AI-term buffers are filtered out via `cj/--ai-term-buffer-p'." (seq-filter #'cj/--ai-term-buffer-p (buffer-list))) +(defun cj/--ai-term-next-agent-dir (current dirs) + "Return the project dir after CURRENT in DIRS, wrapping to the first. + +DIRS is an ordered list of active-agent project dirs. When CURRENT is +the last element, wrap to the first. When CURRENT is nil or not a member +of DIRS, return the first dir. Returns nil when DIRS is empty. Matches +with `member' (string equality) since dirs are paths. + +Pure decision helper (no buffer or window side effects) so the cycle +order driving `cj/ai-term-next' is exercisable in tests." + (when dirs + (if (member current dirs) + (or (cadr (member current dirs)) + (car dirs)) + (car dirs)))) + +(defun cj/--ai-term-active-agent-dirs () + "Return project dirs that have a live agent buffer or a live tmux session. + +Sorted by the agent buffer name, so the rotation is stable and matches +what the picker shows. This is the queue `cj/ai-term-next' steps through: +it includes detached sessions (alive in tmux but with no Emacs buffer), +which the step materializes by attaching." + (let* ((sessions (cj/--ai-term-live-tmux-sessions)) + (live-names (mapcar #'buffer-name (cj/--ai-term-agent-buffers)))) + (sort + (seq-filter + (lambda (dir) + (or (member (cj/--ai-term-buffer-name dir) live-names) + (cj/--ai-term-session-active-p dir sessions))) + (cj/--ai-term-candidates)) + (lambda (a b) + (string< (cj/--ai-term-buffer-name a) (cj/--ai-term-buffer-name b)))))) + (defun cj/--ai-term-most-recent-non-agent-buffer () "Return the most-recently-selected live non-agent buffer, or nil. Walks `buffer-list' (most-recently-selected first) and returns the first buffer that is not an AI-term agent buffer (per `cj/--ai-term-buffer-p') and is not an internal buffer (name starting -with a space). Used by the single-window F9 toggle-off so dismissing a +with a space). Used by the single-window toggle-off so dismissing a full-frame agent returns to the file the user was working in (e.g. todo.org) rather than swapping in another agent." (seq-find (lambda (b) @@ -257,7 +236,7 @@ looked up in SESSIONS, so the lossy whitespace->hyphen transform in (defun cj/--ai-term-launch-command (dir) "Return the shell command line that runs the AI tool in a project tmux session. -Uses `tmux new-session -A' so a second F9 on the same project reattaches +Uses `tmux new-session -A' so a second toggle on the same project reattaches to the running session instead of spawning a new one. The session name comes from `cj/--ai-term-tmux-session-name'; the first window is named `cj/ai-term-tmux-window-name' (default \"ai\") so a later hand-opened @@ -389,22 +368,26 @@ fallback when `cj/--ai-term-last-size' is nil." :type 'number :group 'ai-term) -(defun cj/--ai-term-default-direction () - "Return the host-appropriate default split direction for the agent window. +(defun cj/--ai-term-default-direction (&optional frame) + "Return the default split direction for the agent window. -`below' on a laptop (bottom horizontal split), `right' on a desktop -(right-side vertical split). Detected via `env-laptop-p'." - (if (env-laptop-p) 'below 'right)) +Chosen at display time from FRAME's column width (FRAME defaults to the +selected frame): `right' when a side-by-side split would leave both the +agent and the main window at least `cj/window-dock-min-columns' wide, +`below' otherwise. The agent's share of the width is +`cj/ai-term-desktop-width'. See `cj/preferred-dock-direction'." + (let ((frame (or frame (selected-frame)))) + (cj/preferred-dock-direction (frame-width frame) + cj/ai-term-desktop-width))) (defun cj/--ai-term-default-size () - "Return the host-appropriate default size fraction for the agent window. + "Return the default size fraction paired with the chosen direction. -`cj/ai-term-laptop-height' on a laptop, `cj/ai-term-desktop-width' -on a desktop -- pairing with the axis chosen by -`cj/--ai-term-default-direction'." - (if (env-laptop-p) - cj/ai-term-laptop-height - cj/ai-term-desktop-width)) +`cj/ai-term-desktop-width' (a width fraction) when the default direction is +`right', `cj/ai-term-laptop-height' (a height fraction) when it is `below'." + (if (eq (cj/--ai-term-default-direction) 'right) + cj/ai-term-desktop-width + cj/ai-term-laptop-height)) (defvar cj/--ai-term-last-direction nil "Last user-chosen direction for the AI-term display. @@ -418,7 +401,7 @@ direction applies. Captured at toggle-off by `cj/--ai-term-display-saved'.") (defvar cj/--ai-term-last-was-bury nil - "Non-nil when the last F9 toggle-off used `bury-buffer'. + "Non-nil when the last toggle-off used `bury-buffer'. Set by `cj/ai-term' in its `toggle-off' branch: t when the agent window was the only window in the frame (so toggle-off buried @@ -427,8 +410,20 @@ without deleting), nil when the window was deleted. Consumed by buried agent in the current window (the only one) or splitting per the saved direction.") +(defvar cj/--ai-term-last-toggle-deleted-split nil + "Non-nil when the last toggle-off deleted the agent's own split window. + +Set t by `cj/--ai-term-toggle-off' only when it actually `delete-window's +the agent (a multi-window layout where the agent had its own window); +nil for a bury or a degenerate swap. Consumed by +`cj/--ai-term-reuse-edge-window': when set, the next toggle-on re-splits a +fresh agent window instead of reusing a window at the edge. Without this, +toggling the agent off and on in a 3+ window layout would reuse the user's +working window at the edge, displacing its buffer and collapsing the layout +-- the toggle must be reversible (off then on returns the same windows).") + (defvar cj/--ai-term-last-hidden-buffer nil - "The agent buffer hidden by the most recent F9 toggle-off. + "The agent buffer hidden by the most recent toggle-off. Captured in `cj/ai-term' just before an agent window is torn down, and consumed by `cj/--ai-term-dispatch' so the next toggle-on reopens the @@ -439,21 +434,28 @@ the \"the displayed buffer changes\" bug. Falls back to the buffer-list MRU when nil or when the remembered buffer has been killed.") (defvar cj/--ai-term-last-size nil - "Last user-chosen body size for the AI-term display. + "Last user-chosen size for the AI-term display. Positive integer: body-columns when `cj/--ai-term-last-direction' -is right or left, body-lines when below or above. nil means use +is right or left, total-lines when below or above. nil means use the host-aware default from `cj/--ai-term-default-size' (a float -fraction). - -Body size, not total size, because total-width includes the -right-edge divider when the window has a right sibling but excludes -it when the window is at the frame edge. Capturing total-width -from a rightmost agent (no divider) and replaying into a middle -position (with divider) leaves the body 1 column short -- visible -as 1 col of the sibling buffer peeking through where agent should -have ended. Body-width is divider-independent and matches what the -user actually sees. +fraction). See `cj/window-replay-size' for the per-axis capture. + +The axis choice is asymmetric. Width captures body-width, not +total-width: total-width includes the right-edge divider when the +window has a right sibling but excludes it at the frame edge, so +capturing total-width from a rightmost agent (no divider) and +replaying into a middle position (with divider) leaves the body 1 +column short. Body-width is divider-independent. + +Height captures total-height, not body-height: every window has +exactly one mode line regardless of position, so total-height has +no divider-position problem, and total-height is the same whether +the window is active or inactive. Body-height would subtract the +mode line's pixel height, which differs between an active and an +inactive (theme-shrunk) mode line -- capturing body-height active +and replaying it inactive then re-measuring active drifts the +window down by ~1 line per toggle (the F9 shrink bug, 2026-06-20). Absolute values rather than fractions because `display-buffer-in-direction' interprets a float `window-width' / @@ -463,11 +465,24 @@ and a fraction-of-frame produces the wrong size on replay (squeezes the other windows). An integer is unambiguous, at the cost of not auto-scaling if the frame itself resizes.") +(defvar cj/--ai-term-last-fullscreen nil + "Non-nil when the agent window was last seen filling its frame. + +Maintained by `cj/--ai-term-track-geometry' on +`window-configuration-change-hook': set t whenever a live agent window is +the sole window in its frame, cleared when the agent is shown as a split +\(its dock direction and size are captured then instead). Consulted by +`cj/--ai-term-display-saved' so a summon into a single-window frame +restores the agent fullscreen rather than docking it -- the sole-window +state isn't a representable dock size, so this flag is how it round-trips. +Unlike `cj/--ai-term-last-was-bury' it does not depend on a toggle-off, so +it also covers leaving the agent by switching buffers or `C-x 1'.") + (defun cj/--ai-term-capture-state (window) "Capture WINDOW's direction and size into module-level state. Sets `cj/--ai-term-last-direction' and `cj/--ai-term-last-size' -so a subsequent F9 display can restore the user's chosen orientation +so a subsequent display can restore the user's chosen orientation and size. Called at toggle-off (just before the window is torn down). The default direction is host-aware via `cj/--ai-term-default-direction' (used only when WINDOW fills its @@ -479,6 +494,35 @@ is not live." 'cj/--ai-term-last-size '(right below left))) +(defun cj/--ai-term-window-sole-p (window) + "Return non-nil when WINDOW is the only live window in its frame. +A frame's sole window is its root window; once split, the root is an +internal window and no live window equals it." + (and (window-live-p window) + (eq window (frame-root-window (window-frame window))))) + +(defun cj/--ai-term-track-geometry (&rest _) + "Track whether the displayed agent window is fullscreen. + +Run from `window-configuration-change-hook'. Sets +`cj/--ai-term-last-fullscreen' to whether a live agent window is the sole +window in its frame, and leaves it untouched when no agent window is +displayed -- that retained value is the just-left state a later summon +replays. Dock direction and size stay owned by the toggle-off capture +\(`cj/--ai-term-capture-state'); this hook must not re-capture them, or the +repeated capture/replay drifts the dock height a couple rows per cycle." + (let ((win (cj/--ai-term-displayed-agent-window))) + (when (window-live-p win) + (setq cj/--ai-term-last-fullscreen (cj/--ai-term-window-sole-p win))))) + +(add-hook 'window-configuration-change-hook #'cj/--ai-term-track-geometry) + +;; Agent buffers ("agent [<project>]") are buried, not killed, by the +;; kill-all sweep (F1 / `cj/dashboard-only'). Register the family pattern so +;; every agent -- however and whenever created -- survives with its session. +(with-eval-after-load 'undead-buffers + (cj/make-buffer-pattern-undead "\\`agent \\[")) + (defun cj/--ai-term-reuse-existing-agent (buffer _alist) "Display-buffer action: reuse any window in this frame already showing an agent buffer. @@ -491,7 +535,7 @@ action in the chain runs. This is more specific than `display-buffer-use-some-window', which would happily steal any non-selected window (e.g. a code window above the agent split) when the user is focused in agent and -swaps projects via C-F9. The selective lookup here keeps non-agent +swaps projects via C-; a s. The selective lookup here keeps non-agent windows undisturbed and preserves the user's split geometry across project changes." (let ((win (cj/--ai-term-displayed-agent-window))) @@ -521,29 +565,45 @@ displaced buffer and the agent, never changing the window count. Runs after `cj/--ai-term-reuse-existing-agent', so an agent already on screen has been handled already; the window reused here always holds a -non-agent buffer, which is replaced (it stays alive, just unshown)." - (let* ((direction (or cj/--ai-term-last-direction - (cj/--ai-term-default-direction))) - (win (cj/window-at-edge direction))) - (when (and win (not (window-dedicated-p win))) - (display-buffer-record-window 'reuse win buffer) - (set-window-buffer win buffer) - win))) +non-agent buffer, which is replaced (it stays alive, just unshown). + +Skipped entirely when the prior toggle-off deleted the agent's own split +window (`cj/--ai-term-last-toggle-deleted-split'): re-showing then reuses a +working window at the edge and collapses the layout. Consume the flag and +return nil so `cj/--ai-term-display-saved' re-splits a fresh agent window, +keeping the toggle reversible." + (if cj/--ai-term-last-toggle-deleted-split + (progn (setq cj/--ai-term-last-toggle-deleted-split nil) nil) + (let* ((direction (or cj/--ai-term-last-direction + (cj/--ai-term-default-direction))) + (win (cj/window-at-edge direction))) + (when (and win (not (window-dedicated-p win))) + (display-buffer-record-window 'reuse win buffer) + (set-window-buffer win buffer) + win)))) (defun cj/--ai-term-display-saved (buffer alist) - "Display-buffer action: split per saved direction and size. + "Display-buffer action: restore fullscreen in a single-window frame, +otherwise split per saved direction and size. -When the prior toggle-off was a bury (single-window state, flagged -via `cj/--ai-term-last-was-bury') and the frame is still single- -window, restore the agent into the selected window in place rather -than splitting -- preserves the user's lone-window layout across -F9 toggles. +When the frame is a single window and the agent was last fullscreen +\(`cj/--ai-term-last-fullscreen', tracked by `cj/--ai-term-track-geometry') +or the prior toggle-off was a single-window bury +\(`cj/--ai-term-last-was-bury'), restore the agent into the selected window +in place rather than splitting. This round-trips a fullscreen agent -- +left by toggle-off, `C-x 1', or switching buffers -- since the sole-window +state isn't a representable dock size. Otherwise delegates to `cj/window-toggle-display-saved' against the -F9 state vars, falling back to the host-aware defaults from +toggle state vars, falling back to the host-aware defaults from `cj/--ai-term-default-direction' and `cj/--ai-term-default-size'." (cond - ((and cj/--ai-term-last-was-bury (one-window-p)) + ;; NOMINI t: don't count an active minibuffer as a second window. A summon + ;; can run with a picker prompt up, and a bare `one-window-p' then returns + ;; nil on a structurally single-window frame, misfiring the fullscreen + ;; restore into a dock -- which clears the fullscreen flag and cascades. + ((and (or cj/--ai-term-last-fullscreen cj/--ai-term-last-was-bury) + (one-window-p t)) (setq cj/--ai-term-last-was-bury nil) (let ((win (selected-window))) (set-window-buffer win buffer) @@ -566,7 +626,7 @@ through four actions in order: 2. `cj/--ai-term-reuse-existing-agent' -- otherwise, if any window in this frame already shows an agent-prefixed buffer, swap its buffer for the new one (preserves geometry across - project changes via C-F9). + project changes via C-; a s). 3. `cj/--ai-term-reuse-edge-window' -- otherwise, if the frame already has a window forming the half the agent would occupy (the right column on a desktop, the bottom row on a laptop), @@ -595,19 +655,26 @@ split) when the user is focused in agent and switches projects." (dolist (entry (cj/--ai-term-display-rule-list)) (add-to-list 'display-buffer-alist entry)) +(defun cj/--ai-term-send-string (buffer string) + "Send STRING to BUFFER's terminal process (the agent's shell). +Sends to the pty directly so the launch command reaches the shell EAT runs." + (let ((proc (get-buffer-process buffer))) + (when (process-live-p proc) + (process-send-string proc string)))) + (defun cj/--ai-term-show-or-create (dir name) "Show or create the AI-term buffer for project DIR with buffer NAME. If a buffer named NAME exists with a live process, display it. If the buffer exists but its process is dead, kill it and recreate. If -no such buffer exists, create a new ghostel terminal in DIR and send +no such buffer exists, create a new EAT terminal in DIR and send the project's tmux launch command (see `cj/--ai-term-launch-command') so the same project basename reattaches across Emacs restarts. -The dynamic binding of `cj/--ai-term-suppress-tmux' around `(ghostel)' -suppresses the generic tmux-launch hook in term-config.el so -it doesn't fire a bare \"tmux\\n\" before the project-named launch -command runs. +EAT runs a plain shell with no auto-tmux hook, so the named +`tmux new-session -A' launch command is the only thing that starts the +session -- the spike confirmed EAT + tmux detach and reattach exactly +like ghostel + tmux did. Records DIR in `cj/--ai-term-mru' (whichever branch runs) so the project picker can list recently-opened projects first. Returns the @@ -621,28 +688,22 @@ buffer." (t (when existing (kill-buffer existing)) - ;; `ghostel' switches to its buffer in the selected window before our + ;; `eat' switches to its buffer in the selected window before our ;; display-buffer-alist rule can route it; `save-window-excursion' ;; reverts that, and the explicit display-buffer below routes the buffer - ;; through the alist into the agent slot. `ghostel-buffer-name' is bound - ;; to NAME so the terminal is created under the agent name, and - ;; `ghostel-buffer-name-function' is pinned nil (dynamically during - ;; creation, then buffer-locally) so OSC title escapes from the agent - ;; don't rename it out from under the "agent [" prefix that buffer - ;; detection and the display rule key on. + ;; through the alist into the agent slot. `eat-buffer-name' is bound to + ;; NAME so the terminal is created under the agent name; EAT (unlike + ;; ghostel) does not rename the buffer from the terminal's OSC title, so + ;; the "agent [" prefix that buffer detection and the display rule key on + ;; stays put. (save-window-excursion (let ((default-directory dir) - (ghostel-buffer-name name) - (ghostel-buffer-name-function nil) - (cj/--ai-term-suppress-tmux t)) - (let ((buf (ghostel))) - (when (buffer-live-p buf) - (with-current-buffer buf - (setq-local ghostel-buffer-name-function nil)))))) + (eat-buffer-name name)) + (eat))) (let ((buf (get-buffer name))) (with-current-buffer buf - (ghostel-send-string (cj/--ai-term-launch-command dir)) - (ghostel-send-string "\n")) + (cj/--ai-term-send-string + buf (concat (cj/--ai-term-launch-command dir) "\n"))) (display-buffer buf) buf))))) @@ -711,17 +772,17 @@ Signals `user-error' when no candidates exist." (expand-file-name chosen))))) (defun cj/--ai-term-dispatch () - "Compute the F9 (`cj/ai-term') action without performing it. + "Compute the `cj/ai-term' (C-; a a) action without performing it. Returns one of: - (toggle-off . WINDOW) -- agent is displayed in WINDOW; quit it. - (redisplay-recent . BUFFER) -- 1+ alive agent buffers; show MRU. - (pick-project) -- zero alive agent buffers; prompt. -When 2+ agent buffers are alive, F9 redisplays the most-recently- -selected one rather than opening the project picker. C-F9 is the -explicit \"start a different project\" surface; M-F9 is the explicit -\"switch among existing agents\" surface. F9 keeps a single, simple +When 2+ agent buffers are alive, C-; a a redisplays the most-recently- +selected one rather than opening the project picker. C-; a s is the +explicit \"start a different project\" surface; C-; a n is the explicit +\"switch among existing agents\" surface. C-; a a keeps a single, simple job: toggle whichever agent was last in use. A pure-decision helper so the dispatch logic is exercisable in tests @@ -744,7 +805,7 @@ without firing real `display-buffer' or `quit-window' calls." (t '(pick-project)))))))) (defun cj/ai-term-pick-project (&optional arg) - "Pick an AI-agent project and open or reuse its ghostel terminal. + "Pick an AI-agent project and open or reuse its EAT terminal. The project is picked from a filtered completing-read list of dirs that contain .ai/protocols.org. The terminal buffer is named @@ -754,11 +815,11 @@ buffers; reinvoking on the same project reuses its existing terminal. With prefix ARG, display the buffer without selecting its window. -Bound to C-F9 -- always shows the project picker, even when an agent +Bound to C-; a s -- always shows the project picker, even when an agent buffer is currently displayed. -ghostel renders in terminal frames as well as GUI frames, so this -launches from either (only kitty inline-graphics degrade in a TTY)." +EAT renders in terminal frames as well as GUI frames, so this +launches from either." (interactive "P") (let* ((dir (cj/--ai-term-pick-project)) (name (cj/--ai-term-buffer-name dir)) @@ -768,74 +829,92 @@ launches from either (only kitty inline-graphics degrade in a TTY)." (when win (select-window win)))) buf)) +(defun cj/--ai-term-swap-to-working-buffer (win) + "In WIN, switch to the most-recent non-agent buffer (a working file). +Falls back to `other-buffer' (excluding WIN's current agent buffer) when no +non-agent buffer is on record. Used at toggle-off and close so dismissing an +agent surfaces the file the user was working on rather than another agent or +the agent itself." + (with-selected-window win + (switch-to-buffer + (or (cj/--ai-term-most-recent-non-agent-buffer) + (other-buffer (window-buffer win) t))))) + +(defun cj/--ai-term-toggle-off (win) + "Hide the agent shown in WIN for a toggle-off. Always returns nil. + +Two cases, by window count: + +- Lone fullscreen agent (e.g. after `C-x 1' inside it): there is no prior + layout for the native undo to restore and deleting would leave the frame + empty. Bury and flag, so the next toggle-on (`cj/--ai-term-display-saved') + restores the agent in place at full frame rather than splitting. Capture + geometry for that restore. `bury-buffer' can no-op when the window's + prev-buffer history holds only the agent (common right after `C-x 1'), so + force a swap to a non-agent buffer to keep the toggle observable. + +- Multi-window: collapse the agent split outright by deleting its window, so + the working buffer (e.g. todo.org) reclaims the space. The toggle is a pure + show/hide toggle of THE agent split -- it must never surface a different + agent. `quit-restore-window' can't guarantee that here: switching among + several agents reuses the one slot via `set-window-buffer' (see + `cj/--ai-term-reuse-existing-agent'), which leaves the window's + `quit-restore' parameter pointing at the FIRST agent shown. Once it's + stale, `quit-restore-window' falls back to `switch-to-prev-buffer' and + surfaces another agent instead of removing the window -- exactly the \"F9 + shows another agent\" bug. `delete-window' is unconditional and + slot-history-independent. Capture geometry first so the next toggle-on + splits at the same size (the user's chosen split width is preserved)." + ;; Remember which agent we're hiding so the next toggle-on reopens this + ;; same one, not whichever agent is most-recent in `buffer-list'. + (setq cj/--ai-term-last-hidden-buffer (window-buffer win)) + (cond + ((one-window-p) + (cj/--ai-term-capture-state win) + (setq cj/--ai-term-last-was-bury t) + (setq cj/--ai-term-last-toggle-deleted-split nil) + (bury-buffer (window-buffer win)) + (when (and (window-live-p win) + (cj/--ai-term-buffer-p (window-buffer win))) + (cj/--ai-term-swap-to-working-buffer win))) + (t + (cj/--ai-term-capture-state win) + (setq cj/--ai-term-last-was-bury nil) + (if (and (window-live-p win) + (> (length (window-list (window-frame win) 'never)) 1)) + (progn + (delete-window win) + ;; The agent had its own window in a multi-window layout, now gone: + ;; the next toggle-on must re-split it rather than reuse a working + ;; window at the edge (see `cj/--ai-term-reuse-edge-window'). + (setq cj/--ai-term-last-toggle-deleted-split t)) + ;; Degenerate fallback (window became sole between dispatch and + ;; here): swap to a non-agent buffer rather than leave the agent up. + (setq cj/--ai-term-last-toggle-deleted-split nil) + (when (window-live-p win) + (cj/--ai-term-swap-to-working-buffer win))))) + nil) + (defun cj/ai-term (&optional arg) - "Smart F9 dispatch for the AI-term launcher. + "DWIM dispatch for the AI-term launcher. Bound to C-; a a. Behavior depends on the current state: -- If an AI-term buffer is currently displayed in this frame, F9 +- If an AI-term buffer is currently displayed in this frame, it quits its window (toggle off, buffer stays alive). -- Else, if exactly one alive AI-term buffer exists, F9 re-displays +- Else, if exactly one alive AI-term buffer exists, it re-displays it (DWIM -- the obvious next step is to look at it). -- Else (zero or 2+), F9 falls through to `cj/ai-term-pick-project'. +- Else (zero or 2+), it falls through to `cj/ai-term-pick-project'. With prefix ARG, display the buffer without selecting its window when a buffer is being shown (no effect on the toggle-off branch). -See `cj/ai-term-pick-project' (C-F9) to force the project picker. -M-F9 (and C-S-F9) close an agent via `cj/ai-term-close'." +See `cj/ai-term-pick-project' (C-; a s) to force the project picker. +C-; a k closes an agent via `cj/ai-term-close'." (interactive "P") (pcase (cj/--ai-term-dispatch) (`(toggle-off . ,win) - ;; Remember which agent we're hiding so the next toggle-on reopens this - ;; same one, not whichever agent is most-recent in `buffer-list'. - (setq cj/--ai-term-last-hidden-buffer (window-buffer win)) - (cond - ;; Lone fullscreen agent (e.g. after `C-x 1' inside it): there is no - ;; prior layout for the native undo to restore and deleting would - ;; leave the frame empty. Bury and flag, so the next toggle-on - ;; (`cj/--ai-term-display-saved') restores the agent in place at - ;; full frame rather than splitting. Capture geometry for that - ;; restore. `bury-buffer' can no-op when the window's prev-buffer - ;; history holds only the agent (common right after `C-x 1'), so - ;; force a swap to a non-agent buffer to keep the toggle observable. - ((one-window-p) - (cj/--ai-term-capture-state win) - (setq cj/--ai-term-last-was-bury t) - (bury-buffer (window-buffer win)) - (when (and (window-live-p win) - (cj/--ai-term-buffer-p (window-buffer win))) - (with-selected-window win - (switch-to-buffer - (or (cj/--ai-term-most-recent-non-agent-buffer) - (other-buffer (window-buffer win) t)))))) - ;; Multi-window: collapse the agent split outright by deleting its - ;; window, so the working buffer (e.g. todo.org) reclaims the space. - ;; F9 is a pure show/hide toggle of THE agent split -- it must never - ;; surface a different agent. `quit-restore-window' can't guarantee - ;; that here: switching among several agents reuses the one slot via - ;; `set-window-buffer' (see `cj/--ai-term-reuse-existing-agent'), - ;; which leaves the window's `quit-restore' parameter pointing at the - ;; FIRST agent shown. Once it's stale, `quit-restore-window' falls - ;; back to `switch-to-prev-buffer' and surfaces another agent instead - ;; of removing the window -- exactly the "F9 shows another agent" - ;; bug. `delete-window' is unconditional and slot-history-independent. - ;; Capture geometry first so the next toggle-on splits at the same - ;; size (the user's chosen split width is preserved across the toggle). - (t - (cj/--ai-term-capture-state win) - (setq cj/--ai-term-last-was-bury nil) - (if (and (window-live-p win) - (> (length (window-list (window-frame win) 'never)) 1)) - (delete-window win) - ;; Degenerate fallback (window became sole between dispatch and - ;; here): swap to a non-agent buffer rather than leave the agent up. - (when (window-live-p win) - (with-selected-window win - (switch-to-buffer - (or (cj/--ai-term-most-recent-non-agent-buffer) - (other-buffer (window-buffer win) t)))))))) - nil) + (cj/--ai-term-toggle-off win)) (`(redisplay-recent . ,buf) (display-buffer buf) (unless arg @@ -859,12 +938,14 @@ down." (error nil))) (defun cj/--ai-term-close-buffer (buffer) - "Gracefully tear down AI-term BUFFER: tmux session, window, buffer. + "Gracefully tear down AI-term BUFFER: tmux session, then buffer. Derives the tmux session name from BUFFER's `default-directory' (the project dir the terminal was created in) and kills it so the agent -process stops. Deletes BUFFER's window when it's shown and isn't the -only window in its frame, then kills BUFFER (suppressing the +process stops. When BUFFER is shown, swaps its window to a non-agent +buffer (the working file) rather than deleting the window -- closing an +agent must not collapse the user's window layout; the hide toggle is +what collapses the split. Then kills BUFFER (suppressing the process-still-running prompt -- the session is already down). No-op when BUFFER isn't an AI-term buffer." (when (cj/--ai-term-buffer-p buffer) @@ -872,11 +953,13 @@ when BUFFER isn't an AI-term buffer." (cj/--ai-term-tmux-session-name (buffer-local-value 'default-directory buffer))) (let ((win (get-buffer-window buffer))) - (when (and win (> (length (window-list (window-frame win) 'never)) 1)) - (delete-window win))) + (when (window-live-p win) + (cj/--ai-term-swap-to-working-buffer win))) (let ((kill-buffer-query-functions nil)) (kill-buffer buffer)))) +(require 'system-lib) + (defun cj/--ai-term-close-target () "Return the AI-term buffer `cj/ai-term-close' should act on, or nil. @@ -891,7 +974,8 @@ buffers; nil when none are alive." ((null (cdr buffers)) (car buffers)) (t (get-buffer (completing-read "Close AI terminal: " - (mapcar #'buffer-name buffers) nil t)))))))) + (cj/completion-table 'buffer (mapcar #'buffer-name buffers)) + nil t)))))))) (defun cj/ai-term-close () "Gracefully close an AI-term agent: kill its tmux session and buffer. @@ -899,7 +983,7 @@ buffers; nil when none are alive." Targets the current agent buffer, the sole live agent, or prompts when several are alive (see `cj/--ai-term-close-target'). Asks for confirmation first -- this kills the running agent process, which can -interrupt work in progress. Bound to M-<f9> (primary) and C-S-<f9>." +interrupt work in progress. Bound to C-; a k." (interactive) (let ((buffer (cj/--ai-term-close-target))) (unless buffer @@ -910,31 +994,165 @@ interrupt work in progress. Bound to M-<f9> (primary) and C-S-<f9>." (cj/--ai-term-close-buffer buffer) (message "Closed agent %s." name))))) -(keymap-global-set "<f9>" #'cj/ai-term) -(keymap-global-set "C-<f9>" #'cj/ai-term-pick-project) -(keymap-global-set "M-<f9>" #'cj/ai-term-close) -(keymap-global-set "C-S-<f9>" #'cj/ai-term-close) - -;; ghostel's semi-char mode forwards keys not in `ghostel-keymap-exceptions' to -;; the terminal program, so a plain <f9> typed while point is inside an agent -;; buffer would be sent to the program instead of toggling the agent -- which -;; bites hard when the agent buffer is the only window in the frame. Re-bind -;; the F9 family in `ghostel-mode-map' so the toggle reaches Emacs from there -;; too. (C-<f9> / M-<f9> are bound here as well so the behaviour is uniform.) -(with-eval-after-load 'ghostel - (keymap-set ghostel-mode-map "<f9>" #'cj/ai-term) - (keymap-set ghostel-mode-map "C-<f9>" #'cj/ai-term-pick-project) - (keymap-set ghostel-mode-map "M-<f9>" #'cj/ai-term-close) - (keymap-set ghostel-mode-map "C-S-<f9>" #'cj/ai-term-close) - ;; The bindings above live in `ghostel-mode-map', but in semi-char mode - ;; ghostel's own `ghostel-semi-char-mode-map' forwards every key not in - ;; `ghostel-keymap-exceptions' to the pty -- and that map outranks the - ;; major-mode map, so it would swallow the F9 family before the bindings - ;; above fire. Add the family to the exceptions and rebuild the semi-char - ;; map so the keys fall through to `ghostel-mode-map' inside agent buffers. - (dolist (key '("<f9>" "C-<f9>" "M-<f9>" "C-S-<f9>")) - (add-to-list 'ghostel-keymap-exceptions key)) - (ghostel--rebuild-semi-char-keymap)) +;; ------------------------- Step to the next agent ---------------------------- + +(defun cj/ai-term-next () + "Step to the next open AI-term agent in the queue. + +The queue is every active agent ordered by buffer name -- a stable +rotation, unaffected by which agent was most recently selected. Active +means a live agent buffer (attached) OR a live tmux session with no Emacs +buffer (detached); stepping onto a detached agent attaches it (recreates +its terminal, which reattaches the session). When an agent window is on +screen, swap it to the next agent (wrapping after the last) and select it. +When no agent is displayed but agents exist, show the first. When none +are open, open the project picker to launch the first agent rather than +erroring. + +Bound to M-SPC. Unlike C-; a a (toggle the most-recent agent on/off), this +is the \"switch among existing agents\" surface; C-; a s opens the project +picker and C-; a k closes an agent." + (interactive) + (let* ((dirs (cj/--ai-term-active-agent-dirs)) + (win (cj/--ai-term-displayed-agent-window)) + (current-name (and win (buffer-name (window-buffer win)))) + (current-dir (and current-name + (seq-find (lambda (d) + (equal (cj/--ai-term-buffer-name d) current-name)) + dirs))) + (next-dir (cj/--ai-term-next-agent-dir current-dir dirs))) + (if (not next-dir) + ;; No agents open: launch the first via the project picker instead of + ;; erroring, so the swap key doubles as a "start an agent" key. + (cj/ai-term-pick-project) + (let* ((name (cj/--ai-term-buffer-name next-dir)) + (existing (get-buffer name))) + ;; Live agent and an agent window is up: swap it into that window in + ;; place (faithful to the prior buffer-only behavior). Detached, or no + ;; window yet: show-or-create attaches the tmux session / displays it. + (if (and win existing (cj/--ai-term-process-live-p existing)) + (progn (set-window-buffer win existing) (select-window win)) + (cj/--ai-term-show-or-create next-dir name) + (let ((w (get-buffer-window name))) + (when w (select-window w)))) + (message "Agent: %s" name))))) + +;; ai-term lives under the C-; a prefix (vacated when gptel was archived). +;; The frequent "swap to the next agent" also gets M-SPC for a fast chord. +(defvar-keymap cj/ai-term-keymap + :doc "Keymap for ai-term agent commands (C-; a)." + "a" #'cj/ai-term ;; toggle the most-recent agent on/off + "s" #'cj/ai-term-pick-project ;; select / launch via the project picker + "n" #'cj/ai-term-next ;; swap to the next open agent + "k" #'cj/ai-term-close) ;; kill the current agent +(cj/register-prefix-map "a" cj/ai-term-keymap "ai-term") +(keymap-global-set "M-SPC" #'cj/ai-term-next) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; a" "ai-term menu" + "C-; a a" "toggle agent" + "C-; a s" "select / launch" + "C-; a n" "next agent" + "C-; a k" "kill agent" + "M-SPC" "ai-term: next agent")) + +;; In EAT's semi-char mode, keys not bound in `eat-semi-char-mode-map' are +;; forwarded to the pty. M-SPC (swap to the next agent) must reach Emacs from +;; inside an agent buffer, so bind it in that map -- no exception-list or rebuild +;; dance like ghostel needed. C-; is already bound there (eat-config), so the +;; C-; a family resolves through the global prefix without extra wiring. +(with-eval-after-load 'eat + (keymap-set eat-semi-char-mode-map "M-SPC" #'cj/ai-term-next)) + +;; ------------------- Wrap-it-up teardown + shutdown ------------------------- +;; +;; Headless entry points the rulesets wrap-it-up workflow calls via +;; `emacsclient -e' (its Stop hook ~/.claude/hooks/ai-wrap-teardown.sh). All +;; three must work with no interactive frame guaranteed. rulesets owns the +;; workflow + hook that call these; this module owns the aiv- session naming, +;; the agent buffer, and the geometry restore, so the functions live here. +;; See docs/design/2026-06-23-wrap-teardown-shutdown-proposal.org (rulesets). + +(defcustom cj/ai-term-shutdown-command "sudo shutdown now" + "Shell command run when the shutdown countdown completes uncancelled. +A defcustom so development and tests can stub it instead of powering off +\(sudo is NOPASSWD on Craig's machines, so the default really shuts down)." + :type 'string + :group 'cj) + +(defun cj/ai-term-quit (&optional project) + "Tear down PROJECT's AI-term: kill its tmux session, buffer, and restore layout. +PROJECT is a project basename (as the rulesets Stop hook passes) or a directory; +nil means the current project (`default-directory'). Kills the `aiv-<name>' +tmux session (taking the agent process with it), then, when the agent buffer is +live, swaps its window back to the working buffer and kills it. Idempotent and +safe headless: a session or buffer already gone is a no-op, not an error." + (let* ((key (or project default-directory)) + (session (cj/--ai-term-tmux-session-name key)) + (buffer (get-buffer (cj/--ai-term-buffer-name key)))) + (cj/--ai-term-kill-tmux-session session) + (when (cj/--ai-term-buffer-p buffer) + (let ((win (get-buffer-window buffer))) + (when (window-live-p win) + (cj/--ai-term-swap-to-working-buffer win))) + (let ((kill-buffer-query-functions nil)) + (kill-buffer buffer))) + session)) + +(defun cj/ai-term-live-count () + "Return the integer count of live AI-term (aiv-*) tmux sessions. +0 when tmux has no server or no AI-term sessions. The shutdown safety gate: +`emacsclient -e (cj/ai-term-live-count)' prints the integer for the hook." + (length (cj/--ai-term-live-tmux-sessions))) + +(defvar cj/--ai-term-shutdown-timer nil + "The active shutdown-countdown repeating timer, or nil when none is running.") + +(defun cj/--ai-term-shutdown-clear-timer () + "Cancel and forget the shutdown-countdown timer, if any." + (when (timerp cj/--ai-term-shutdown-timer) + (cancel-timer cj/--ai-term-shutdown-timer)) + (setq cj/--ai-term-shutdown-timer nil)) + +(defun cj/ai-term-shutdown-cancel () + "Cancel an in-progress AI-term shutdown countdown." + (interactive) + (when cj/--ai-term-shutdown-timer + (cj/--ai-term-shutdown-clear-timer) + (message "Shutdown cancelled."))) + +(defun cj/ai-term-shutdown-countdown (&optional seconds) + "Count down SECONDS (default 10) in the echo area, then shut the machine down. +Re-checks the safety gate first (a TOCTOU guard against the workflow's earlier +check): aborts with a message when more than one `aiv-*' session is live. The +countdown is an abort-able `run-at-time' timer -- `C-g' (while the countdown +owns the keymap) or \\[cj/ai-term-shutdown-cancel] stops it. On reaching zero +uncancelled it runs `cj/ai-term-shutdown-command'. Returns immediately so the +Stop hook does not block; the daemon ticks the timer asynchronously." + (if (> (cj/ai-term-live-count) 1) + (progn + (message "Shutdown aborted: %d AI-term sessions still live." + (cj/ai-term-live-count)) + nil) + (cj/--ai-term-shutdown-clear-timer) + (let ((remaining (or seconds 10))) + (set-transient-map + (let ((m (make-sparse-keymap))) + (define-key m (kbd "C-g") #'cj/ai-term-shutdown-cancel) + m) + (lambda () (and cj/--ai-term-shutdown-timer t))) + (setq cj/--ai-term-shutdown-timer + (run-at-time + 0 1 + (lambda () + (if (<= remaining 0) + (progn + (cj/--ai-term-shutdown-clear-timer) + (shell-command cj/ai-term-shutdown-command)) + (message "Shutting down in %d… (C-g to cancel)" remaining) + (setq remaining (1- remaining)))))) + nil))) ;; ---------- emacsclient: keep opened files off the agent terminal ---------- ;; diff --git a/modules/auth-config.el b/modules/auth-config.el index 7f729f02a..c2df244b5 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -1,4 +1,4 @@ -;; auth-config.el --- Configuration for Authentication Utilities -*- lexical-binding: t; coding: utf-8; -*- +;;; auth-config.el --- Authentication and GPG integration -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,34 +6,30 @@ ;; Layer: 1 (Foundation). ;; Category: F/D. ;; Load shape: eager. -;; Eager reason: auth-source and GPG/epa setup that other modules rely on for -;; credentials early in the session. -;; Top-level side effects: auth-source/epa configuration via use-package and setq. +;; Eager reason: credentials and GPG setup are needed by other modules early. +;; Top-level side effects: auth-source/epa setup and oauth2-auto cache advice. ;; Runtime requires: system-lib, user-constants. -;; Direct test load: yes (configuration only). +;; Direct test load: yes. ;; -;; Configuration for Emacs authentication and GPG integration: - -;; • auth-source -;; – Forces use of your default authinfo file -;; – Disable external GPG agent in favor of Emacs's own prompt -;; – Keeps auth-source debug logging disabled by default - -;; • Easy PG Assistant (epa) -;; – Force using the 'gpg2' executable for encryption/decryption operations - -;; • oauth2-auto cache fix (via advice) -;; – oauth2-auto version 20250624.1919 has caching bug on line 206 -;; – Function oauth2-auto--plstore-read has `or nil` disabling cache -;; – This caused GPG passphrase prompts every ~15 minutes during gcal-sync -;; – Fix: Advice to enable hash-table cache without modifying package -;; – Works across package updates -;; – Fixed 2025-11-11 +;; Central auth-source, GPG, and credential-debug setup. Auth lookups use the +;; configured authinfo file; passphrase caching is left to gpg-agent. +;; +;; Advises oauth2-auto's plstore reader to restore in-memory caching and avoid +;; repeated GPG prompts during calendar/mail refreshes. ;;; Code: (require 'system-lib) -(eval-when-compile (require 'user-constants)) ;; defines authinfo-file location +(require 'user-constants) ;; defines authinfo-file, read at load time below + +;; Lazily-loaded oauth2-auto / plstore internals used by the cache-fix advice +;; below. oauth2-auto is required at runtime inside the advised function; these +;; declarations satisfy the byte-compiler without forcing an eager load. +(declare-function oauth2-auto--compute-id "oauth2-auto") +(declare-function plstore-get "plstore") +(declare-function plstore-close "plstore") +(defvar oauth2-auto--plstore-cache) +(defvar oauth2-auto-plstore) (defcustom cj/auth-source-debug-enabled nil "Non-nil means enable verbose auth-source debug logging. @@ -83,9 +79,11 @@ much context about sensitive services in the Messages buffer." ;; (setq epa-pinentry-mode 'loopback) ;; emacs request passwords in minibuffer (setq epg-gpg-program "gpg2") ;; force use gpg2 (not gpg v.1) - ;; Update gpg-agent with current DISPLAY environment - ;; This ensures pinentry can open GUI windows when Emacs starts - (call-process "gpg-connect-agent" nil nil nil "updatestartuptty" "/bye")) + ;; Update gpg-agent with the current DISPLAY so pinentry can open GUI windows. + ;; Guarded: on a machine without the binary the bare call-process signalled + ;; file-missing and aborted init. + (when (cj/executable-find-or-warn "gpg-connect-agent" "GPG pinentry GUI updates") + (call-process "gpg-connect-agent" nil nil nil "updatestartuptty" "/bye"))) ;; ---------------------------------- Plstore ---------------------------------- ;; Encrypted storage used by oauth2-auto for Google Calendar tokens. diff --git a/modules/auto-dim-config.el b/modules/auto-dim-config.el index c0e6e7a1b..efae5341b 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -16,14 +16,13 @@ ;; Dims windows that do not have focus so the selected window stands out, ;; using a local fork of auto-dim-other-buffers (the fork adds a focus-change ;; debounce). The dimmed faces (auto-dim-other-buffers and -;; auto-dim-other-buffers-hide) live in the active theme -;; (themes/dupre-faces.el) so they track theme switches. +;; auto-dim-other-buffers-hide) live in the active theme (the generated +;; theme-studio theme) so they track theme switches. ;; -;; Terminal buffers (ghostel) do not participate in window dimming: ghostel -;; bakes its color palette into the native module per-terminal, not per-window, -;; so there is no per-window color hook to dim through (the vterm engine had -;; one via `vterm--get-color', which this module used to advise). See the -;; terminal-migration follow-up task in todo.org for revisiting this. +;; EAT terminals render in real Emacs faces and use the `default' face for the +;; terminal background, so -- unlike the old ghostel/vterm engines, which baked +;; color per-terminal with no per-window hook -- they follow the per-window +;; dimmed background like any other buffer. ;;; Code: @@ -79,19 +78,21 @@ focus cue on a split-displayed dashboard, accepted as a fair trade." ;; Org TODO-keyword + priority faces dim to their own -dim variant ;; (a darker shade of the same colour) rather than the flat gray, so ;; a dimmed window's keywords stay recognizable. Faces are defined - ;; in themes/dupre-faces.el and wired in modules/org-config.el. - (dupre-org-todo . (dupre-org-todo-dim . nil)) - (dupre-org-project . (dupre-org-project-dim . nil)) - (dupre-org-doing . (dupre-org-doing-dim . nil)) - (dupre-org-waiting . (dupre-org-waiting-dim . nil)) - (dupre-org-verify . (dupre-org-verify-dim . nil)) - (dupre-org-stalled . (dupre-org-stalled-dim . nil)) - (dupre-org-failed . (dupre-org-failed-dim . nil)) - (dupre-org-done . (dupre-org-done-dim . nil)) - (dupre-org-priority-a . (dupre-org-priority-a-dim . nil)) - (dupre-org-priority-b . (dupre-org-priority-b-dim . nil)) - (dupre-org-priority-c . (dupre-org-priority-c-dim . nil)) - (dupre-org-priority-d . (dupre-org-priority-d-dim . nil)))) + ;; and wired in modules/org-faces-config.el. + (org-faces-todo . (org-faces-todo-dim . nil)) + (org-faces-project . (org-faces-project-dim . nil)) + (org-faces-doing . (org-faces-doing-dim . nil)) + (org-faces-waiting . (org-faces-waiting-dim . nil)) + (org-faces-verify . (org-faces-verify-dim . nil)) + (org-faces-stalled . (org-faces-stalled-dim . nil)) + (org-faces-delegated . (org-faces-delegated-dim . nil)) + (org-faces-failed . (org-faces-failed-dim . nil)) + (org-faces-done . (org-faces-done-dim . nil)) + (org-faces-cancelled . (org-faces-cancelled-dim . nil)) + (org-faces-priority-a . (org-faces-priority-a-dim . nil)) + (org-faces-priority-b . (org-faces-priority-b-dim . nil)) + (org-faces-priority-c . (org-faces-priority-c-dim . nil)) + (org-faces-priority-d . (org-faces-priority-d-dim . nil)))) (add-hook 'auto-dim-other-buffers-never-dim-buffer-functions #'cj/auto-dim--never-dim-dashboard-p) (auto-dim-other-buffers-mode 1)) diff --git a/modules/browser-config.el b/modules/browser-config.el index 4a2c54623..564e7a275 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -76,7 +76,10 @@ Includes built-in Emacs browsers (those with nil executable)." (defun cj/save-browser-choice (browser-plist) "Save BROWSER-PLIST to the persistence file." (with-temp-file cj/browser-choice-file - (insert ";;; Browser choice - Auto-generated\n") + (insert ";;; browser-choice.el --- Generated browser selection -*- lexical-binding: t; -*-\n") + (insert ";;\n") + (insert ";; Generated by browser-config.el. Do not edit by hand; use\n") + (insert ";; `cj/choose-browser' to rewrite this file.\n") (insert (format "(setq cj/saved-browser-choice '%S)\n" browser-plist)))) (defun cj/load-browser-choice () @@ -102,19 +105,12 @@ Returns: \\='success if applied successfully, (program-var (plist-get browser-plist :program-var))) (if (null browse-fn) 'invalid-plist - ;; Set the main browse-url function (setq browse-url-browser-function browse-fn) ;; Set the specific browser program variable if it exists (when program-var (set program-var (or path executable))) 'success)))) -(defun cj/apply-browser-choice (browser-plist) - "Apply the browser settings from BROWSER-PLIST." - (pcase (cj/--do-apply-browser-choice browser-plist) - ('success (message "Default browser set to: %s" (plist-get browser-plist :name))) - ('invalid-plist (message "Invalid browser configuration")))) - (defun cj/--do-choose-browser (browser-plist) "Save and apply BROWSER-PLIST as the default browser. Returns: \\='success if browser was saved and applied, @@ -151,7 +147,8 @@ Persists the choice for future sessions." (defun cj/--do-initialize-browser () "Initialize browser configuration. Returns: (cons \\='loaded browser-plist) if saved choice was loaded, - (cons \\='first-available browser-plist) if using first discovered browser, + (cons \\='first-available browser-plist) if using first + discovered browser, (cons \\='no-browsers nil) if no browsers found." (let ((saved-choice (cj/load-browser-choice))) (if saved-choice diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 13c74ca16..b684330c8 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -8,75 +8,17 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D/S. ;; Load shape: eager only when calendar-sync.local.el configures calendars. -;; Eager reason: daily-driver workflow; calendars are expected synced at the -;; first session. Timers and network fetches are guarded for batch/test loads. -;; Top-level side effects: defines a calendar keymap and conditionally registers -;; it under cj/custom-keymap; timer and network fetches guarded by -;; config/noninteractive checks. +;; Eager reason: daily agenda workflow; timers and network fetches are guarded. +;; Top-level side effects: defines C-; g map; starts sync only when configured. ;; Runtime requires: cl-lib, subr-x, system-lib, cj-org-text-lib, keybindings. -;; Direct test load: yes (private config optional; degrades cleanly when absent). +;; Direct test load: yes. ;; -;; Simple, reliable one-way sync from multiple calendars to Org mode. -;; Downloads .ics files from calendar URLs (Google, Proton, etc.) and -;; converts to Org format. No OAuth, no API complexity, just file conversion. +;; One-way calendar synchronization from configured .ics/API sources into Org +;; files. Feed URLs may be inline or resolved from auth-source via :secret-host. ;; -;; Features: -;; - Multi-calendar support (sync multiple calendars to separate files) -;; - Pure Emacs Lisp .ics parser (no external dependencies) -;; - Recurring event support (RRULE expansion) -;; - Timer-based automatic sync (every 60 minutes, configurable) -;; - Self-contained in .emacs.d (no cron, portable across machines) -;; - Read-only (can't corrupt source calendars) -;; - Works with Chime for event notifications -;; -;; Recurring Events (RRULE): -;; -;; Calendar recurring events are defined once with an RRULE -;; (recurrence rule) rather than as individual event instances. This -;; module expands recurring events into individual org entries. -;; -;; Expansion uses a rolling window approach: -;; - Past: 3 months before today -;; - Future: 12 months after today -;; -;; Every sync regenerates the entire file based on the current date, -;; so the window automatically advances as time passes. Old events -;; naturally fall off after 3 months, and new future events appear -;; as you approach them. -;; -;; Supported RRULE patterns: -;; - FREQ=DAILY: Daily events -;; - FREQ=WEEKLY;BYDAY=MO,WE,FR: Weekly on specific days -;; - FREQ=MONTHLY: Monthly events (same day each month) -;; - FREQ=YEARLY: Yearly events (anniversaries, birthdays) -;; - INTERVAL: Repeat every N periods (e.g., every 2 weeks) -;; - UNTIL: End date for recurrence -;; - COUNT: Maximum occurrences (combined with date range limit) -;; -;; Setup: -;; 1. Configure calendars in your init.el: -;; (setq calendar-sync-calendars -;; '((:name "google" -;; :url "https://calendar.google.com/calendar/ical/.../basic.ics" -;; :file gcal-file) -;; (:name "proton" -;; :url "https://calendar.proton.me/api/calendar/v1/url/.../calendar.ics" -;; :file pcal-file))) -;; -;; 2. Load and start: -;; (require 'calendar-sync) -;; (calendar-sync-start) -;; -;; 3. Add to org-agenda (optional): -;; (dolist (cal calendar-sync-calendars) -;; (add-to-list 'org-agenda-files (plist-get cal :file))) -;; -;; Usage: -;; - M-x calendar-sync-now ; Sync all or select specific calendar -;; - M-x calendar-sync-start ; Start auto-sync -;; - M-x calendar-sync-stop ; Stop auto-sync -;; - M-x calendar-sync-toggle ; Toggle auto-sync -;; - M-x calendar-sync-status ; Show sync status for all calendars +;; The parser expands recurring events into a rolling window around today, +;; regenerates target Org files on each sync, and keeps source calendars +;; read-only. Commands under C-; g start, stop, toggle, inspect, and run syncs. ;;; Code: @@ -223,7 +165,7 @@ Example: -21600 for CST (UTC-6), -28800 for PST (UTC-8)." (defun calendar-sync--format-timezone-offset (offset) "Format timezone OFFSET (in seconds) as human-readable string. -Example: -21600 → 'UTC-6' or 'UTC-6:00'." +Example: -21600 → `UTC-6' or `UTC-6:00'." (if (null offset) "unknown" (let* ((hours (/ offset 3600)) @@ -255,8 +197,10 @@ Example: -21600 → 'UTC-6' or 'UTC-6:00'." (dir (file-name-directory calendar-sync--state-file))) (unless (file-directory-p dir) (make-directory dir t)) - (with-temp-file calendar-sync--state-file - (prin1 state (current-buffer))))) + (let ((tmp (make-temp-file (expand-file-name ".calendar-sync-state-" dir)))) + (with-temp-file tmp + (prin1 state (current-buffer))) + (rename-file tmp calendar-sync--state-file t)))) (defun calendar-sync--load-state () "Load sync state from disk." @@ -289,7 +233,7 @@ Example: -21600 → 'UTC-6' or 'UTC-6:00'." "Normalize line endings in CONTENT to Unix format (LF only). Removes all carriage return characters (\\r) from CONTENT. The iCalendar format (RFC 5545) uses CRLF line endings, but Emacs -and 'org-mode' expect LF only. This function ensures consistent line +and `org-mode' expect LF only. This function ensures consistent line endings throughout the parsing pipeline. Returns CONTENT with all \\r characters removed." @@ -423,14 +367,16 @@ Handles both simple values and values with parameters like TZID." (defun calendar-sync--get-recurrence-id-line (event-str) "Extract full RECURRENCE-ID line from EVENT-STR, including parameters. -Returns the complete line like 'RECURRENCE-ID;TZID=Europe/Tallinn:20260203T170000'. +Returns the complete line like +`RECURRENCE-ID;TZID=Europe/Tallinn:20260203T170000'. Returns nil if not found." (when (and event-str (stringp event-str)) (calendar-sync--get-property-line event-str "RECURRENCE-ID"))) (defun calendar-sync--parse-ics-datetime (value) "Parse iCal datetime VALUE into (year month day hour minute) list. -Returns nil for invalid input. For date-only values, returns (year month day nil nil). +Returns nil for invalid input. For date-only values, returns +(year month day nil nil). Handles formats: 20260203T090000Z, 20260203T090000, 20260203." (when (and value (stringp value) @@ -454,53 +400,56 @@ Handles formats: 20260203T090000Z, 20260203T090000, 20260203." (defalias 'calendar-sync--parse-recurrence-id #'calendar-sync--parse-ics-datetime "Parse RECURRENCE-ID value. See `calendar-sync--parse-ics-datetime'.") +(defun calendar-sync--parse-exception-event (event-str) + "Parse a RECURRENCE-ID override EVENT-STR into an exception plist, or nil. +Returns nil when EVENT-STR carries no RECURRENCE-ID, or its recurrence-id / +start time fail to parse. The plist holds :recurrence-id (localized), +:recurrence-id-raw, :start, :end, :summary, :description, :location." + (let ((recurrence-id (calendar-sync--get-recurrence-id event-str))) + (when recurrence-id + (let* ((recurrence-id-line (calendar-sync--get-recurrence-id-line event-str)) + (recurrence-id-tzid (calendar-sync--extract-tzid recurrence-id-line)) + (recurrence-id-is-utc (string-suffix-p "Z" recurrence-id)) + (recurrence-id-parsed (calendar-sync--parse-recurrence-id recurrence-id)) + ;; Parse the new times from the exception + (dtstart (calendar-sync--get-property event-str "DTSTART")) + (dtend (calendar-sync--get-property event-str "DTEND")) + (dtstart-line (calendar-sync--get-property-line event-str "DTSTART")) + (dtend-line (calendar-sync--get-property-line event-str "DTEND")) + (start-tzid (calendar-sync--extract-tzid dtstart-line)) + (end-tzid (calendar-sync--extract-tzid dtend-line)) + (start-parsed (calendar-sync--parse-timestamp dtstart start-tzid)) + (end-parsed (and dtend (calendar-sync--parse-timestamp dtend end-tzid))) + (summary (calendar-sync--clean-text + (calendar-sync--get-property event-str "SUMMARY"))) + (description (calendar-sync--clean-text + (calendar-sync--get-property event-str "DESCRIPTION"))) + (location (calendar-sync--clean-text + (calendar-sync--get-property event-str "LOCATION")))) + (when (and recurrence-id-parsed start-parsed) + (list :recurrence-id (calendar-sync--localize-parsed-datetime + recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid) + :recurrence-id-raw recurrence-id + :start start-parsed + :end end-parsed + :summary summary + :description description + :location location)))))) + (defun calendar-sync--collect-recurrence-exceptions (ics-content) "Collect all RECURRENCE-ID events from ICS-CONTENT. Returns hash table mapping UID to list of exception event plists. -Each exception plist contains :recurrence-id (parsed), :start, :end, :summary, etc." +Each exception plist contains :recurrence-id (parsed), :start, :end, +:summary, etc." (let ((exceptions (make-hash-table :test 'equal))) (when (and ics-content (stringp ics-content)) - (let ((events (calendar-sync--split-events ics-content))) - (dolist (event-str events) - (let ((recurrence-id (calendar-sync--get-recurrence-id event-str)) - (uid (calendar-sync--get-property event-str "UID"))) - (when (and recurrence-id uid) - ;; Parse the exception event - (let* ((recurrence-id-line (calendar-sync--get-recurrence-id-line event-str)) - (recurrence-id-tzid (calendar-sync--extract-tzid recurrence-id-line)) - (recurrence-id-is-utc (and recurrence-id - (string-suffix-p "Z" recurrence-id))) - (recurrence-id-parsed (calendar-sync--parse-recurrence-id recurrence-id)) - ;; Parse the new times from the exception - (dtstart (calendar-sync--get-property event-str "DTSTART")) - (dtend (calendar-sync--get-property event-str "DTEND")) - (dtstart-line (calendar-sync--get-property-line event-str "DTSTART")) - (dtend-line (calendar-sync--get-property-line event-str "DTEND")) - (start-tzid (calendar-sync--extract-tzid dtstart-line)) - (end-tzid (calendar-sync--extract-tzid dtend-line)) - (start-parsed (calendar-sync--parse-timestamp dtstart start-tzid)) - (end-parsed (and dtend (calendar-sync--parse-timestamp dtend end-tzid))) - (summary (calendar-sync--clean-text - (calendar-sync--get-property event-str "SUMMARY"))) - (description (calendar-sync--clean-text - (calendar-sync--get-property event-str "DESCRIPTION"))) - (location (calendar-sync--clean-text - (calendar-sync--get-property event-str "LOCATION")))) - (when (and recurrence-id-parsed start-parsed) - (let ((local-recurrence-id - (calendar-sync--localize-parsed-datetime - recurrence-id-parsed recurrence-id-is-utc recurrence-id-tzid))) - (let ((exception-plist - (list :recurrence-id local-recurrence-id - :recurrence-id-raw recurrence-id - :start start-parsed - :end end-parsed - :summary summary - :description description - :location location))) - ;; Add to hash table - (let ((existing (gethash uid exceptions))) - (puthash uid (cons exception-plist existing) exceptions))))))))))) + (dolist (event-str (calendar-sync--split-events ics-content)) + (let ((uid (calendar-sync--get-property event-str "UID")) + (exception-plist (calendar-sync--parse-exception-event event-str))) + (when (and uid exception-plist) + (puthash uid + (cons exception-plist (gethash uid exceptions)) + exceptions))))) exceptions)) (defun calendar-sync--occurrence-matches-exception-p (occurrence exception) @@ -535,7 +484,15 @@ Compares year, month, day, hour, minute." (plist-put result :location (plist-get exception :location))) ;; Pass through new fields if exception overrides them (when (plist-get exception :attendees) - (plist-put result :attendees (plist-get exception :attendees))) + (plist-put result :attendees (plist-get exception :attendees)) + ;; Re-derive the user's status from the overridden attendees so a + ;; singly-declined occurrence drops its inherited series "accepted" + ;; (otherwise `calendar-sync--filter-declined' can't drop it). Leave the + ;; inherited status when the override doesn't name the user. + (let ((status (calendar-sync--find-user-status + (plist-get exception :attendees) calendar-sync-user-emails))) + (when status + (plist-put result :status status)))) (when (plist-get exception :organizer) (plist-put result :organizer (plist-get exception :organizer))) (when (plist-get exception :url) @@ -569,7 +526,8 @@ Returns new list with matching occurrences replaced by exception times." (defun calendar-sync--get-exdates (event-str) "Extract all EXDATE values from EVENT-STR. -Returns list of datetime strings (without TZID parameters), or nil if none found. +Returns list of datetime strings (without TZID parameters), or nil if +none found. Handles both simple values and values with parameters like TZID." (when (and event-str (stringp event-str) (not (string-empty-p event-str))) (let ((exdates '()) @@ -582,7 +540,8 @@ Handles both simple values and values with parameters like TZID." (defun calendar-sync--get-exdate-line (event-str exdate-value) "Find the full EXDATE line containing EXDATE-VALUE from EVENT-STR. -Returns the complete line like 'EXDATE;TZID=America/New_York:20260210T130000'. +Returns the complete line like +`EXDATE;TZID=America/New_York:20260210T130000'. Returns nil if not found." (when (and event-str (stringp event-str) exdate-value) (let ((pattern (format "^\\(EXDATE[^:]*:%s\\)" (regexp-quote exdate-value)))) @@ -616,7 +575,8 @@ Converts TZID-qualified and UTC times to local time." (defun calendar-sync--exdate-matches-p (occurrence-start exdate) "Check if OCCURRENCE-START matches EXDATE. OCCURRENCE-START is (year month day hour minute). -EXDATE is (year month day hour minute) or (year month day nil nil) for date-only. +EXDATE is (year month day hour minute) or (year month day nil nil) for +date-only. Date-only EXDATE matches any time on that day." (and occurrence-start exdate (= (nth 0 occurrence-start) (nth 0 exdate)) ; year @@ -680,7 +640,8 @@ Returns nil if property not found." (defun calendar-sync--get-property-line (event property) "Extract full PROPERTY line from EVENT string, including parameters. -Returns the complete line like 'DTSTART;TZID=Europe/Lisbon:20260202T190000'. +Returns the complete line like +`DTSTART;TZID=Europe/Lisbon:20260202T190000'. Returns nil if property not found." (when (string-match (format "^\\(%s[^\n]*\\)$" (regexp-quote property)) event) (match-string 1 event))) @@ -788,8 +749,8 @@ Returns URL string or nil." (defun calendar-sync--extract-tzid (property-line) "Extract TZID parameter value from PROPERTY-LINE. -PROPERTY-LINE is like 'DTSTART;TZID=Europe/Lisbon:20260202T190000'. -Returns timezone string like 'Europe/Lisbon', or nil if no TZID. +PROPERTY-LINE is like `DTSTART;TZID=Europe/Lisbon:20260202T190000'. +Returns timezone string like `Europe/Lisbon', or nil if no TZID. Returns nil for malformed lines (missing colon separator)." (when (and property-line (stringp property-line) @@ -811,7 +772,7 @@ Returns list (year month day hour minute) in local timezone." (defun calendar-sync--convert-tz-to-local (year month day hour minute source-tz) "Convert datetime from SOURCE-TZ timezone to local time. -SOURCE-TZ is a timezone name like 'Europe/Lisbon' or 'Asia/Yerevan'. +SOURCE-TZ is a timezone name like `Europe/Lisbon' or `Asia/Yerevan'. Returns list (year month day hour minute) in local timezone, or nil on error. Uses Emacs built-in timezone support (encode-time/decode-time with ZONE @@ -835,8 +796,10 @@ TZ database as the `date' command." "Convert PARSED datetime to local time using timezone info. PARSED is (year month day hour minute) or (year month day nil nil). IS-UTC non-nil means the value had a Z suffix. + TZID is a timezone string like \"Europe/Lisbon\", or nil. -Returns PARSED converted to local time, or PARSED unchanged if no conversion needed." +Returns PARSED converted to local time, or PARSED unchanged if no +conversion needed." (cond (is-utc (calendar-sync--convert-utc-to-local @@ -854,7 +817,8 @@ Returns PARSED converted to local time, or PARSED unchanged if no conversion nee "Parse iCal timestamp string TIMESTAMP-STR. Returns (year month day hour minute) or (year month day) for all-day events. Converts UTC times (ending in Z) to local time. -If TZID is provided (e.g., 'Europe/Lisbon'), converts from that timezone to local. +If TZID is provided (e.g., `Europe/Lisbon'), converts from that timezone +to local. Returns nil if parsing fails." (cond ;; DateTime format: 20251116T140000Z or 20251116T140000 @@ -911,7 +875,8 @@ Returns string like '<2025-11-16 Sun 14:00-15:00>' or '<2025-11-16 Sun>'." (defun calendar-sync--date-to-time (date) "Convert DATE to time value for comparison. DATE should be a list starting with (year month day ...). -Only the first three elements are used; extra elements (hour, minute) are ignored." +Only the first three elements are used; extra elements (hour, minute) are +ignored." (let ((day (nth 2 date)) (month (nth 1 date)) (year (nth 0 date))) @@ -1080,7 +1045,8 @@ Returns nil if event lacks required fields (DTSTART, SUMMARY). Skips events with RECURRENCE-ID (individual instances of recurring events are handled separately via exception collection). Handles TZID-qualified timestamps by converting to local time. -Cleans text fields (description, location, summary) via `calendar-sync--clean-text'." +Cleans text fields (description, location, summary) via +`calendar-sync--clean-text'." ;; Skip individual instances of recurring events (they're collected as exceptions) (unless (calendar-sync--get-property event-str "RECURRENCE-ID") (let* ((uid (calendar-sync--get-property event-str "UID")) @@ -1226,11 +1192,19 @@ RECURRENCE-ID exceptions are applied to override specific occurrences." (time-less-p (calendar-sync--event-start-time a) (calendar-sync--event-start-time b))))) (org-entries (mapcar #'calendar-sync--event-to-org sorted-events))) - (if org-entries - (concat "# Calendar Events\n\n" - (string-join org-entries "\n\n") - "\n") - nil))) + ;; Distinguish a healthy zero-event calendar from garbage: a real + ;; iCalendar (carries BEGIN:VCALENDAR) with no in-window events + ;; returns the header alone, so the caller writes an empty calendar + ;; and reports success. Non-iCalendar content (an HTML error page, a + ;; truncated download) has no VCALENDAR and returns nil -- a failure. + (cond + (org-entries + (concat "# Calendar Events\n\n" + (string-join org-entries "\n\n") + "\n")) + ((string-match-p "BEGIN:VCALENDAR" ics-content) + "# Calendar Events\n\n") + (t nil)))) (error (calendar-sync--log-silently "calendar-sync: Parse error: %s" (error-message-string err)) nil))) @@ -1249,7 +1223,7 @@ invoked when the fetch completes, either successfully or with an error." (make-process :name "calendar-sync-curl" :buffer buffer - :command (list "curl" "-s" "-L" + :command (list "curl" "-s" "-L" "--fail" "--connect-timeout" "10" "--max-time" (number-to-string calendar-sync-fetch-timeout) url) @@ -1281,7 +1255,7 @@ owns deleting the temp file after a successful callback." (make-process :name "calendar-sync-curl" :buffer buffer - :command (list "curl" "-s" "-L" + :command (list "curl" "-s" "-L" "--fail" "--connect-timeout" "10" "--max-time" (number-to-string calendar-sync-fetch-timeout) "-o" temp-file @@ -1307,13 +1281,17 @@ owns deleting the temp file after a successful callback." (funcall callback nil)))) (defun calendar-sync--write-file (content file) - "Write CONTENT to FILE. -Creates parent directories if needed." + "Write CONTENT to FILE atomically. +Creates parent directories if needed, then writes a temp file in the same +directory and renames it into place, so org-agenda or chime reading mid-write +never sees a half-written calendar." (let ((dir (file-name-directory file))) (unless (file-directory-p dir) - (make-directory dir t))) - (with-temp-file file - (insert content))) + (make-directory dir t)) + (let ((tmp (make-temp-file (expand-file-name ".calendar-sync-" dir)))) + (with-temp-file tmp + (insert content)) + (rename-file tmp file t)))) (defun calendar-sync--emacs-binary () "Return the Emacs executable to use for calendar conversion workers." diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el index 4243e509a..38aa0de05 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -6,51 +6,23 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; optional ebook workflow, a command-loaded deferral -;; candidate for Phase 4. -;; Top-level side effects: one add-hook, one advice-add, package config. -;; Runtime requires: user-constants, subr-x. +;; Eager reason: none; ebook commands can load by command. +;; Top-level side effects: one hook, one advice, package config. +;; Runtime requires: user-constants, subr-x, transient. ;; Direct test load: yes. ;; -;; This module provides a comprehensive ebook management and reading experience -;; within Emacs, integrating CalibreDB for library management and Nov for EPUB -;; reading. +;; CalibreDB and Nov integration for browsing the Calibre library and reading +;; EPUBs inside Emacs. The module adds a curated CalibreDB transient, filter +;; helpers, Nov typography, image centering, and reader-to-library navigation. ;; -;; FEATURES: -;; - CalibreDB integration for managing your Calibre ebook library -;; - Nov mode for reading EPUB files with customized typography and layout -;; - Seamless navigation between Nov reading buffers and CalibreDB entries -;; - Image centering in EPUB documents without modifying buffer text -;; - Quick filtering and searching within your ebook library -;; -;; KEY BINDINGS: -;; - M-B: Open CalibreDB library browser -;; - In CalibreDB search mode: -;; - l: Filter by tag -;; - L: Clear all filters -;; - In Nov mode: -;; - z: Open current EPUB in external viewer (zathura) -;; - C-c C-b: Jump to CalibreDB entry for current book -;; - m: Set bookmark -;; - b: List bookmarks -;; -;; WORKFLOW: -;; 1. Press M-B to browse your Calibre library -;; 2. Use filters (l for tags, L to clear) to narrow results -;; 3. Open an EPUB to read it in Nov with optimized typography -;; 4. While reading, use C-c C-b to jump back to the book's metadata -;; 5. Use z to open in external reader when needed -;; -;; CONFIGURATION NOTES: -;; - Prefers EPUB format when available, falls back to PDF -;; - Centers images in EPUB documents using display properties -;; - Applies custom typography with larger fonts for comfortable reading -;; - Uses visual-fill-column for centered text with appropriate margins +;; EPUB is preferred when available; external opening remains available for +;; formats or workflows better handled outside Emacs. ;;; Code: (require 'user-constants) ;; for books-dir (require 'subr-x) +(require 'transient) ;; cj/calibredb-menu is a transient prefix ;; Declare functions from lazy-loaded packages (declare-function calibredb-find-create-search-buffer "calibredb" ()) @@ -59,6 +31,40 @@ (declare-function nov-render-document "nov" ()) (defvar nov-text-width) ; from nov.el; set buffer-local here +;; calibredb commands the curated menu drives (all autoloaded by calibredb) +(declare-function calibredb-switch-library "calibredb" ()) +(declare-function calibredb-search-keyword-filter "calibredb-search") + +;; calibredb's filter-scope flags (set in `cj/--calibredb-open-to-favorites'); +;; declared special so the assignments compile clean when calibredb is absent. +(defvar calibredb-tag-filter-p) +(defvar calibredb-favorite-filter-p) +(defvar calibredb-author-filter-p) +(defvar calibredb-date-filter-p) +(defvar calibredb-format-filter-p) +(declare-function calibredb-filter-by-book-format "calibredb" ()) +(declare-function calibredb-filter-by-author-sort "calibredb" ()) +(declare-function calibredb-search-clear-filter "calibredb" ()) +(declare-function calibredb-sort-by-author "calibredb" ()) +(declare-function calibredb-sort-by-title "calibredb" ()) +(declare-function calibredb-sort-by-pubdate "calibredb" ()) +(declare-function calibredb-sort-by-format "calibredb" ()) +(declare-function calibredb-find-file "calibredb" ()) +(declare-function calibredb-dispatch "calibredb" ()) +(declare-function calibredb-show-entry "calibredb" (entry &optional switch)) +(declare-function calibredb-find-candidate-at-point "calibredb" ()) +(declare-function calibredb-search-refresh-or-resume "calibredb" (&optional begin position)) +(defvar calibredb-show-entry-switch) ; from calibredb-show.el +(defvar calibredb-sort-by) ; from calibredb-core.el +(defvar calibredb-search-filter) ; from calibredb-search.el +;; calibredb filter-state vars (set by cj/calibredb-clear-filters and friends) +(defvar calibredb-tag-filter-p) ; from calibredb-search.el +(defvar calibredb-favorite-filter-p) ; from calibredb-search.el +(defvar calibredb-author-filter-p) ; from calibredb-search.el +(defvar calibredb-date-filter-p) ; from calibredb-search.el +(defvar calibredb-format-filter-p) ; from calibredb-search.el +(defvar calibredb-search-current-page) ; from calibredb-search.el + ;; -------------------------- CalibreDB Ebook Manager -------------------------- (defun cj/calibredb-clear-filters () @@ -73,6 +79,43 @@ ;; empty string resets keyword filter and refreshes listing (calibredb-search-keyword-filter "")) +(defun cj/calibredb-describe-at-point () + "Show the book at point in the docked *calibredb-entry* buffer. +Displays the entry without switching focus back to the list, so it lands +in the bottom-docked window (see the `display-buffer-alist' entry below) +and q (`calibredb-entry-quit') dismisses it." + (interactive) + (calibredb-show-entry (car (calibredb-find-candidate-at-point)))) + +(defun cj/--calibredb-sort-preserving-filter (field) + "Set `calibredb-sort-by' to FIELD and refresh, keeping the active filter. +calibredb's own `calibredb-sort-by-*' commands refresh with +`calibredb-search-refresh-and-clear-filter', which drops the active filter +on every sort. This refreshes with `calibredb-search-refresh-or-resume', +which re-applies `calibredb-search-filter' instead." + (setq calibredb-sort-by field) + (calibredb-search-refresh-or-resume)) + +(defun cj/--calibredb-open-to-favorites (&rest _) + "Filter the calibredb search to books tagged `calibredb-favorite-keyword'. +Advice (:after) on `calibredb' so every launch lands on the favorite-keyword +books (Craig's \"in-progress\" reading list); clear with L / x to see the +whole library. Scopes to the tag field (sets `calibredb-tag-filter-p', +clears the other filter-scope flags), because a bare keyword filter matches +the keyword in any field -- title, author, or the description -- and would +surface books that merely mention it. No-op unless a non-empty string +keyword is set." + (when (and (boundp 'calibredb-favorite-keyword) + (stringp calibredb-favorite-keyword) + (not (string-empty-p calibredb-favorite-keyword)) + (fboundp 'calibredb-search-keyword-filter)) + (setq calibredb-tag-filter-p t + calibredb-favorite-filter-p nil + calibredb-author-filter-p nil + calibredb-date-filter-p nil + calibredb-format-filter-p nil) + (calibredb-search-keyword-filter calibredb-favorite-keyword))) + (use-package calibredb :commands calibredb :bind @@ -80,7 +123,10 @@ ;; use built-in filter by tag, add clear-filters (:map calibredb-search-mode-map ("l" . calibredb-filter-by-tag) - ("L" . cj/calibredb-clear-filters)) + ("L" . cj/calibredb-clear-filters) + ;; "?" -> curated menu of frequent workflows; "H" -> the full dispatch + ("?" . cj/calibredb-menu) + ("H" . calibredb-dispatch)) :config ;; basic config (setq calibredb-root-dir books-dir) @@ -88,13 +134,60 @@ (setq calibredb-program "/usr/bin/calibredb") (setq calibredb-preferred-format "epub") (setq calibredb-search-page-max-rows 500) + ;; Dock the book-detail buffer to the bottom 30%; q dismisses it. + ;; `pop-to-buffer' honours `display-buffer-alist' (the default + ;; `switch-to-buffer-other-window' would not). + (setq calibredb-show-entry-switch #'pop-to-buffer) + (add-to-list 'display-buffer-alist + '("\\`\\*calibredb-entry\\*\\'" + (display-buffer-at-bottom) + (window-height . 0.3))) + ;; A curated menu of the frequent calibredb workflows, bound to `?' in the + ;; search buffer; calibredb's own full dispatch (the wall of every command) + ;; moves to `H'. Defined here in `:config' so it only builds once calibredb + ;; (and its matching transient) is loaded. This is the "? brings up a + ;; discoverable help menu" convention. + (transient-define-prefix cj/calibredb-menu () + "Frequent calibredb workflows." + [["Library" + ("l" "switch library" calibredb-switch-library)] + ["Filter" + ("f" "format" calibredb-filter-by-book-format) + ("a" "author" calibredb-filter-by-author-sort) + ("x" "reset filter" calibredb-search-clear-filter)] + ["Sort" + ("A" "author (last name)" calibredb-sort-by-author) + ("t" "title" calibredb-sort-by-title) + ("p" "pubdate" calibredb-sort-by-pubdate) + ("g" "group by format" calibredb-sort-by-format)] + ["Book" + ("o" "open" calibredb-find-file) + ("d" "describe" cj/calibredb-describe-at-point) + ("H" "full calibredb menu" calibredb-dispatch)]] + [("q" "quit" transient-quit-one)]) + + ;; Keep the active filter when sorting. calibredb's macro-generated + ;; `calibredb-sort-by-*' commands refresh-and-clear-filter, dropping the + ;; filter on every sort; override each to refresh-or-resume so the filter + ;; survives. Named advice keeps the override idempotent across reloads. + (dolist (field '(id title author format date pubdate tag size language)) + (let ((cmd (intern (format "calibredb-sort-by-%s" field))) + (adv (intern (format "cj/--calibredb-sort-keep-filter-%s" field))) + (f field)) + (defalias adv + (lambda (&rest _) (interactive) (cj/--calibredb-sort-preserving-filter f)) + (format "Sort by %s, keeping the active filter (override)." field)) + (advice-add cmd :override adv))) ;; search window display (setq calibredb-size-show nil) (setq calibredb-order "asc") (setq calibredb-id-width 7) (setq calibredb-favorite-icon "🔖") - (setq calibredb-favorite-keyword "in-progress")) + (setq calibredb-favorite-keyword "in-progress") + ;; Open every calibredb launch (dashboard, M-x, elsewhere) filtered to the + ;; in-progress favorites; L / x clears to the whole library. + (advice-add 'calibredb :after #'cj/--calibredb-open-to-favorites)) ;; ------------------------------ Nov Epub Reader ------------------------------ @@ -117,7 +210,6 @@ Adjust it live with `cj/nov-widen-text' and `cj/nov-narrow-text'.") (if (and buffer-file-name (string-match-p "\\.epub\\'" buffer-file-name)) (progn - ;; Load nov if not already loaded (unless (featurep 'nov) (require 'nov nil t)) ;; Call nov-mode if available, otherwise fallback to default behavior @@ -158,6 +250,29 @@ layout passes -- each pass narrows the body width but not the natural width." "Return the preferred EPUB text column count for WINDOW." (cj/nov--text-width (cj/nov--natural-window-width window))) +(defun cj/nov--rerender-preserving-position () + "Re-render the nov document, restoring point's relative position. +Capture point as a fraction of the buffer, re-render, then move point to the +same fraction of the re-rendered buffer so the reading position is kept +approximately." + (let ((frac (when (> (point-max) (point-min)) + (/ (float (- (point) (point-min))) + (- (point-max) (point-min)))))) + (nov-render-document) + (when frac + (goto-char (+ (point-min) + (round (* frac (- (point-max) (point-min))))))))) + +(defun cj/nov--center-in-window (win total width) + "Center a WIDTH-column text block in WIN, given its TOTAL natural width. +Set equal left/right display margins and push the fringes to the window edge." + ;; floor: never let the margins squeeze the text area below WIDTH. + (let ((margin (max 0 (/ (- total width) 2)))) + (set-window-margins win margin margin)) + ;; Push the fringes out to the window's edge; otherwise they sit between the + ;; margin and the text and show as thin vertical lines beside it. + (set-window-fringes win nil nil t)) + (defun cj/nov-update-layout (&optional _frame) "Size the EPUB text column for this buffer and center it in its window. `nov-text-width' is set so nov's `shr' fills the text to roughly 80% of the @@ -173,20 +288,9 @@ command." (width (cj/nov--text-width total))) (unless (eql nov-text-width width) (setq-local nov-text-width width) - (let ((frac (when (> (point-max) (point-min)) - (/ (float (- (point) (point-min))) - (- (point-max) (point-min)))))) - (nov-render-document) - (when frac - (goto-char (+ (point-min) - (round (* frac (- (point-max) (point-min))))))))) + (cj/nov--rerender-preserving-position)) (when win - ;; floor: never let the margins squeeze the text area below WIDTH. - (let ((margin (max 0 (/ (- total width) 2)))) - (set-window-margins win margin margin)) - ;; Push the fringes out to the window's edge; otherwise they sit between - ;; the margin and the text and show as thin vertical lines beside it. - (set-window-fringes win nil nil t))))) + (cj/nov--center-in-window win total width))))) (defun cj/--nov-adjust-margin (delta) "Add DELTA to `cj/nov-margin-percent' (clamped 0..25), re-lay-out, and report. @@ -210,11 +314,12 @@ A positive DELTA narrows the text column; a negative DELTA widens it." (defun cj/nov-apply-preferences () "Apply preferences after nov-mode has launched." (interactive) - ;; Use Merriweather for comfortable reading with appropriate scaling - ;; Darker sepia color (#E8DCC0) is easier on the eyes than pure white - (face-remap-add-relative 'variable-pitch :family "Merriweather" :height 1.0 :foreground "#E8DCC0") - (face-remap-add-relative 'default :family "Merriweather" :height 180 :foreground "#E8DCC0") - (face-remap-add-relative 'fixed-pitch :height 180 :foreground "#E8DCC0") + ;; Use Merriweather for comfortable reading with appropriate scaling. + ;; (Reading fg color stripped; falls back to the theme default until a + ;; themeable reading face exists -- see todo.org.) + (face-remap-add-relative 'variable-pitch :family "Merriweather" :height 1.0) + (face-remap-add-relative 'default :family "Merriweather" :height 180) + (face-remap-add-relative 'fixed-pitch :height 180) ;; Enable visual-line-mode for proper text wrapping (visual-line-mode 1) ;; Set fill-column as a fallback @@ -301,6 +406,12 @@ Try to use the Calibre book id from the parent folder name (for example, (calibredb-search-keyword-filter "") (message "CalibreDB: no metadata; showing all")))))) +(require 'system-lib) +;; nov renders epub via shr, which paints with manual `face' properties. Left in +;; `global-font-lock-mode' font-lock overwrites them and the book loses its +;; colors, the same issue as elfeed-show and mu4e-view. Exclude nov-mode. +(cj/exclude-from-global-font-lock 'nov-mode) + (use-package nov :mode ("\\.epub\\'" . nov-mode) @@ -327,6 +438,60 @@ Try to use the Calibre book id from the parent folder name (for example, ("t" . nov-goto-toc) ("C-c C-b" . cj/nov-jump-to-calibredb))) +;; ------------------------- Nov bookmark naming ------------------------------- +;; In a nov buffer "m" is bound to `bookmark-set' (above). nov's +;; Both nov (EPUB) and pdf-view (PDF) name a new bookmark after the buffer -- +;; the file's name, extension and all. Rebuild it as "Author, Title" parsed +;; from the filename: under Calibre's "<Title> - <Author>.<ext>" naming the +;; filename is more complete than the file's embedded metadata (which carries +;; truncated titles and author-sort "Last, First" forms). One :filter-return +;; advice serves both record functions; the parser is extension-agnostic. + +(defun cj/--reading-clean-title (s) + "Clean a title or author S parsed from a book filename, or nil when blank. +Restores a colon where Calibre sanitized \":\" to \"_\" (\"Frege_ A Guide\" +-> \"Frege: A Guide\"), turns any leftover underscore into a space, and +collapses runs of whitespace." + (when (stringp s) + (let* ((colon (replace-regexp-in-string "_ " ": " s)) + (spaced (replace-regexp-in-string "_" " " colon)) + (out (string-trim (replace-regexp-in-string "[ \t]+" " " spaced)))) + (and (not (string-empty-p out)) out)))) + +(defun cj/--reading-bookmark-name-from-file (path) + "Return \"Author, Title\" derived from a book PATH's filename, or nil. +Splits the filename (sans extension) on its last \" - \" into title and +author per Calibre's \"<Title> - <Author>\" convention, restoring colons and +reordering to \"Author, Title\". Falls back to the cleaned whole name when +there is no \" - \" separator. Extension-agnostic, so it serves EPUB and PDF." + (when (and (stringp path) (not (string-empty-p path))) + (let ((base (file-name-sans-extension (file-name-nondirectory path)))) + (if (string-match "\\`\\(.+\\) - \\(.+\\)\\'" base) + (let ((title (cj/--reading-clean-title (match-string 1 base))) + (author (cj/--reading-clean-title (match-string 2 base)))) + (cond ((and author title) (format "%s, %s" author title)) + (title title) + (author author) + (t nil))) + (cj/--reading-clean-title base))))) + +(defun cj/--reading-bookmark-rename-record (record) + "Replace RECORD's bookmark name with \"Author, Title\" from its filename. +Advice (:filter-return) on `nov-bookmark-make-record' and +`pdf-view-bookmark-make-record'. RECORD is (NAME . ALIST) carrying a +`filename'; left unchanged when no name derives." + (let ((name (cj/--reading-bookmark-name-from-file + (alist-get 'filename (cdr record))))) + (if name (cons name (cdr record)) record))) + +(with-eval-after-load 'nov + (advice-add 'nov-bookmark-make-record :filter-return + #'cj/--reading-bookmark-rename-record)) + +(with-eval-after-load 'pdf-view + (advice-add 'pdf-view-bookmark-make-record :filter-return + #'cj/--reading-bookmark-rename-record)) + (defun cj/--nov-image-padding-cols (col-width img-px font-width-px) "Return left-padding columns to center an IMG-PX-wide image in COL-WIDTH cols. FONT-WIDTH-PX is the column width in pixels; clamped up to 1 so a zero or diff --git a/modules/chrono-tools.el b/modules/chrono-tools.el index 9ccba6676..744781268 100644 --- a/modules/chrono-tools.el +++ b/modules/chrono-tools.el @@ -22,6 +22,11 @@ (require 'user-constants) +;; Declared by the lazily-loaded `tmr' package; quiet the byte-compiler +;; without forcing the package to load. +(defvar tmr-sound-file) +(defvar tmr-descriptions-list) + ;; -------------------------------- Time Zones --------------------------------- (use-package time-zones @@ -66,6 +71,19 @@ Returns nil if `sounds-dir' does not exist." (message "Timer sound reset to default: %s" (file-name-nondirectory notification-sound))) +(defun cj/tmr--current-sound-name () + "Return the basename of the current `tmr-sound-file' if it exists, else nil." + (when (and tmr-sound-file (file-exists-p tmr-sound-file)) + (file-name-nondirectory tmr-sound-file))) + +(defun cj/tmr--apply-sound-file (selected-file) + "Set `tmr-sound-file' to SELECTED-FILE, a basename within `sounds-dir'. +Return the confirmation message string (noting when it is the default sound)." + (setq tmr-sound-file (expand-file-name selected-file sounds-dir)) + (if (equal tmr-sound-file notification-sound) + (format "Timer sound set to default: %s" selected-file) + (format "Timer sound set to: %s" selected-file))) + (defun cj/tmr-select-sound-file () "Select a sound file from `sounds-dir' to use for tmr timers. @@ -80,13 +98,9 @@ Present all audio files in the sounds directory and set the chosen file as (if (boundp 'sounds-dir) sounds-dir "<unset>"))) (t (let ((sound-files (cj/tmr--available-sound-files))) - (cond - ((null sound-files) - (message "No audio files found in %s" sounds-dir)) - (t - (let* ((current-file (when (and tmr-sound-file - (file-exists-p tmr-sound-file)) - (file-name-nondirectory tmr-sound-file))) + (if (null sound-files) + (message "No audio files found in %s" sounds-dir) + (let* ((current-file (cj/tmr--current-sound-name)) (selected-file (completing-read (format "Select timer sound%s: " @@ -94,14 +108,9 @@ Present all audio files in the sounds directory and set the chosen file as (format " (current: %s)" current-file) "")) sound-files nil t nil nil current-file))) - (cond - ((or (null selected-file) (string-empty-p selected-file)) - (message "No file selected")) - (t - (setq tmr-sound-file (expand-file-name selected-file sounds-dir)) - (if (equal tmr-sound-file notification-sound) - (message "Timer sound set to default: %s" selected-file) - (message "Timer sound set to: %s" selected-file))))))))))) + (if (or (null selected-file) (string-empty-p selected-file)) + (message "No file selected") + (message "%s" (cj/tmr--apply-sound-file selected-file))))))))) (use-package tmr :defer 0.5 diff --git a/modules/cj-cache-lib.el b/modules/cj-cache-lib.el index 9aad51a3d..dc38b4836 100644 --- a/modules/cj-cache-lib.el +++ b/modules/cj-cache-lib.el @@ -10,7 +10,7 @@ ;; ;; Used by org-agenda-config and org-refile-config which previously ;; carried parallel hand-rolled implementations of this exact shape. -;; See docs/design/cache-helper-design.org for the API contract, +;; See docs/specs/cache-helper-design-spec-implemented.org for the API contract, ;; consumer migration shape, and rationale for the deliberate "nil ;; cached value reads as invalid" decision. ;; diff --git a/modules/cj-window-geometry-lib.el b/modules/cj-window-geometry-lib.el index 047fe7c45..4484a1d15 100644 --- a/modules/cj-window-geometry-lib.el +++ b/modules/cj-window-geometry-lib.el @@ -42,21 +42,34 @@ fails to span the full height." ((not spans-full-height) (if (= top root-top) 'above 'below)) (t (or default 'right))))) -(defun cj/window-body-size (window direction) - "Return WINDOW's body size on the axis matching DIRECTION. +(defun cj/window-replay-size (window direction) + "Return WINDOW's size to capture for geometry replay, on DIRECTION's axis. Returns body-width (columns) when DIRECTION is right or left. -Returns body-height (lines) when DIRECTION is below or above. - -Body size, not total size, is the right thing to capture for -geometry replay: total-width includes the right-side divider when -the window has a right sibling but excludes it at the frame edge, -so a captured rightmost window replayed into a middle position -would leave the body 1 col short. Body size is divider- -independent and matches what the user actually sees." +Returns total-height (lines) when DIRECTION is below or above. + +The axis choice is deliberately asymmetric, for two different reasons: + +- Width: body-width, not total-width. Total-width includes the right-side + divider when the window has a right sibling but excludes it at the frame + edge, so a captured rightmost window replayed into a middle position would + leave the body 1 col short. Body-width is divider-independent and matches + what the user sees. + +- Height: total-height, not body-height. Every window carries exactly one + mode line regardless of position, so total-height has no analog of the + divider-position problem -- it is position-independent. Body-height does + NOT work here: it subtracts the mode line's *pixel* height, which differs + between an active (full-height) and an inactive (theme-shrunk) mode line. + Capturing body-height while the window is active and replaying it while the + window is displayed inactive then re-measuring active drifts the value down + by ~1 line per toggle whenever the inactive mode line is shorter than a text + line (e.g. a theme that sets `mode-line-inactive' to a sub-line height). + Total-height is identical active or inactive, so the capture/replay + round-trip is a fixed point." (if (memq direction '(right left)) (window-body-width window) - (window-body-height window))) + (window-total-height window))) (defun cj/cardinal-to-edge-direction (direction) "Map cardinal DIRECTION to its `display-buffer-in-direction' edge variant. @@ -129,5 +142,39 @@ the fraction at toggle-off, replay it on the next toggle-on." (hi (or max-frac 0.95))) (max lo (min hi (/ (float window-size) frame-size)))))) +(defcustom cj/window-dock-min-columns 80 + "Minimum body columns each pane must keep for a side-by-side dock. + +`cj/preferred-dock-direction' docks a companion panel as a side-by-side +column only when both the panel and the main window would stay at least +this wide; otherwise it stacks the panel below. 80 is the classic +terminal/code width." + :type 'integer + :group 'windows) + +(defun cj/preferred-dock-direction (frame-cols fraction &optional min-cols) + "Return the dock direction for a companion panel beside the main window. + +Returns `right' (a side-by-side column) when a split that gives the panel +FRACTION of FRAME-COLS would leave both panes at least MIN-COLS columns +wide; otherwise `below' (a stacked panel). FRAME-COLS is the frame's +total column count; FRACTION is the panel's share of the width, in the +open interval (0, 1). MIN-COLS defaults to `cj/window-dock-min-columns'. + +The narrower of the two resulting panes governs: the panel takes +round(FRACTION * FRAME-COLS) columns, the main window takes the rest less +one divider column, and `right' is returned only when the smaller of the +two clears MIN-COLS. Returns `below' for degenerate input (non-positive +FRAME-COLS, or FRACTION outside (0, 1)) so a caller always gets a usable +stacked fallback." + (let ((min-cols (or min-cols cj/window-dock-min-columns))) + (if (and (numberp frame-cols) (> frame-cols 0) + (numberp fraction) (< 0 fraction 1)) + (let* ((panel (round (* fraction frame-cols))) + (main (- frame-cols panel 1)) + (narrower (min panel main))) + (if (>= narrower min-cols) 'right 'below)) + 'below))) + (provide 'cj-window-geometry-lib) ;;; cj-window-geometry-lib.el ends here diff --git a/modules/cj-window-toggle-lib.el b/modules/cj-window-toggle-lib.el index ba91f5a40..175a1d958 100644 --- a/modules/cj-window-toggle-lib.el +++ b/modules/cj-window-toggle-lib.el @@ -44,7 +44,7 @@ No-op when WINDOW is nil or not live." (if (or (null allowed) (memq dir allowed)) (progn (set direction-var dir) - (set size-var (cj/window-body-size window dir))) + (set size-var (cj/window-replay-size window dir))) (set direction-var default-direction) (set size-var nil))))) @@ -59,10 +59,12 @@ DEFAULT-SIZE when the stored values are nil. The cardinal direction is mapped to its frame-edge variant via `cj/cardinal-to-edge-direction' so the new buffer always lands at the same frame edge regardless of the selected window. An integer -size is wrapped in a `(body-columns . N)' / `(body-lines . N)' cons -so `display-buffer-in-direction' sets the body explicitly, -divider-independent. A float size passes through as a fraction of -the new window's parent. +size is wrapped per axis: a width size as a `(body-columns . N)' +cons (divider-independent body width), a height size as a plain +integer total-line count. Height uses total rather than body so the +capture/replay round-trip is immune to the mode line's pixel height +(see `cj/window-replay-size'). A float size passes through as a +fraction of the new window's parent. Caller-supplied ALIST entries for direction, window-width, or window-height are stripped before delegating to @@ -74,15 +76,15 @@ placement; the remaining alist entries are passed through." (edge-direction (or (cj/cardinal-to-edge-direction direction) (cj/cardinal-to-edge-direction default-direction))) (size (or stored-size default-size)) - (size-key (if (memq direction '(right left)) - 'window-width - 'window-height)) - (body-tag (if (memq direction '(right left)) - 'body-columns - 'body-lines)) - (size-value (if (integerp size) - (cons body-tag size) - size)) + (width-axis (memq direction '(right left))) + (size-key (if width-axis 'window-width 'window-height)) + ;; A width integer is a body-column count (divider-independent); a + ;; height integer is a plain total-line count (mode-line-pixel- + ;; independent -- see `cj/window-replay-size'). Floats pass through. + (size-value (cond + ((not (integerp size)) size) + (width-axis (cons 'body-columns size)) + (t size))) (filtered (cl-remove-if (lambda (cell) (memq (car-safe cell) diff --git a/modules/config-utilities.el b/modules/config-utilities.el index b3eec5d3d..0c98a896c 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -21,6 +21,19 @@ (require 'find-lisp) (require 'profiler) +;; External variables referenced at runtime only (org and the native +;; compiler are loaded lazily; declare to quiet the byte-compiler). +(defvar comp-async-report-warnings-errors) +(defvar org-ts-regexp) +(defvar org-agenda-files) + +;; External functions referenced at runtime only. +(declare-function org-element-parse-buffer "org-element") +(declare-function org-element-map "org-element") +(declare-function org-element-property "org-element-ast") +(declare-function org-time-string-to-absolute "org") +(declare-function org-alert-check "org-alert") + ;;; -------------------------------- Debug Keymap ------------------------------- (defvar-keymap cj/debug-config-keymap @@ -65,13 +78,15 @@ (with-eval-after-load 'emacsql-sqlite-builtin (cl-defmethod emacsql-close :around ((connection emacsql-sqlite-builtin-connection)) - (when (oref connection handle) + ;; The class is loaded lazily, so the slot is unknown at compile time. + (when (with-no-warnings (oref connection handle)) (cl-call-next-method)))) (with-eval-after-load 'emacsql-sqlite-module (cl-defmethod emacsql-close :around ((connection emacsql-sqlite-module-connection)) - (when (oref connection handle) + ;; The class is loaded lazily, so the slot is unknown at compile time. + (when (with-no-warnings (oref connection handle)) (cl-call-next-method)))) ;;; -------------------------------- Benchmarking ------------------------------- @@ -99,11 +114,14 @@ Signals `user-error' if METHOD-SYMBOL is nil or not fboundp." (with-timer title (funcall method-symbol))) +(require 'system-lib) + (defun cj/benchmark-this-method () "Prompt for a title and method name, then time the execution of the method." (interactive) (let* ((title (read-string "Enter the title for the timing: ")) - (method-name (completing-read "Enter the method name to time: " obarray + (method-name (completing-read "Enter the method name to time: " + (cj/completion-table 'function obarray) #'fboundp t)) (method-symbol (intern-soft method-name))) (condition-case err diff --git a/modules/coverage-core.el b/modules/coverage-core.el index 0a8b2464f..e8f7a4740 100644 --- a/modules/coverage-core.el +++ b/modules/coverage-core.el @@ -17,7 +17,7 @@ ;; intersects the results, and displays a report buffer. Languages ;; plug in via the backend registry (see `cj/coverage-backends'). ;; -;; See docs/design/coverage.org for the design rationale. +;; See docs/specs/coverage-spec-implemented.org for the design rationale. ;;; Code: @@ -25,6 +25,15 @@ (require 'subr-x) (require 'system-lib) +;; Make json.el's reader variables visible to the byte/native compiler so the +;; `let' bindings of `json-object-type' / `json-array-type' / `json-key-type' +;; in the parse helpers below bind dynamically. Without this the compiler +;; treats them as lexical (this file is lexical-binding), the bindings never +;; reach `json-read-file', and it returns json.el's default alist instead of +;; the hash tables the parsers maphash over. The runtime `(require 'json)' +;; inside each helper still keeps json off the load-time path. +(eval-when-compile (require 'json)) + (defvar cj/coverage-backends nil "Registry of coverage backends in priority order. Each entry is a plist with at least :name, :detect, :run, and :report-path. @@ -249,6 +258,27 @@ Signals `user-error' for any other SCOPE." (maphash (lambda (k _v) (push k keys)) table) (sort keys #'<))) +(defun cj/--coverage-relativize-keys (table root) + "Return a copy of TABLE with each file-path key made relative to ROOT. +An absolute key is relativized against ROOT via `file-relative-name'; an +already-relative key is kept as-is. Line-set values are shared, not copied. + +`cj/--coverage-parse-simplecov' emits absolute path keys (simplecov reports +absolute source paths) while `cj/--coverage-parse-diff-output' emits +repo-relative keys (git's \"+++ b/<path>\"). Both must be normalized to +repo-relative before `cj/--coverage-intersect' joins them by key, or every +diff-aware match misses and each changed file reads `:tracked nil'." + (let ((result (make-hash-table :test 'equal))) + (when table + (maphash + (lambda (path lines) + (let ((key (if (file-name-absolute-p path) + (file-relative-name path root) + path))) + (puthash key lines result))) + table)) + result)) + (defun cj/--coverage-intersect (covered changed) "Combine COVERED (LCOV) with CHANGED (git diff) into per-file records. COVERED and CHANGED are each hash tables from file path to a hash table @@ -479,10 +509,14 @@ line in the simplecov data — the intersect then classifies each line as covered or uncovered. For diff-aware scopes, the changed set comes from `git diff' via `cj/--coverage-changed-lines'." (let* ((report-path (funcall (plist-get backend :report-path))) - (covered (cj/--coverage-parse-simplecov report-path)) - (changed (if (eq scope 'whole-project) - (cj/--coverage-simplecov-executable-lines report-path) - (cj/--coverage-changed-lines scope))) + (root (cj/--coverage-project-root)) + (covered (cj/--coverage-relativize-keys + (cj/--coverage-parse-simplecov report-path) root)) + (changed (cj/--coverage-relativize-keys + (if (eq scope 'whole-project) + (cj/--coverage-simplecov-executable-lines report-path) + (cj/--coverage-changed-lines scope)) + root)) (records (cj/--coverage-intersect covered changed))) (cj/--coverage-render-to-buffer records scope))) diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el index 6c3e6c6e5..b10ecd168 100644 --- a/modules/custom-buffer-file.el +++ b/modules/custom-buffer-file.el @@ -48,6 +48,7 @@ ;; mm-decode for email viewing (mm-handle-type is a macro, needs early require) (require 'mm-decode) (require 'external-open) ;; for cj/xdg-open, cj/open-this-file-with +(require 'system-lib) ;; cj/confirm-strong (overwrite confirms), used below ;; cj/kill-buffer-and-window and cj/kill-other-window-buffer defined in undead-buffers.el (declare-function cj/kill-buffer-and-window "undead-buffers") @@ -156,7 +157,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case _ (cj/--move-buffer-and-file dir nil) (file-already-exists - (if (yes-or-no-p (format "File %s exists; overwrite? " target)) + (if (cj/confirm-strong (format "File %s exists; overwrite? " target)) (cj/--move-buffer-and-file dir t) (message "File not moved")))))) @@ -196,7 +197,7 @@ When called interactively, prompts for confirmation if target file exists." (condition-case err (cj/--rename-buffer-and-file new-name nil) (file-already-exists - (if (yes-or-no-p (format "File %s exists; overwrite? " new-name)) + (if (cj/confirm-strong (format "File %s exists; overwrite? " new-name)) (cj/--rename-buffer-and-file new-name t) (message "File not renamed"))) (error @@ -338,7 +339,6 @@ Do not save the deleted text in the kill ring." (kill-new (buffer-name)) (message "Copied: %s" (buffer-name))) -(require 'system-lib) (declare-function ansi-color-apply-on-region "ansi-color") (defun cj/--diff-with-difftastic (file1 file2 buffer) @@ -512,8 +512,8 @@ Signals an error if: "m" #'cj/move-buffer-and-file "r" #'cj/rename-buffer-and-file "p" #'cj/copy-buffer-source-as-kill - "d" #'cj/delete-buffer-and-file - "D" #'cj/diff-buffer-with-file + "d" #'cj/diff-buffer-with-file + "D" #'cj/delete-buffer-and-file "c" cj/copy-buffer-content-map "n" #'cj/copy-buffer-name "l" #'cj/copy-link-to-buffer-file @@ -546,8 +546,8 @@ Signals an error if: "C-; b m" "move file" "C-; b r" "rename file" "C-; b p" "copy buffer source" - "C-; b d" "delete file" - "C-; b D" "diff buffer with file" + "C-; b d" "diff buffer with file" + "C-; b D" "delete file" "C-; b c" "buffer copy menu" "C-; b c w" "copy whole buffer" "C-; b c b" "copy to bottom" diff --git a/modules/custom-case.el b/modules/custom-case.el index d30ebf942..876226958 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -49,6 +49,18 @@ (downcase-region (car bounds) (cdr bounds)) (user-error "No symbol at point"))))) +(defun cj/--title-case-capitalize-word-p (word is-first prev-word-end word-skip chars-skip-reset) + "Return non-nil when WORD at point should be capitalized in title case. +Point is at WORD's first character. WORD is capitalized when it is the first +word (IS-FIRST), is not a minor skip word (in WORD-SKIP), or immediately follows +a skip-reset character (one of CHARS-SKIP-RESET: : ! ?), reached by skipping +blanks back to PREV-WORD-END." + (or is-first + (not (member word word-skip)) + (save-excursion + (and (not (zerop (skip-chars-backward "[:blank:]" prev-word-end))) + (memq (char-before (point)) chars-skip-reset))))) + (defun cj/title-case-region () "Capitalize the region in title case format. Title case is a capitalization convention where major words are capitalized, @@ -58,67 +70,53 @@ considered major words. Short (i.e., three letters or fewer) conjunctions, short prepositions, and all articles are considered minor words." (interactive) (let ((beg nil) - (end nil) - (prev-word-end nil) - ;; Allow capitals for skip characters after this, so: - ;; Warning: An Example - ;; Capitalizes the `An'. - (chars-skip-reset '(?: ?! ??)) - ;; Don't capitalize characters directly after these. e.g. - ;; "Foo-bar" or "Foo\bar" or "Foo's". - - (chars-separator '(?\\ ?- ?' ?.)) - - (word-chars "[:alnum:]") - (word-skip - (list "a" "an" "and" "as" "at" "but" "by" - "for" "if" "in" "is" "nor" "of" - "on" "or" "so" "the" "to" "yet")) - (is-first t)) - (cond - ((region-active-p) - (setq beg (region-beginning)) - (setq end (region-end))) - (t - (setq beg (line-beginning-position)) - (setq end (line-end-position)))) - (save-excursion - ;; work on uppercased text (e.g., headlines) by downcasing first - (downcase-region beg end) - (goto-char beg) - - (while (< (point) end) - (setq prev-word-end (point)) - (skip-chars-forward (concat "^" word-chars) end) - (when (>= (point) end) ;; no word chars remaining - (goto-char end)) - (let ((word-end - (save-excursion - (skip-chars-forward word-chars end) - (point)))) - - (unless (or (>= (point) end) - (memq (char-before (point)) chars-separator)) - (let* ((c-orig (char-to-string (char-after (point)))) - (c-up (capitalize c-orig))) - (unless (string-equal c-orig c-up) - (let ((word (buffer-substring-no-properties (point) word-end))) - (when - (or - ;; Always allow capitalization. - is-first - ;; If it's not a skip word, allow. - (not (member word word-skip)) - ;; Check the beginning of the previous word doesn't reset first. - (save-excursion - (and - (not (zerop - (skip-chars-backward "[:blank:]" prev-word-end))) - (memq (char-before (point)) chars-skip-reset)))) - (delete-region (point) (1+ (point))) - (insert c-up)))))) - (goto-char word-end) - (setq is-first nil)))))) + (end nil) + (prev-word-end nil) + ;; Allow capitals for skip characters after this, so: + ;; Warning: An Example + ;; Capitalizes the `An'. + (chars-skip-reset '(?: ?! ??)) + ;; Don't capitalize characters directly after these. e.g. + ;; "Foo-bar" or "Foo\bar" or "Foo's". + (chars-separator '(?\\ ?- ?' ?.)) + (word-chars "[:alnum:]") + (word-skip + (list "a" "an" "and" "as" "at" "but" "by" + "for" "if" "in" "is" "nor" "of" + "on" "or" "so" "the" "to" "yet")) + (is-first t)) + (cond + ((region-active-p) + (setq beg (region-beginning)) + (setq end (region-end))) + (t + (setq beg (line-beginning-position)) + (setq end (line-end-position)))) + (save-excursion + ;; work on uppercased text (e.g., headlines) by downcasing first + (downcase-region beg end) + (goto-char beg) + (while (< (point) end) + (setq prev-word-end (point)) + (skip-chars-forward (concat "^" word-chars) end) + (when (>= (point) end) ;; no word chars remaining + (goto-char end)) + (let ((word-end + (save-excursion + (skip-chars-forward word-chars end) + (point)))) + (unless (or (>= (point) end) + (memq (char-before (point)) chars-separator)) + (let* ((c-orig (char-to-string (char-after (point)))) + (c-up (capitalize c-orig))) + (unless (string-equal c-orig c-up) + (let ((word (buffer-substring-no-properties (point) word-end))) + (when (cj/--title-case-capitalize-word-p + word is-first prev-word-end word-skip chars-skip-reset) + (delete-region (point) (1+ (point))) + (insert c-up)))))) + (goto-char word-end) + (setq is-first nil)))))) ;; replace the capitalize-region keybinding to call title-case (keymap-global-set "<remap> <capitalize-region>" #'cj/title-case-region) diff --git a/modules/custom-comments.el b/modules/custom-comments.el index b6919d651..a2604a558 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -5,62 +5,17 @@ ;; Layer: 2 (Core UX). ;; Category: L/C. ;; Load shape: eager. -;; Eager reason: registers its C-; C comment submap at load. Currently eager by -;; init order; a deferral candidate for Phase 3/4 (command/autoload + -;; registration API). -;; Top-level side effects: defines cj/comment-map, registers it under C-; C. +;; Eager reason: registers C-; C comment helpers. +;; Top-level side effects: defines and registers cj/comment-map. ;; Runtime requires: keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; This module provides custom comment formatting and manipulation utilities for code editing. -;; -;; Functions include: -;; - deleting all comments in a buffer, -;; - reformatting commented text into single-line paragraphs, -;; - creating centered comment headers with customizable separator characters, -;; - creating comment boxes around text -;; - inserting hyphen-style centered comments. -;; -;; These utilities help create consistent, well-formatted code comments and section headers. -;; Bound to keymap prefix: C-; C -;; -;; Comment Style Patterns: -;; -;; inline-border: -;; ========== inline-border ========== -;; -;; simple-divider: -;; ==================================== -;; simple-divider -;; ==================================== -;; -;; padded-divider: -;; ==================================== -;; padded-divider -;; ==================================== -;; -;; box: -;; ************************************ -;; * box * -;; ************************************ -;; -;; heavy-box: -;; ************************************ -;; * * -;; * heavy-box * -;; * * -;; ************************************ -;; -;; unicode-box: -;; ┌──────────────────────────────────┐ -;; │ unicode-box │ -;; └──────────────────────────────────┘ -;; -;; block-banner: -;; /************************************ -;; * block-banner -;; ************************************/ +;; Comment editing helpers: delete comments, reflow commented regions, and insert +;; consistent section headers or boxes using the current mode's comment syntax. ;; +;; Public commands live under C-; C. Decoration helpers validate single printable +;; characters before generating comment borders. + ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap @@ -109,6 +64,14 @@ inputs. Used by all divider / border helpers below." decoration-char)) decoration-char) +(defun cj/--comment-emit-prefix (cmt-start) + "Insert CMT-START -- doubled when it is a lone semicolon -- and a trailing space. +A bare =;= is doubled to =;;= so the line reads as an Emacs-Lisp comment. This +is the line-opening prologue shared by the divider and inline-border emitters." + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " ")) + ;; ----------------------------- Inline Border --------------------------------- (defun cj/--comment-inline-border (cmt-start cmt-end decoration-char text length) @@ -138,10 +101,7 @@ LENGTH is the total width of the line." (error "Length %d is too small for text '%s' (need at least %d more chars)" length text (- min-space space-on-each-side))) ;; Generate the line - (insert cmt-start) - (when (equal cmt-start ";") - (insert cmt-start)) - (insert " ") + (cj/--comment-emit-prefix cmt-start) ;; Left decoration (dotimes (_ space-on-each-side) (insert decoration-char)) @@ -181,48 +141,11 @@ Uses the lesser of `fill-column\\=' or 80 for line length." CMT-START and CMT-END are the comment syntax strings. DECORATION-CHAR is the character to use for the divider lines. TEXT is the comment text. -LENGTH is the total width of each line." - (cj/--validate-decoration-char decoration-char) - (let* ((current-column-pos (current-column)) - (min-length (+ current-column-pos - (length cmt-start) - (if (equal cmt-start ";") 1 0) ; doubled semicolon - 1 ; space after comment-start - 3 ; minimum decoration chars - (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) - (when (< length min-length) - (error "Length %d is too small to generate comment (minimum %d)" length min-length)) - (let* ((available-width (- length current-column-pos - (length cmt-start) - (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) - (line (make-string available-width (string-to-char decoration-char)))) - ;; Top line - (insert cmt-start) - (when (equal cmt-start ";") (insert cmt-start)) - (insert " ") - (insert line) - (when (not (string-empty-p cmt-end)) - (insert " " cmt-end)) - (newline) +LENGTH is the total width of each line. - ;; Text line - (dotimes (_ current-column-pos) (insert " ")) - (insert cmt-start) - (when (equal cmt-start ";") (insert cmt-start)) - (insert " " text) - (when (not (string-empty-p cmt-end)) - (insert " " cmt-end)) - (newline) - - ;; Bottom line - (dotimes (_ current-column-pos) (insert " ")) - (insert cmt-start) - (when (equal cmt-start ";") (insert cmt-start)) - (insert " ") - (insert line) - (when (not (string-empty-p cmt-end)) - (insert " " cmt-end)) - (newline)))) +A simple divider is a padded divider with no padding before the text, so it +delegates to `cj/--comment-padded-divider' with PADDING 0." + (cj/--comment-padded-divider cmt-start cmt-end decoration-char text length 0)) (defun cj/comment-simple-divider () "Insert a simple divider comment banner. @@ -276,9 +199,7 @@ PADDING is the number of spaces before the text." (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) (line (make-string available-width (string-to-char decoration-char)))) ;; Top line - (insert cmt-start) - (when (equal cmt-start ";") (insert cmt-start)) - (insert " ") + (cj/--comment-emit-prefix cmt-start) (insert line) (when (not (string-empty-p cmt-end)) (insert " " cmt-end)) @@ -286,9 +207,7 @@ PADDING is the number of spaces before the text." ;; Text line with padding (dotimes (_ current-column-pos) (insert " ")) - (insert cmt-start) - (when (equal cmt-start ";") (insert cmt-start)) - (insert " ") + (cj/--comment-emit-prefix cmt-start) (dotimes (_ padding) (insert " ")) (insert text) (when (not (string-empty-p cmt-end)) @@ -297,9 +216,7 @@ PADDING is the number of spaces before the text." ;; Bottom line (dotimes (_ current-column-pos) (insert " ")) - (insert cmt-start) - (when (equal cmt-start ";") (insert cmt-start)) - (insert " ") + (cj/--comment-emit-prefix cmt-start) (insert line) (when (not (string-empty-p cmt-end)) (insert " " cmt-end)) @@ -335,12 +252,12 @@ Prompts for decoration character, text, padding, and length option." ;; -------------------------------- Comment Box -------------------------------- -(defun cj/--comment-box (cmt-start cmt-end decoration-char text length) - "Internal implementation: Generate a 3-line box comment with centered text. -CMT-START and CMT-END are the comment syntax strings. -DECORATION-CHAR is the character to use for borders. -TEXT is the comment text (centered). -LENGTH is the total width of each line." +(defun cj/--comment-box-emit (cmt-start cmt-end decoration-char text length heavy) + "Emit a box comment with centered TEXT; the border/text/border skeleton. +CMT-START and CMT-END are the comment syntax strings. DECORATION-CHAR borders +the box. LENGTH is the total width of each line. When HEAVY is non-nil, an +interior blank-bordered line is added above and below the text line (the only +difference between the plain box and the heavy box)." (cj/--validate-decoration-char decoration-char) (let* ((current-column-pos (current-column)) (comment-char (if (equal cmt-start ";") ";;" cmt-start)) @@ -363,11 +280,22 @@ LENGTH is the total width of each line." (padding-each-side (max 1 (/ (- text-available text-length) 2))) (right-padding (if (= (% (- text-available text-length) 2) 0) padding-each-side - (1+ padding-each-side)))) + (1+ padding-each-side))) + ;; Interior side-border line: repeats the comment prefix and suffix so + ;; the blank rows stay valid comments in line-comment languages (elisp, + ;; Python). Only inserted for the heavy box. + (empty-line (concat comment-char " " decoration-char + (make-string (- available-width 2) ?\s) + decoration-char " " comment-end-char))) ;; Top border (insert comment-char " " border-line " " comment-end-char) (newline) + (when heavy + (dotimes (_ current-column-pos) (insert " ")) + (insert empty-line) + (newline)) + ;; Centered text line with side borders (dotimes (_ current-column-pos) (insert " ")) (insert comment-char " " decoration-char " ") @@ -377,11 +305,24 @@ LENGTH is the total width of each line." (insert " " decoration-char " " comment-end-char) (newline) + (when heavy + (dotimes (_ current-column-pos) (insert " ")) + (insert empty-line) + (newline)) + ;; Bottom border (dotimes (_ current-column-pos) (insert " ")) (insert comment-char " " border-line " " comment-end-char) (newline)))) +(defun cj/--comment-box (cmt-start cmt-end decoration-char text length) + "Internal implementation: Generate a 3-line box comment with centered text. +CMT-START and CMT-END are the comment syntax strings. +DECORATION-CHAR is the character to use for borders. +TEXT is the comment text (centered). +LENGTH is the total width of each line." + (cj/--comment-box-emit cmt-start cmt-end decoration-char text length nil)) + (defun cj/comment-box () "Insert a 3-line comment box with centered text. Prompts for decoration character, text, and uses `fill-column' for length." @@ -404,52 +345,11 @@ Prompts for decoration character, text, and uses `fill-column' for length." CMT-START and CMT-END are the comment syntax strings. DECORATION-CHAR is the character to use for borders. TEXT is the comment text (centered). -LENGTH is the total width of each line." - (cj/--validate-decoration-char decoration-char) - (let* ((current-column-pos (current-column)) - (comment-char (if (equal cmt-start ";") ";;" cmt-start)) - (comment-end-char (if (string-empty-p cmt-end) comment-char cmt-end)) - (available-width (- length current-column-pos - (length comment-char) - (length comment-end-char) - 2)) ; spaces around content - (border-line (make-string available-width (string-to-char decoration-char))) - (text-length (length text)) - (padding-each-side (max 1 (/ (- available-width text-length) 2))) - (right-padding (if (= (% (- available-width text-length) 2) 0) - padding-each-side - (1+ padding-each-side)))) - ;; Top border - (insert comment-char " " border-line " " comment-end-char) - (newline) - - ;; Empty line with side borders - (dotimes (_ current-column-pos) (insert " ")) - (insert decoration-char) - (dotimes (_ available-width) (insert " ")) - (insert " " decoration-char) - (newline) - - ;; Centered text line - (dotimes (_ current-column-pos) (insert " ")) - (insert decoration-char " ") - (dotimes (_ padding-each-side) (insert " ")) - (insert text) - (dotimes (_ right-padding) (insert " ")) - (insert " " decoration-char) - (newline) - - ;; Empty line with side borders - (dotimes (_ current-column-pos) (insert " ")) - (insert decoration-char) - (dotimes (_ available-width) (insert " ")) - (insert " " decoration-char) - (newline) +LENGTH is the total width of each line. - ;; Bottom border - (dotimes (_ current-column-pos) (insert " ")) - (insert comment-char " " border-line " " comment-end-char) - (newline))) +A heavy box is a box with an interior blank-bordered line above and below the +text, so it delegates to `cj/--comment-box-emit' with HEAVY non-nil." + (cj/--comment-box-emit cmt-start cmt-end decoration-char text length t)) (defun cj/comment-heavy-box () "Insert a heavy box comment with blank lines around centered text. diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index 87b286de7..0528688c2 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -1,4 +1,4 @@ -;;; custom-datetime.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-datetime.el --- Insert formatted date and time strings -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -12,47 +12,33 @@ ;; Runtime requires: keybindings. ;; Direct test load: yes (requires keybindings explicitly). ;; -;; Utilities for inserting date/time stamps in multiple formats. -;; -;; Interactive commands: -;; - cj/insert-readable-date-time -;; - cj/insert-sortable-date-time -;; - cj/insert-sortable-time -;; - cj/insert-readable-time -;; - cj/insert-sortable-date -;; - cj/insert-readable-date -;; -;; Each command uses a corresponding format variable: -;; readable-date-time-format, sortable-date-time-format, -;; sortable-time-format, readable-time-format, -;; sortable-date-format, readable-date-format. -;; Customize these (see =format-time-string') to change output. -;; Some defaults include a trailing space for convenient typing. -;; -;; Key bindings: -;; A prefix map =cj/datetime-map' is installed on "d" under =cj/custom-keymap': -;; r → readable date+time -;; s → sortable date+time -;; t → sortable time -;; T → readable time -;; d → sortable date -;; D → readable date +;; Date/time insertion commands under C-; d. Each command is generated from a +;; customizable format variable and inserts format-time-string output at point. ;; ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap +(defmacro cj/--define-datetime-inserter (name format-var thing) + "Define interactive command NAME inserting the current THING at point. +THING is a short noun phrase (\"date and time\", \"time\", \"date\") used in +the docstring. The inserted text is `format-time-string' applied to +FORMAT-VAR's value, so customizing FORMAT-VAR changes the output." + (declare (indent defun)) + `(defun ,name () + ,(format "Insert the current %s into the current buffer.\nUse `%s' for formatting." + thing format-var) + (interactive) + (insert (format-time-string ,format-var (current-time))))) + ;; ----------------------------- Readable Date Time ---------------------------- (defvar readable-date-time-format "%A, %B %d, %Y at %I:%M:%S %p %Z " "Format string used by `cj/insert-readable-date-time'. See `format-time-string' for possible replacements.") -(defun cj/insert-readable-date-time () - "Insert the current date and time into the current buffer. -Use `readable-date-time-format' for formatting." - (interactive) - (insert (format-time-string readable-date-time-format (current-time)))) +(cj/--define-datetime-inserter cj/insert-readable-date-time + readable-date-time-format "date and time") ;; ----------------------------- Sortable Date Time ---------------------------- @@ -60,11 +46,8 @@ Use `readable-date-time-format' for formatting." "Format string used by `cj/insert-sortable-date-time'. See `format-time-string' for possible replacements.") -(defun cj/insert-sortable-date-time () - "Insert the current date and time into the current buffer. -Use `sortable-date-time-format' for formatting." - (interactive) - (insert (format-time-string sortable-date-time-format (current-time)))) +(cj/--define-datetime-inserter cj/insert-sortable-date-time + sortable-date-time-format "date and time") ;; ------------------------------- Sortable Time ------------------------------- @@ -72,11 +55,8 @@ Use `sortable-date-time-format' for formatting." "Format string used by `cj/insert-sortable-time'. See `format-time-string' for possible replacements.") -(defun cj/insert-sortable-time () - "Insert the current time into the current buffer. -Use `sortable-time-format' for formatting." - (interactive) - (insert (format-time-string sortable-time-format (current-time)))) +(cj/--define-datetime-inserter cj/insert-sortable-time + sortable-time-format "time") ;; ------------------------------- Readable Time ------------------------------- @@ -84,11 +64,8 @@ Use `sortable-time-format' for formatting." "Format string used by `cj/insert-readable-time'. See `format-time-string' for possible replacements.") -(defun cj/insert-readable-time () - "Insert the current time into the current buffer. -Use `readable-time-format' for formatting." - (interactive) - (insert (format-time-string readable-time-format (current-time)))) +(cj/--define-datetime-inserter cj/insert-readable-time + readable-time-format "time") ;; ------------------------------- Sortable Date ------------------------------- @@ -96,11 +73,8 @@ Use `readable-time-format' for formatting." "Format string used by `cj/insert-sortable-date'. See `format-time-string' for possible replacements.") -(defun cj/insert-sortable-date () - "Insert the current date into the current buffer. -Use `sortable-date-format' for formatting." - (interactive) - (insert (format-time-string sortable-date-format (current-time)))) +(cj/--define-datetime-inserter cj/insert-sortable-date + sortable-date-format "date") ;; ------------------------------- Readable Date ------------------------------- @@ -108,11 +82,8 @@ Use `sortable-date-format' for formatting." "Format string used by `cj/insert-readable-date'. See `format-time-string' for possible replacements.") -(defun cj/insert-readable-date () - "Insert the current date into the current buffer. -Use `readable-date-format' for formatting." - (interactive) - (insert (format-time-string readable-date-format (current-time)))) +(cj/--define-datetime-inserter cj/insert-readable-date + readable-date-format "date") ;; ------------------------------ Date Time Keymap ----------------------------- diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index 2cbcecc16..dd2999c4e 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -1,4 +1,4 @@ -;;; custom-line-paragraph.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-line-paragraph.el --- Line and paragraph editing commands -*- coding: utf-8; lexical-binding: t; -*- ;; Author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: @@ -14,16 +14,9 @@ ;; Runtime requires: keybindings (expand-region on demand via declare-function). ;; Direct test load: yes (requires keybindings explicitly). ;; -;; This module provides the following line and paragraph manipulation utilities: -;; -;; - joining lines in a region or the current line with the previous one -;; - joining separate lines into a single paragraph -;; - duplicating lines or regions (optional commenting) -;; - removing duplicate lines -;; - removing lines containing specific text -;; - underlining text with a custom character -;; -;; Bound to keymap prefix C-; l +;; Line and paragraph transforms under C-; l: join, duplicate, delete matching +;; lines, remove duplicates, and underline text. Commands operate on the active +;; region when present and otherwise on the current line or paragraph. ;; ;;; Code: diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 578bede4b..4dc5bff84 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -1,4 +1,4 @@ -;;; custom-ordering.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-ordering.el --- Region sorting and list-format transforms -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -13,22 +13,10 @@ ;; declare-function). ;; Direct test load: yes (requires keybindings explicitly). ;; -;; Text transformation and sorting utilities for reformatting data structures. +;; Region transforms under C-; o for sorting, reversing, numbering, quote +;; toggling, and converting between line lists and comma-separated arrays. +;; Helpers preserve trailing newlines where line-oriented callers expect them. ;; -;; Array/list formatting: -;; - arrayify/listify - convert lines to comma-separated format (with/without quotes, brackets) -;; - unarrayify - convert arrays back to separate lines -;; -;; Line manipulation: -;; - toggle-quotes - swap double ↔ single quotes -;; - reverse-lines - reverse line order -;; - number-lines - add line numbers with custom format (supports zero-padding) -;; - alphabetize-region - sort words alphabetically -;; - comma-separated-text-to-lines - split CSV text into lines -;; -;; Convenience functions: listify, arrayify-json, arrayify-python -;; Bound to keymap prefix C-; o - ;;; Code: (require 'cl-lib) @@ -40,6 +28,23 @@ (defvar cj/ordering-map) +(defun cj/--ordering-validate-region (start end) + "Signal an error when START is greater than END. +Shared guard for the pure ordering helpers below, which all operate on a +buffer region and must reject an inverted one before reading it." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end))) + +(defun cj/--ordering-replace-region (start end insertion) + "Replace the buffer text between START and END with INSERTION. +Point is left after the inserted text. Shared tail for the interactive +ordering commands, which all compute a transformed string from the +original region then swap it in. INSERTION is evaluated by the caller +before this runs, so the transform reads the pre-deletion text." + (delete-region start end) + (goto-char start) + (insert insertion)) + (defun cj/--arrayify (start end quote &optional prefix suffix) "Internal implementation: Convert lines to quoted, comma-separated format. START and END define the region to operate on. @@ -50,8 +55,7 @@ SUFFIX is an optional string to append to the result (e.g., \"]\" or \")\"). Preserves a trailing newline if the input region ends with one, so line-oriented operations on the result behave the same as before. Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let* ((raw (buffer-substring start end)) (trailing-newline (string-suffix-p "\n" raw)) (result (mapconcat @@ -65,36 +69,29 @@ Returns the transformed string without modifying the buffer." START and END identify the active region. QUOTE specifies the quotation characters to surround each element." (interactive "r\nMQuotation character to use for array element: ") - (let ((insertion (cj/--arrayify start end quote))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region start end (cj/--arrayify start end quote))) (defun cj/listify (start end) "Convert lines between START and END into an unquoted, comma-separated list. START and END identify the active region. Example: `apple banana cherry' becomes `apple, banana, cherry'." (interactive "r") - (let ((insertion (cj/--arrayify start end ""))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region start end (cj/--arrayify start end ""))) (defun cj/arrayify-json (start end) "Convert lines between START and END into a JSON-style array. START and END identify the active region. Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'." (interactive "r") - (let ((insertion (cj/--arrayify start end "\"" "[" "]"))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region start end (cj/--arrayify start end "\"" "[" "]"))) -(defun cj/arrayify-python (start end) - "Convert lines between START and END into a Python-style list. -START and END identify the active region. -Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'." - (interactive "r") - (let ((insertion (cj/--arrayify start end "\"" "[" "]"))) - (delete-region start end) - (insert insertion))) +;; JSON arrays and Python lists coincide here (double-quoted, square-bracketed), +;; so the Python command is an alias. Split it back into its own defun if the +;; two formats ever need to differ (e.g. Python single quotes). +(defalias 'cj/arrayify-python 'cj/arrayify-json + "Convert lines in the active region into a Python-style list. +Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'. +Currently identical to `cj/arrayify-json'.") (defun cj/--unarrayify (start end) "Internal implementation: Convert comma-separated array to lines. @@ -102,8 +99,7 @@ START and END define the region to operate on. Removes quotes (both single and double) and splits by ', '. Preserves a trailing newline if the input region ends with one. Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let* ((raw (buffer-substring start end)) (trailing-newline (string-suffix-p "\n" raw)) (result (mapconcat @@ -115,17 +111,14 @@ Returns the transformed string without modifying the buffer." "Convert quoted comma-separated strings between START and END to separate lines. START and END identify the active region." (interactive "r") - (let ((insertion (cj/--unarrayify start end))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region start end (cj/--unarrayify start end))) (defun cj/--toggle-quotes (start end) "Internal implementation: Toggle between double and single quotes. START and END define the region to operate on. Swaps all double quotes with single quotes and vice versa. Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let ((text (buffer-substring start end))) (with-temp-buffer (insert text) @@ -145,16 +138,13 @@ Returns the transformed string without modifying the buffer." "Toggle between double and single quotes in region between START and END. START and END identify the active region." (interactive "r") - (let ((insertion (cj/--toggle-quotes start end))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region start end (cj/--toggle-quotes start end))) (defun cj/--reverse-lines (start end) "Internal implementation: Reverse the order of lines in region. START and END define the region to operate on. Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let ((lines (split-string (buffer-substring start end) "\n"))) (mapconcat #'identity (nreverse lines) "\n"))) @@ -162,9 +152,7 @@ Returns the transformed string without modifying the buffer." "Reverse the order of lines in region between START and END. START and END identify the active region." (interactive "r") - (let ((insertion (cj/--reverse-lines start end))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region start end (cj/--reverse-lines start end))) (defun cj/--number-lines (start end format-string zero-pad) "Internal implementation: Number lines in region with custom format. @@ -175,8 +163,7 @@ FORMAT-STRING is the format for each line, with N as placeholder for number. ZERO-PAD when non-nil pads numbers with zeros for alignment. Example with 100 lines: \"001\", \"002\", ..., \"100\". Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let* ((lines (split-string (buffer-substring start end) "\n")) (line-count (length lines)) (width (if zero-pad (length (number-to-string line-count)) 1)) @@ -199,17 +186,15 @@ FORMAT-STRING is the format for each line, with N as placeholder for number. Example: \"N. \" produces \"1. \", \"2. \", etc. ZERO-PAD when non-nil (prefix argument) pads numbers with zeros." (interactive "r\nMFormat string (use N for number): \nP") - (let ((insertion (cj/--number-lines start end format-string zero-pad))) - (delete-region start end) - (insert insertion))) + (cj/--ordering-replace-region + start end (cj/--number-lines start end format-string zero-pad))) (defun cj/--alphabetize-region (start end) "Internal implementation: Alphabetize words in region. START and END define the region to operate on. Splits by whitespace and commas, sorts alphabetically, joins with ', '. Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let ((string (buffer-substring-no-properties start end))) (mapconcat #'identity (sort (split-string string "[[:space:],]+" t) @@ -221,21 +206,17 @@ Returns the transformed string without modifying the buffer." Produce a comma-separated list as the result." (interactive) (unless (use-region-p) - (user-error "No region selected")) + (user-error "No region selected")) (let ((start (region-beginning)) - (end (region-end)) - (insertion (cj/--alphabetize-region (region-beginning) (region-end)))) - (delete-region start end) - (goto-char start) - (insert insertion))) + (end (region-end))) + (cj/--ordering-replace-region start end (cj/--alphabetize-region start end)))) (defun cj/--comma-separated-text-to-lines (start end) "Internal implementation: Convert comma-separated text to lines. START and END define the region to operate on. Replaces commas with newlines and removes trailing whitespace from each line. Returns the transformed string without modifying the buffer." - (when (> start end) - (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (cj/--ordering-validate-region start end) (let ((text (buffer-substring-no-properties start end))) (with-temp-buffer (insert text) @@ -249,14 +230,11 @@ Returns the transformed string without modifying the buffer." "Break up comma-separated text in active region so each item is on own line." (interactive) (if (not (region-active-p)) - (error "No region selected")) - + (error "No region selected")) (let ((beg (region-beginning)) - (end (region-end)) - (text (cj/--comma-separated-text-to-lines (region-beginning) (region-end)))) - (delete-region beg end) - (goto-char beg) - (insert text))) + (end (region-end))) + (cj/--ordering-replace-region + beg end (cj/--comma-separated-text-to-lines beg end)))) diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index fdfb92230..4d72347d1 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -1,4 +1,4 @@ -;;; custom-text-enclose.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-text-enclose.el --- Wrap, unwrap, and prefix text ranges -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -12,23 +12,10 @@ ;; Runtime requires: keybindings (change-inner on demand via declare-function). ;; Direct test load: yes (requires keybindings explicitly). ;; -;; Text enclosure utilities for wrapping and line manipulation. +;; Text enclosure commands under C-; s. Commands wrap or unwrap the active +;; region/word at point, and add prefixes, suffixes, indentation, or dedentation +;; across selected lines. ;; -;; Wrapping functions: -;; - surround-word-or-region - wrap text with same delimiter on both sides -;; - wrap-word-or-region - wrap with different opening/closing delimiters -;; - unwrap-word-or-region - remove surrounding delimiters -;; -;; Line manipulation: -;; - append-to-lines - add suffix to each line -;; - prepend-to-lines - add prefix to each line -;; - indent-lines - add leading whitespace (spaces or tabs) -;; - dedent-lines - remove leading whitespace -;; -;; Most functions work on region or entire buffer when no region is active. -;; -;; Bound to keymap prefix C-; s - ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap @@ -54,48 +41,42 @@ CLOSING is appended to TEXT. Returns the wrapped text without modifying the buffer." (concat opening text closing)) +(defun cj/--enclose-region-or-word (transform &optional no-target-message) + "Apply TRANSFORM to the active region or the word at point, in place. +TRANSFORM is a function of one string (the target text) returning the +replacement text. An active region is the target; otherwise the word at +point is. With neither, show NO-TARGET-MESSAGE (or a default) and leave the +buffer unchanged. Point is left after the inserted text." + (let ((bounds (cond ((use-region-p) (cons (region-beginning) (region-end))) + ((thing-at-point 'word) (bounds-of-thing-at-point 'word))))) + (if (null bounds) + (message "%s" (or no-target-message + "Can't do that. No word at point and no region selected.")) + (let* ((beg (car bounds)) + (end (cdr bounds)) + (text (buffer-substring beg end))) + (delete-region beg end) + (goto-char beg) + (insert (funcall transform text)))))) + (defun cj/surround-word-or-region () "Surround the word at point or active region with a string. The surround string is read from the minibuffer." (interactive) - (let ((str (read-string "Surround with: ")) - (regionp (use-region-p))) - (if regionp - (let ((beg (region-beginning)) - (end (region-end)) - (text (buffer-substring (region-beginning) (region-end)))) - (delete-region beg end) - (goto-char beg) - (insert (cj/--surround text str))) - (if (thing-at-point 'word) - (let* ((bounds (bounds-of-thing-at-point 'word)) - (text (buffer-substring (car bounds) (cdr bounds)))) - (delete-region (car bounds) (cdr bounds)) - (goto-char (car bounds)) - (insert (cj/--surround text str))) - (message "Can't insert around. No word at point and no region selected."))))) + (let ((str (read-string "Surround with: "))) + (cj/--enclose-region-or-word + (lambda (text) (cj/--surround text str)) + "Can't insert around. No word at point and no region selected."))) (defun cj/wrap-word-or-region () "Wrap the word at point or active region with different opening/closing strings. The opening and closing strings are read from the minibuffer." (interactive) (let ((opening (read-string "Opening: ")) - (closing (read-string "Closing: ")) - (regionp (use-region-p))) - (if regionp - (let ((beg (region-beginning)) - (end (region-end)) - (text (buffer-substring (region-beginning) (region-end)))) - (delete-region beg end) - (goto-char beg) - (insert (cj/--wrap text opening closing))) - (if (thing-at-point 'word) - (let* ((bounds (bounds-of-thing-at-point 'word)) - (text (buffer-substring (car bounds) (cdr bounds)))) - (delete-region (car bounds) (cdr bounds)) - (goto-char (car bounds)) - (insert (cj/--wrap text opening closing))) - (message "Can't wrap. No word at point and no region selected."))))) + (closing (read-string "Closing: "))) + (cj/--enclose-region-or-word + (lambda (text) (cj/--wrap text opening closing)) + "Can't wrap. No word at point and no region selected."))) (defun cj/--unwrap (text opening closing) "Internal implementation: Remove OPENING and CLOSING from TEXT if present. @@ -114,22 +95,10 @@ Returns the unwrapped text if both delimiters present, otherwise unchanged." The opening and closing strings are read from the minibuffer." (interactive) (let ((opening (read-string "Opening to remove: ")) - (closing (read-string "Closing to remove: ")) - (regionp (use-region-p))) - (if regionp - (let ((beg (region-beginning)) - (end (region-end)) - (text (buffer-substring (region-beginning) (region-end)))) - (delete-region beg end) - (goto-char beg) - (insert (cj/--unwrap text opening closing))) - (if (thing-at-point 'word) - (let* ((bounds (bounds-of-thing-at-point 'word)) - (text (buffer-substring (car bounds) (cdr bounds)))) - (delete-region (car bounds) (cdr bounds)) - (goto-char (car bounds)) - (insert (cj/--unwrap text opening closing))) - (message "Can't unwrap. No word at point and no region selected."))))) + (closing (read-string "Closing to remove: "))) + (cj/--enclose-region-or-word + (lambda (text) (cj/--unwrap text opening closing)) + "Can't unwrap. No word at point and no region selected."))) (defun cj/--append-to-lines (text suffix) "Internal implementation: Append SUFFIX to each line in TEXT. diff --git a/modules/custom-whitespace.el b/modules/custom-whitespace.el index 0d4d1cc06..cbf3eff12 100644 --- a/modules/custom-whitespace.el +++ b/modules/custom-whitespace.el @@ -1,4 +1,4 @@ -;;; custom-whitespace.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-whitespace.el --- Whitespace cleanup commands -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: ;; @@ -12,19 +12,10 @@ ;; Runtime requires: keybindings. ;; Direct test load: yes (requires keybindings explicitly). ;; -;; This module provides whitespace manipulation operations for cleaning and transforming whitespace in text. - -;; Functions include: - -;; - removing leading and trailing whitespace -;; - collapsing multiple spaces to single spaces -;; - deleting blank lines -;; - converting whitespace to hyphens. - -;; All operations work on the current line, active region, or entire buffer depending on context. - -;; Bound to keymap prefix C-; w - +;; Whitespace cleanup under C-; w: trim line edges, collapse runs of spaces, +;; delete blank lines, enforce a single blank line, and hyphenate whitespace. +;; Commands choose region, buffer, or current line based on prefix/mark state. +;; ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index b4e4545d0..53f19b72b 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -17,10 +17,63 @@ ;;; Code: +(require 'system-lib) ;; cj/exclude-from-global-font-lock (eval-when-compile (require 'undead-buffers)) (declare-function cj/make-buffer-undead "undead-buffers" (string)) (autoload 'cj/make-buffer-undead "undead-buffers" nil t) -(declare-function ghostel "ghostel" (&optional arg)) +(declare-function cj/term-toggle "eat-config") + +;; ------------------------------ Declarations ------------------------------- +;; These functions and variables belong to lazily-loaded packages or to other +;; cj modules; declaring them keeps the byte-compiler quiet without forcing an +;; eager require. Behavior is unchanged -- the symbols still resolve at runtime +;; once their owning package/module loads. + +;; dashboard package internals used by the bookmark-insertion override. +(declare-function dashboard-insert-section "dashboard") +(declare-function dashboard-subseq "dashboard") +(declare-function dashboard-get-shortcut "dashboard") +(declare-function dashboard-shorten-path "dashboard") +(declare-function dashboard--align-length-by-type "dashboard") +(declare-function dashboard--generate-align-format "dashboard") +(declare-function dashboard-refresh-buffer "dashboard") +(declare-function dashboard-open "dashboard") +(defvar dashboard-bookmarks-show-path) +(defvar dashboard--bookmarks-cache-item-format) + +;; bookmark.el (required at runtime inside `dashboard-insert-bookmarks'). +(declare-function bookmark-all-names "bookmark") +(declare-function bookmark-get-filename "bookmark") + +;; recentf.el (required at runtime inside the exclude helper). +(defvar recentf-exclude) + +;; nerd-icons glyph functions used in the launcher table. +(declare-function nerd-icons-faicon "nerd-icons") +(declare-function nerd-icons-devicon "nerd-icons") +(declare-function nerd-icons-mdicon "nerd-icons") +(declare-function nerd-icons-codicon "nerd-icons") +(declare-function nerd-icons-octicon "nerd-icons") +(declare-function nerd-icons-wicon "nerd-icons") + +;; user-constants.el provides the home-directory constant. +(defvar user-home-dir) + +;; Launcher actions defined in other cj modules. +(declare-function cj/main-agenda-display "org-agenda-config") +(declare-function cj/elfeed-open "elfeed-config") +(declare-function cj/drill-start "org-drill-config") +(declare-function cj/music-playlist-toggle "music-config") +(declare-function cj/music-playlist-load "music-config") +(declare-function cj/erc-switch-to-buffer-with-completion "erc-config") +(declare-function cj/telega "telega-config") +(declare-function cj/slack-start "slack-config") +(declare-function cj/signel-message "signal-config") +(declare-function cj/kill-all-other-buffers-and-windows "undead-buffers") + +;; External package commands invoked by launchers. +(declare-function mu4e "mu4e") +(declare-function pearl-list-issues "pearl") ;; ------------------------ Dashboard Bookmarks Override ----------------------- ;; overrides the bookmark insertion from the dashboard package to provide an @@ -32,6 +85,14 @@ (defvar dashboard-bookmarks-item-format "%s" "Format to use when showing the base of the file name.") +;; `el' is bound dynamically by dashboard's section-insertion machinery, which the +;; override below plugs into. Declare it so the byte-compiler reads the +;; references as that special variable rather than a free variable. The name is +;; dashboard's, not ours, so the missing-prefix lint is suppressed rather than +;; renamed (renaming would break the dynamic binding dashboard supplies). +(with-suppressed-warnings ((lexical el)) + (defvar el)) + (defun dashboard-insert-bookmarks (list-size) "Add the list of LIST-SIZE items of bookmarks." (require 'bookmark) @@ -77,23 +138,26 @@ Adjust this if the title doesn't appear centered under the banner image.") (list (list "c" #'nerd-icons-faicon "nf-fa-code" "Code" "Switch Project" (lambda () (projectile-switch-project))) (list "d" #'nerd-icons-faicon "nf-fa-folder_o" "Files" "Dirvish File Manager" (lambda () (dirvish user-home-dir))) - (list "t" #'nerd-icons-devicon "nf-dev-terminal" "Terminal" "Launch Terminal" (lambda () (ghostel))) + (list "t" #'nerd-icons-devicon "nf-dev-terminal" "Terminal" "Launch Terminal" (lambda () (cj/term-toggle))) (list "a" #'nerd-icons-mdicon "nf-md-calendar" "Agenda" "Main Org Agenda" (lambda () (cj/main-agenda-display))) + (list "w" #'nerd-icons-wicon "nf-weather-day_sunny_overcast" "Weather" "Wttrin Weather Forecast" (lambda () (call-interactively #'wttrin))) (list "r" #'nerd-icons-faicon "nf-fa-rss_square" "Feeds" "Elfeed Feed Reader" (lambda () (cj/elfeed-open))) - (list "b" #'nerd-icons-faicon "nf-fae-book_open_o" "Books" "Calibre Ebook Reader" (lambda () (calibredb))) + (list "b" #'nerd-icons-codicon "nf-cod-library" "Books" "Calibre Ebook Reader" (lambda () (calibredb))) (list "f" #'nerd-icons-mdicon "nf-md-school" "Flashcards" "Org-Drill" (lambda () (cj/drill-start))) (list "m" #'nerd-icons-mdicon "nf-md-music" "Music" "EMMS Music Player" (lambda () (cj/music-playlist-toggle) (cj/music-playlist-load))) (list "e" #'nerd-icons-faicon "nf-fa-envelope" "Email" "Mu4e Email Client" (lambda () (mu4e))) (list "i" #'nerd-icons-faicon "nf-fa-comments" "IRC" "Emacs Relay Chat" (lambda () (cj/erc-switch-to-buffer-with-completion))) - (list "g" #'nerd-icons-faicon "nf-fa-telegram" "Telegram" "Telega Telegram Client" (lambda () (cj/telega))) + (list "G" #'nerd-icons-faicon "nf-fa-telegram" "Telegram" "Telega Telegram Client" (lambda () (cj/telega))) (list "s" #'nerd-icons-faicon "nf-fa-slack" "Slack" "Slack Client" (lambda () (cj/slack-start))) - (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues)))) + (list "l" #'nerd-icons-octicon "nf-oct-issue_tracks" "Linear" "Linear Issue Tracker" (lambda () (pearl-list-issues))) + (list "S" #'nerd-icons-mdicon "nf-md-message" "Signal" "Signal Messenger" (lambda () (cj/signel-message)))) "Dashboard launcher table: (KEY ICON-FN ICON-NAME LABEL TOOLTIP ACTION). Drives both `dashboard-navigator-buttons' and the dashboard-mode-map keys.") -(defconst cj/dashboard--row-sizes '(4 4 3 2) +(defconst cj/dashboard--row-sizes '(5 4 3 3) "Navigator row lengths. Must sum to the number of `cj/dashboard--launchers'. -The last row groups Slack and Linear together.") +The top row carries Weather alongside the core tools; the last row groups +Slack, Linear, and Signal together.") (defun cj/dashboard--navigator-button (l) "Build a `dashboard-navigator-buttons' entry from launcher L." @@ -134,17 +198,36 @@ doesn't leak into this display when the buffer is taller than the window." (interactive) (if (get-buffer "*dashboard*") - (progn - (switch-to-buffer "*dashboard*") - (cj/kill-all-other-buffers-and-windows)) - (when (fboundp 'dashboard-open) - (dashboard-open))) + (progn + (switch-to-buffer "*dashboard*") + (cj/kill-all-other-buffers-and-windows)) + (when (fboundp 'dashboard-open) + (dashboard-open))) + ;; Refresh so re-showing the dashboard always lands on fresh content. + (when (fboundp 'dashboard-refresh-buffer) + (dashboard-refresh-buffer)) (goto-char (point-min)) (set-window-start (selected-window) (point-min))) ;; --------------------------------- Dashboard --------------------------------- ;; a useful startup screen for Emacs +(defun cj/--dashboard-exclude-emms-from-recentf () + "Exclude the EMMS history file from recentf. +Adds to `recentf-exclude' so entries set elsewhere (e.g. in +system-defaults) are preserved rather than overwritten." + (require 'recentf) + (add-to-list 'recentf-exclude "/emms/history")) + +;; Keep global font-lock out of the dashboard buffer. Dashboard colors its +;; banner title (`dashboard-banner-logo-title') and section headings +;; (`dashboard-heading') with the `face' text property; `global-font-lock-mode' +;; owns `face' and strips manually-applied ones it didn't set, so with font-lock +;; running the banner and headings fall back to the default face. Excluding +;; dashboard-mode lets those text-property faces survive. (Item and navigator +;; colors ride a `dashboard-items-face' overlay, which font-lock leaves alone.) +(cj/exclude-from-global-font-lock 'dashboard-mode) + (use-package dashboard :demand t :hook (emacs-startup . cj/dashboard-only) @@ -192,15 +275,18 @@ window." (setq initial-buffer-choice (lambda () (get-buffer "*dashboard*")))) ;; don't display dashboard if opening a file (setq dashboard-display-icons-p t) ;; display icons on both GUI and terminal (setq dashboard-icon-type 'nerd-icons) ;; use `nerd-icons' package + (setq dashboard-set-file-icons nil) ;; no per-item icons on the list entries: URL bookmarks have no filename, so they'd render iconless next to file items -- dropping them all keeps the lists uniform + (setq dashboard-set-heading-icons t) ;; nerd-icons on the section titles (Projects/Bookmarks/Recent) (setq dashboard-center-content t) ;; horizontally center dashboard content (setq dashboard-bookmarks-show-path nil) ;; don't show paths in bookmarks (setq dashboard-recentf-show-base t) ;; show filename, not full path (setq dashboard-recentf-item-format "%s") - (setq recentf-exclude '("/emms/history")) ;; exclude EMMS history from recent files - (setq dashboard-set-footer nil) ;; don't show footer and quotes + (cj/--dashboard-exclude-emms-from-recentf) ;; exclude EMMS history from recent files ;; == navigation - (setq dashboard-set-navigator t) + ;; footer and navigator visibility are controlled by `dashboard-startupify-list' + ;; above (footer omitted, navigator included); the dashboard-set-* toggles are + ;; obsolete as of dashboard 1.9.0. (setq dashboard-navigator-buttons (cj/dashboard--navigator-rows)) ;; == content @@ -215,6 +301,10 @@ window." ;; Disable 'q' to quit dashboard (define-key dashboard-mode-map (kbd "q") nil) + ;; 'g' refreshes the dashboard (the dired/magit convention). Telegram moved to + ;; 'G' in the launcher table to free it. + (define-key dashboard-mode-map (kbd "g") #'dashboard-refresh-buffer) + ;; Launcher keys, derived from `cj/dashboard--launchers' (same source as the ;; navigator icons, so key order can't drift from the icon-row order). (cj/dashboard--bind-launchers dashboard-mode-map)) diff --git a/modules/dev-fkeys.el b/modules/dev-fkeys.el index 9fdfa5b3f..80b43600b 100644 --- a/modules/dev-fkeys.el +++ b/modules/dev-fkeys.el @@ -5,48 +5,17 @@ ;; Layer: 2 (Core UX). ;; Category: C. ;; Load shape: eager. -;; Eager reason: the F4/F6 developer command entry points. -;; Top-level side effects: six global F-key bindings; conditionally registers a -;; C-; P binding. +;; Eager reason: binds the F4/F6 developer command entry points. +;; Top-level side effects: global F-key bindings and optional C-; P binding. ;; Runtime requires: cl-lib, system-lib, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; Project-aware F-key block for developer workflows: +;; Project-aware F-key dispatchers. F4 chooses compile/run/clean commands by +;; project markers; C-F4 and M-F4 are fast paths. F6 runs all project tests or +;; the current file's tests using language-specific command builders. ;; -;; F4 completing-read of compile/run candidates filtered by project type -;; C-F4 fast path: compile only (no-op on interpreted projects) -;; M-F4 fast path: clean + rebuild (no-op on interpreted projects) -;; S-F4 recompile (built-in) -;; F6 completing-read of test candidates: All tests / Current file's tests -;; C-F6 fast path: current file's tests -;; -;; F4 project-type detection runs against the projectile root and falls back -;; to \\='unknown when no marker matches. Interpreted markers are checked -;; before compiled markers, so a Python or Node project that also has a -;; Makefile for tasks classifies as interpreted. -;; -;; F6 \"All tests\" delegates to `projectile-test-project'. F6 \"Current -;; file's tests\" detects the language by extension, derives the runner -;; command (elisp via the project Makefile, Python via pytest, Go via the -;; package), and pipes through `compile' from the projectile root. -;; TypeScript / JavaScript are detected but punted for v1 — the function -;; signals a user-error rather than guessing a runner. -;; -;; M-F6 is reserved for Phase 2b (\"Run a test...\" menu entry with -;; per-language test-name discovery). Phase 2b also adds buffer-local -;; last-test memory and tree-sitter-based discovery for Python / Go / -;; TypeScript. The tree-sitter discovery uses a capture-then-filter pattern -;; (queries without `:match' / `:equal' / `:pred' predicates, with the -;; pattern filter applied in Elisp) to sidestep Emacs bug #79687 — Emacs -;; 30.2 emits unsuffixed `#match' predicates that libtree-sitter 0.26 -;; rejects. The fix lives on Emacs master (commit b0143530) and is -;; targeted at Emacs 31; it has not been backported to the emacs-30 -;; branch as of 2026-05-03. See Mike Olson's writeup at -;; https://mwolson.org/blog/emacs/2026-04-20-fixing-typescript-ts-mode-in-emacs-30-2/ -;; for the same workaround applied to font-lock. -;; -;; F7 (coverage) is wired in coverage-core.el. F5 is reserved for the debug -;; ticket and intentionally left unbound here. +;; Interpreted markers win over compiled markers so task Makefiles do not turn +;; Python/Node projects into compile-first projects. ;;; Code: diff --git a/modules/diff-config.el b/modules/diff-config.el index 75869a73f..0c09b9516 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -28,6 +28,12 @@ ;;; Code: +(declare-function ediff-setup-keymap "ediff") +(declare-function ediff-next-difference "ediff") +(declare-function ediff-previous-difference "ediff") +(declare-function cj/ediff-hook "diff-config") +(declare-function winner-undo "winner") + (use-package ediff :ensure nil ;; built-in :defer t diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index d92869669..b82cdd0d7 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -17,8 +17,8 @@ ;; ediff, playlist creation, path copying, and external file manager integration. ;; ;; Key Bindings: -;; - d: Delete marked files (dired-do-delete) -;; - D: Duplicate file at point (adds "-copy" before extension) +;; - d: Diff/ediff selected files (cj/dired-ediff-files) +;; - D: Delete (dired-do-delete; mark with m for batches) ;; - g: Quick access menu (jump to predefined directories) ;; - G: Search with deadgrep in current directory ;; - f: Open system file manager in current directory @@ -27,7 +27,7 @@ ;; - p: Copy absolute file path ;; - P: Print the file at point via CUPS ;; - S: Study — start an org-drill session on the .org file at point -;; - M-S-d (Meta-Shift-d): DWIM shell commands menu +;; - M-D (Meta-Shift-d): DWIM shell commands menu ;; - TAB: Toggle subtree expansion ;; - F11: Toggle sidebar view @@ -41,6 +41,24 @@ (declare-function cj/drill-this-file "org-drill-config") +;; Dirvish/Dired functions called from lazy-loaded packages. +(declare-function dirvish-peek-mode "dirvish") +(declare-function dirvish-side-follow-mode "dirvish") +(declare-function dirvish-quit "dirvish") +(declare-function dired-get-marked-files "dired") +(declare-function dired-dwim-target-directory "dired-aux") +(declare-function dired-get-file-for-visit "dired") +(declare-function dired-get-filename "dired") +(declare-function dired-mark "dired") +(declare-function dired-current-directory "dired") +(declare-function dired-file-name-at-point "dired-x") +(declare-function dired-find-file "dired") +(declare-function project-roots "project") + +;; External package variables referenced before their package loads. +(defvar ediff-after-quit-hook-internal) +(defvar dirvish-side-attributes) + ;; mark files in dirvish, attach in mu4e (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) @@ -119,6 +137,35 @@ through a `../' or absolute path. Pure helper." (and (not (string-empty-p name)) (not (string-match-p "/" name)))) +(defun cj/--playlist-resolve-target () + "Prompt for a playlist name and return the .m3u path to write under `music-dir'. +Re-prompt until the name is a safe bare filename (no `/'). When the target +already exists, ask whether to overwrite, cancel, or rename: overwrite returns +the path, cancel signals a `user-error', rename re-prompts. Interactive +prompting only -- the caller does the file write." + (let ((base-name nil) + (playlist-path nil) + (done nil)) + (while (not done) + (setq base-name (cj/--playlist-sanitize-name + (read-string "Playlist name (without .m3u): "))) + (cond + ((not (cj/--playlist-name-safe-p base-name)) + (message "Playlist name must be a bare filename, without '/'.")) + (t + (setq playlist-path (expand-file-name (concat base-name ".m3u") music-dir)) + (if (not (file-exists-p playlist-path)) + (setq done t) + (let ((choice (read-char-choice + (format "Playlist '%s' exists. [o]verwrite, [c]ancel, [r]ename? " + (file-name-nondirectory playlist-path)) + '(?o ?c ?r)))) + (cl-case choice + (?o (setq done t)) + (?c (user-error "Cancelled playlist creation")) + (?r (setq done nil)))))))) + playlist-path)) + (defun cj/dired-create-playlist-from-marked () "Create an .m3u playlist file from marked files in Dired (or Dirvish). Filters for audio files, prompts for the playlist name, and saves the resulting @@ -131,27 +178,7 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (if (zerop count) (user-error "No audio files marked (extensions: %s)" (string-join cj/audio-file-extensions ", ")) - (let ((base-name nil) - (playlist-path nil) - (done nil)) - (while (not done) - (setq base-name (cj/--playlist-sanitize-name - (read-string "Playlist name (without .m3u): "))) - (cond - ((not (cj/--playlist-name-safe-p base-name)) - (message "Playlist name must be a bare filename, without '/'.")) - (t - (setq playlist-path (expand-file-name (concat base-name ".m3u") music-dir)) - (if (not (file-exists-p playlist-path)) - (setq done t) - (let ((choice (read-char-choice - (format "Playlist '%s' exists. [o]verwrite, [c]ancel, [r]ename? " - (file-name-nondirectory playlist-path)) - '(?o ?c ?r)))) - (cl-case choice - (?o (setq done t)) - (?c (user-error "Cancelled playlist creation")) - (?r (setq done nil)))))))) + (let ((playlist-path (cj/--playlist-resolve-target))) (with-temp-file playlist-path (dolist (af audio-files) (insert af "\n"))) @@ -167,7 +194,9 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (:map dired-mode-map ([remap dired-summary] . which-key-show-major-mode) ("E" . wdired-change-to-wdired-mode) ;; edit names and properties in buffer - ("e" . cj/dired-ediff-files)) ;; ediff files + ("e" . cj/dired-ediff-files) ;; ediff files + ("d" . cj/dired-ediff-files) ;; d = diff, matching C-; b / ibuffer (was dired-flag-file-deletion) + ("D" . dired-do-delete)) ;; D = delete (d no longer flags; mark with m, then D) :custom (dired-use-ls-dired nil) ;; non GNU FreeBSD doesn't support a "--dired" switch :config @@ -178,6 +207,13 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (setq dired-recursive-copies (quote always)) ;; "always" means no asking (setq dired-recursive-deletes (quote top))) ;; "top" means ask once +;; which-key labels for the d=diff / D=delete pair (shown in the major-mode +;; popup via `which-key-show-major-mode'). +(with-eval-after-load 'which-key + (which-key-add-major-mode-key-based-replacements 'dired-mode + "d" "diff (ediff files)" + "D" "delete file")) + ;; note: disabled as it prevents marking and moving files to another directory ;; (setq dired-kill-when-opening-new-dired-buffer t) ;; don't litter by leaving buffers when navigating directories @@ -204,28 +240,20 @@ used by `cj/dirvish-open-html-in-eww'." ;;; ------------------------ Dired Mark All Visible Files ----------------------- -(defun cj/--dired-line-is-directory-p (line) - "Return non-nil when LINE is a Dired listing of a directory. - -Dired prefixes each file line with a one-character mark column followed -by `ls -l' output, so a directory line reads as `<mark> drwx...' (mark, -space, `d'). Header lines (` /path/to:'), `total N' lines, and empty -lines all fail this match. - -Pure helper used by `cj/dired-mark-all-visible-files'." - (and line (string-match-p "\\`. d" line))) - (defun cj/dired-mark-all-visible-files () "Mark all visible files in Dired mode." (interactive) (save-excursion (goto-char (point-min)) (while (not (eobp)) - (let ((line (buffer-substring-no-properties - (line-beginning-position) (line-end-position)))) - (unless (cj/--dired-line-is-directory-p line) - (dired-mark 1))) - (forward-line 1)))) + ;; dired-mark advances point itself, so only advance manually on the + ;; lines it isn't called for (directories, headers, totals). Use + ;; dired-get-filename to identify real file lines; it returns nil on + ;; non-file lines (no error with the second arg). + (let ((fn (dired-get-filename nil t))) + (if (and fn (not (file-directory-p fn))) + (dired-mark 1) + (forward-line 1)))))) ;;; ------------------------ Dirvish Duplicate File Copy ------------------------ @@ -267,6 +295,37 @@ Examples: (message "Duplicated: %s → %s" (file-name-nondirectory file) new-name)))) +;;; ----------------------------- Dirvish Hard Delete --------------------------- + +(defun cj/--dirvish-hard-delete-command (files) + "Return the `sudo rm -rf' shell command that force-deletes FILES. +Each path is shell-quoted and the list is preceded by `--' so a +leading-dash filename can't be misread as an option. Pure helper used by +`cj/dirvish-hard-delete'." + (concat "sudo rm -rf -- " + (mapconcat #'shell-quote-argument files " "))) + +(defun cj/dirvish-hard-delete () + "Force-delete the marked files (or the file at point) via `sudo rm -rf'. +This bypasses the trash and is IRREVERSIBLE. Prompts with the exact +targets named before running." + (interactive) + (let ((files (dired-get-marked-files))) + (unless files + (user-error "No file at point")) + (let ((targets (mapconcat #'file-name-nondirectory files ", "))) + (when (yes-or-no-p + (format "Force-delete (sudo rm -rf, NO undo): %s? " targets)) + (let ((status (shell-command (cj/--dirvish-hard-delete-command files)))) + ;; Revert either way so the listing reflects whatever was removed, + ;; but only claim success when `rm' actually exited 0 -- a failed or + ;; cancelled `sudo' must not report files gone that are still there. + (revert-buffer) + (if (zerop status) + (message "Force-deleted: %s" targets) + (message "Hard delete failed (exit %d) -- see *Shell Command Output*" + status))))))) + ;;; ------------------------------ Dirvish Print File --------------------------- (defvar cj/dirvish-print-extensions @@ -317,7 +376,8 @@ Shadows dired's `P' (`dired-do-print') with this type-aware version." (defun cj/dirvish-drill-file () "Open the Org file at point and start an `org-drill' session on it. -Bound to `S' (\"study\") in `dirvish-mode-map'; refuses anything but a `.org' file." +Bound to `S' (\"study\") in `dirvish-mode-map'; refuses anything but +a `.org' file." (interactive) (let ((file (dired-get-filename nil t))) (unless (and file (not (file-directory-p file)) (string-suffix-p ".org" file t)) @@ -349,18 +409,19 @@ regardless of what file or subdirectory the point is on." "Return the (PROGRAM PRE-FILE-ARG...) list for setting wallpaper under ENV. ENV is a display-server symbol: `x11' picks feh with --bg-fill, `wayland' -picks swww with the img subcommand. Any other value returns nil so the -caller can surface an \"unknown display server\" error. +picks the `set-wallpaper' script (on PATH from dotfiles; it wraps the awww +backend and persists the choice to waypaper's config). Any other value +returns nil so the caller can surface an \"unknown display server\" error. Pure helper used by `cj/set-wallpaper'." (pcase env ('x11 '("feh" "--bg-fill")) - ('wayland '("swww" "img")) + ('wayland '("set-wallpaper")) (_ nil))) (defun cj/set-wallpaper () "Set the image at point as the desktop wallpaper. -Uses feh on X11, swww on Wayland." +Uses feh on X11, the `set-wallpaper' script on Wayland." (interactive) (let* ((raw (dired-file-name-at-point)) (file (and raw (expand-file-name raw))) @@ -379,6 +440,117 @@ Uses feh on X11, swww on Wayland." (message "Wallpaper set: %s (%s)" (file-name-nondirectory file) (car cmd)))))) +;;; ------------------------- Dirvish Hyprland Popup ---------------------------- + +;; The Hyprland Super+F popup opens an emacsclient frame named "dirvish" (window +;; rules float/size/center it by that name) and runs `cj/dirvish-popup', rooted +;; at home. `q' in that frame runs `cj/dirvish-popup-quit', which quits Dirvish +;; and deletes the popup frame so a stray launch never orphans it; `q' in any +;; other frame quits Dirvish normally. The launcher script calls this command +;; instead of plain `dirvish'. This mirrors the Super+Shift+N quick-capture +;; popup (see `cj/quick-capture' in org-capture-config.el). + +(defun cj/--dirvish-popup-frame () + "Return a live frame named \"dirvish\" (the Hyprland popup), or nil." + (seq-find (lambda (f) + (and (frame-live-p f) + (equal (frame-parameter f 'name) "dirvish"))) + (frame-list))) + +(defun cj/dirvish-popup () + "Open Dirvish in the Hyprland popup frame (frame \"dirvish\"), rooted at home. +The launcher script calls this through =emacsclient -c -e=. `q' +(`cj/dirvish-popup-quit') closes the frame. + +Selects the \"dirvish\" frame by name before opening rather than trusting the +ambient selected frame: the launching =emacsclient -c -e= runs before Hyprland +settles focus on the new float, so =(selected-frame)= is still the daemon's main +frame and Dirvish would otherwise open there." + (interactive) + (let ((frame (cj/--dirvish-popup-frame))) + (when frame (select-frame-set-input-focus frame)) + (dirvish (expand-file-name "~/")))) + +(defun cj/dirvish-popup-focus-existing () + "Raise and focus the live dirvish popup frame, returning t; nil if none. +The launcher script calls this before creating a frame, so a second Super+F +re-uses the open popup instead of spawning a second one (the popup is a +single-instance, transient launcher -- use =C-x d= for several independent +Dirvish sessions)." + (let ((popup (cj/--dirvish-popup-frame))) + (when popup + (select-frame-set-input-focus popup) + t))) + +(defun cj/dirvish-popup-quit () + "Quit Dirvish. In the Hyprland popup frame (\"dirvish\"), delete the frame too. +Bound to `q' in `dirvish-mode-map'. A normal Dirvish session (any other frame) +quits as usual; only the popup frame is torn down, so the Super+F launch never +leaves an empty frame behind." + (interactive) + (let ((popup (cj/--dirvish-popup-frame))) + (if (and popup (eq popup (selected-frame))) + (progn + (ignore-errors (dirvish-quit)) + (when (frame-live-p popup) (delete-frame popup))) + (dirvish-quit)))) + +(defun cj/--dirvish-popup-reap-on-delete (frame) + "Quit the Dirvish session when the Super+F popup FRAME is closed any way. +`q' runs `cj/dirvish-popup-quit', but closing the Hyprland float directly (or +letting it lose focus) bypasses that and orphans the session's dired buffers -- +the \"leaves a load of buffers around\" symptom. As a `delete-frame-functions' +hook this fires on every close path; `dirvish-quit' reaps the session's buffers +(verified: a navigated session drops back to baseline on quit). Scoped to the +popup frame so ordinary `C-x d' sessions -- where multiple dired buffers are +wanted for mark-and-move -- are untouched." + (when (and (frame-live-p frame) + (equal (frame-parameter frame 'name) "dirvish")) + (with-selected-frame frame + (ignore-errors (dirvish-quit))))) + +(add-hook 'delete-frame-functions #'cj/--dirvish-popup-reap-on-delete) + +(defun cj/--dirvish-popup-selected-p () + "Return non-nil when the selected frame is the dirvish popup frame." + (let ((popup (cj/--dirvish-popup-frame))) + (and popup (eq popup (selected-frame))))) + +(defun cj/dirvish-popup-find-file () + "Open the file at point. +In the Hyprland popup frame the popup is a context-free launcher: files open +through the OS handler (`cj/xdg-open' -> xdg-open), so nothing lands inside the +throwaway frame and the launch is independent of the running Emacs session (a +text/code file opens its own new emacsclient frame, not your working session -- +use =C-x d= when you want a file in the session you're in). Directories are +entered normally so you can keep browsing. The popup then dismisses itself on +focus loss. Outside the popup this is exactly `dired-find-file'." + (interactive) + (if (cj/--dirvish-popup-selected-p) + (let ((file (dired-get-file-for-visit))) + (if (file-directory-p file) + (dired-find-file) + (cj/xdg-open file))) + (dired-find-file))) + +(defun cj/--dirvish-popup-focus-watch (&rest _) + "Dismiss the dirvish popup frame once it loses focus. +Armed only after the popup has actually held focus (a per-frame flag), so the +frame is never torn down during its own creation, before Hyprland settles focus +on the new float. Installed on `after-focus-change-function'; a no-op whenever +no popup frame is live." + (let ((popup (cj/--dirvish-popup-frame))) + (when popup + (if (frame-focus-state popup) + (set-frame-parameter popup 'cj-dirvish-popup-had-focus t) + (when (frame-parameter popup 'cj-dirvish-popup-had-focus) + (delete-frame popup)))))) + +;; Install idempotently: remove any prior copy before adding, so re-loading the +;; module updates the watch rather than stacking duplicate copies. +(remove-function after-focus-change-function #'cj/--dirvish-popup-focus-watch) +(add-function :after after-focus-change-function #'cj/--dirvish-popup-focus-watch) + ;;; ---------------------------------- Dirvish ---------------------------------- (use-package dirvish @@ -403,16 +575,16 @@ Uses feh on X11, swww on Wayland." ("lx" "~/archive/lectures/" "lectures") ("mb" "/media/backup/" "backup directory") ("mx" "~/music/" "music") - ("pdx" "~/projects/documents/" "project documents") - ("pdl" "~/projects/danneel/" "project danneel") - ("pcl" "~/projects/clipper/" "project clipper") + ("pdx" "~/projects/home/documents/" "documents area") + ("pdl" "~/projects/home/danneel/" "project danneel") + ("pcl" "~/projects/home/clipper/" "clipper area") ("pwk" "~/projects/work/" "project work") - ("pl" "~/projects/elibrary/" "project elibrary") - ("pf" "~/projects/finances/" "project finances") - ("pjr" "~/projects/jr-estate/" "project jr-estate") - ("phx" "~/projects/health/" "project health") - ("phl" "~/projects/homelab/" "project homelab") - ("pk" "~/projects/kit/" "project kit") + ("pl" "~/projects/home/elibrary/" "elibrary area") + ("pf" "~/projects/home/finances/" "project finances") + ("pjr" "~/projects/home/jr-estate/" "project jr-estate") + ("phx" "~/projects/home/health/" "health area") + ("phl" "~/projects/home/" "project home") + ("pk" "~/projects/home/kit/" "kit area") ("pn" "~/projects/nextjob/" "project nextjob") ("ps" ,(concat pix-dir "/screenshots/") "pictures screenshots") ("px" ,pix-dir "pictures directory") @@ -483,7 +655,8 @@ Uses feh on X11, swww on Wayland." ("bg" . cj/set-wallpaper) ("/" . dirvish-narrow) ("<left>" . dired-up-directory) - ("<right>" . dired-find-file) + ("RET" . cj/dirvish-popup-find-file) ; popup: launch file externally; else normal + ("<right>" . cj/dirvish-popup-find-file) ("C-," . dirvish-history-go-backward) ("C-." . dirvish-history-go-forward) ("F" . dirvish-file-info-menu) @@ -497,14 +670,15 @@ Uses feh on X11, swww on Wayland." ("M-p" . dirvish-peek-toggle) ("M-s" . dirvish-setup-menu) ("TAB" . dirvish-subtree-toggle) - ("d" . dired-do-delete) - ("D" . cj/dirvish-duplicate-file) + ("d" . cj/dirvish-duplicate-file) + ("D" . cj/dirvish-hard-delete) ("f" . cj/dirvish-open-file-manager-here) ("g" . dirvish-quick-access) ("o" . cj/xdg-open) ("O" . cj/open-file-with-command) ; Prompts for command to run ("p" . (lambda () (interactive) (cj/dired-copy-path-as-kill nil t))) ("P" . cj/dirvish-print-file) + ("q" . cj/dirvish-popup-quit) ; quit; in the Hyprland popup frame, close it ("r" . dirvish-rsync) ("S" . cj/dirvish-drill-file) ; Study: org-drill the .org file at point ("s" . dirvish-quicksort) @@ -513,15 +687,9 @@ Uses feh on X11, swww on Wayland." ;;; ----------------------------- Dired Text Greying ---------------------------- -;; The right-column file-size attribute uses `shadow' (#969385). Match the -;; visible text faces to it so the column reads as one tone, with icon color -;; supplying the only accent. `default' is remapped buffer-locally inside -;; dired/dirvish so plain files match too — no global side effects. - -(with-eval-after-load 'dired - (set-face-attribute 'dired-directory nil :foreground 'unspecified :inherit 'shadow) - (set-face-attribute 'dired-symlink nil :foreground 'unspecified :inherit 'shadow) - (set-face-attribute 'dired-header nil :foreground 'unspecified :inherit 'shadow)) +;; `default' is remapped buffer-locally to `shadow' inside dired/dirvish (see +;; `cj/--dired-text-greyout' below) so plain files read grey, with icon color +;; the only accent. The dired text faces themselves are left to the theme. (defun cj/--dired-text-greyout () "Buffer-local: render `default' in `shadow' so plain files read grey." diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index 57eea7063..e8790a489 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -1,103 +1,38 @@ -;; dwim-shell-config.el --- Dired Shell Commands -*- coding: utf-8; lexical-binding: t; -*- +;;; dwim-shell-config.el --- Dired shell command menu -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; ;; Layer: 3 (Domain Workflow). ;; Category: D/P. ;; Load shape: eager. -;; Eager reason: none; Dired/Dirvish shell commands, a command-loaded deferral -;; candidate. +;; Eager reason: none; Dired/Dirvish shell commands can load by command. ;; Top-level side effects: package configuration via use-package. -;; Runtime requires: cl-lib. +;; Runtime requires: cl-lib, system-lib. ;; Direct test load: yes. ;; -;; This module provides a collection of DWIM (Do What I Mean) shell commands -;; for common file operations in Dired and other buffers. It leverages the -;; `dwim-shell-command' package to execute shell commands on marked files -;; with smart templating and progress tracking. -;; -;; Features: -;; - Audio/Video conversion (mp3, opus, webp, HEVC) -;; - Image manipulation (resize, flip, format conversion) -;; - PDF operations (merge, split, password protection, OCR) -;; - Archive management (zip/unzip) -;; - Document conversion (epub to org, docx to pdf, pdf to txt) -;; - Git operations (clone from clipboard) -;; - External file opening with context awareness -;; -;; Workflow: -;; 1. *Mark files in Dired/Dirvish* -;; - Use =m= to mark individual files -;; - Use =* .= to mark by extension -;; - Use =% m= to mark by regexp -;; - Or operate on the file under cursor if nothing is marked -;; -;; 2. *Execute a DWIM command* -;; - Call the command via =M-x dwim-shell-commands-[command-name]= -;; - Or bind frequently used commands to keys -;; -;; 3. *Command execution* -;; - The command runs asynchronously in the background -;; - A =*Async Shell Command*= buffer shows progress -;; - Files are processed with smart templating (replacing =<<f>>=, =<<fne>>=, etc.) -;; -;; 4. *Results* -;; - New files appear in the Dired/Dirvish buffer -;; - Buffer auto-refreshes when command completes -;; - Errors appear in the async buffer if something fails -;; -;; Requirements: -;; The commands rely on various external utilities that need to be installed: -;; - ffmpeg: Audio/video conversion -;; - imagemagick (convert): Image manipulation -;; - qpdf: PDF operations (requires version 8.x+ for secure password handling) -;; - tesseract: OCR functionality -;; - pandoc: Document conversion -;; - atool: Archive extraction -;; - rsvg-convert: SVG to PNG conversion -;; - pdftotext: PDF text extraction -;; - git: Version control operations -;; - gpgconf: GPG agent management -;; - 7z (p7zip): Secure password-protected archives -;; -;; On Arch Linux, install the requirements with: -;; #+begin_src bash -;; sudo pacman -S --needed ffmpeg imagemagick qpdf tesseract tesseract-data-eng pandoc atool librsvg poppler git gnupg p7zip zip unzip mkvtoolnix-cli mpv ruby -;; #+end_src -;; -;; On MacOS, install the requirements with: -;; #+begin_src bash -;; brew install ffmpeg imagemagick qpdf tesseract pandoc atool librsvg poppler gnupg p7zip mkvtoolnix mpv -;; #+end_src -;; -;; Usage: -;; Commands operate on marked files in Dired or the current file in other modes. -;; The package automatically replaces standard shell commands with DWIM versions -;; for a more intuitive experience. -;; -;; Security: -;; Password-protected operations (PDF encryption, archive encryption) use secure -;; methods to avoid exposing passwords in process lists or command history: -;; - PDF operations: Use temporary files with restrictive permissions (mode 600) -;; - Archive operations: Use 7z instead of zip for better password handling -;; - Temporary password files are automatically cleaned up after use -;; - Note: Switched from zip to 7z for encryption due to zip's insecure -P flag -;; -;; Template Variables: -;; - <<f>>: Full path to file -;; - <<fne>>: File name without extension -;; - <<e>>: File extension -;; - <<b>>: Base name (file name with extension, no directory) -;; - <<d>>: Directory path -;; - <<n>>: Sequential number (for batch renaming) -;; - <<td>>: Temporary directory -;; - <<cb>>: Clipboard contents -;; - <<*>>: All marked files +;; Configures dwim-shell-command actions for marked Dired/Dirvish files: +;; media conversion, archive/PDF/document operations, external opening, and a +;; curated transient menu. Commands use dwim-shell templates for marked files or +;; the current buffer file. ;; +;; Password-bearing operations avoid command-line secrets by writing temporary +;; password files with restrictive permissions and deleting them from the process +;; sentinel after the spawned command exits. ;;; Code: (require 'cl-lib) +(require 'system-lib) ;; cj/confirm-strong (permanent file destruction confirm) + +;; Function declarations (lazily-loaded packages and sibling modules). +(declare-function dwim-shell-command-on-marked-files "dwim-shell-command") +(declare-function dwim-shell-command-read-file-name "dwim-shell-command") +(declare-function dwim-shell-command--files "dwim-shell-command") +(declare-function cj/xdg-open "external-open") +(declare-function dwim-shell-commands-menu "dwim-shell-config") + +;; Forward declaration: external variable provided by the dirvish package. +(defvar dirvish-mode-map) ;; --------------------------- Password-file helpers --------------------------- @@ -197,6 +132,53 @@ file list." (replace-regexp-in-string "'" "'\\\\''" (expand-file-name f)))) files "\n")) +(defun cj/dwim-shell--zip-single-file-command () + "Return the zip command template for a single marked file. +The archive is named =<fne>.zip=, not a reconstruction of the input filename +\(which produced invalid archives, and a `foo.' name for a directory)." + "zip -r '<<fne>>.zip' '<<f>>'") + +(defun cj/dwim-shell--dated-backup-command () + "Return the cp command template for a timestamped backup of marked file(s). +The timestamp is interpolated here with `format-time-string' so it can't sit +dead inside the shell's single quotes the way a literal =$(date ...)= did." + (format "cp -p '<<f>>' '<<f>>.%s.bak'" (format-time-string "%Y%m%d_%H%M%S"))) + +(defun cj/dwim-shell--tar-gzip-command (single-p) + "Return the tar-gzip command template. +SINGLE-P non-nil names the archive after the lone file (=<fne>.tar.gz=); +otherwise a shared =archive.tar.gz= over all marked files." + (if single-p + "tar czf '<<fne>>.tar.gz' '<<f>>'" + "tar czf '<<archive.tar.gz(u)>>' '<<*>>'")) + +(defun cj/dwim-shell--text-to-speech-command (system voice) + "Return the text-to-speech command template for SYSTEM using VOICE. +SYSTEM is a `system-type' symbol: `darwin' synthesizes with `say' and VOICE; +any other system uses `espeak' (VOICE unused)." + (if (eq system 'darwin) + (format "say -v %s -o '<<fne>>.aiff' -f '<<f>>'" voice) + "espeak -f '<<f>>' -w '<<fne>>.wav'")) + +(defun cj/dwim-shell--video-trim-command (trim-type start end) + "Return the ffmpeg video-trim command template for TRIM-TYPE. +TRIM-TYPE is \"Beginning\", \"End\", or \"Both\". START trims that many +seconds off the front, END off the back (each ignored for the side it does +not apply to). Signals a `user-error' when a used second count is negative." + (pcase trim-type + ("Beginning" + (when (< start 0) (user-error "Seconds must be non-negative")) + (format "ffmpeg -i '<<f>>' -y -ss %d -c:v copy -c:a copy '<<fne>>_trimmed.<<e>>'" + start)) + ("End" + (when (< end 0) (user-error "Seconds must be non-negative")) + (format "ffmpeg -sseof -%d -i '<<f>>' -y -c:v copy -c:a copy '<<fne>>_trimmed.<<e>>'" + end)) + ("Both" + (when (or (< start 0) (< end 0)) (user-error "Seconds must be non-negative")) + (format "ffmpeg -i '<<f>>' -y -ss %d -sseof -%d -c:v copy -c:a copy '<<fne>>_trimmed.<<e>>'" + start end)))) + ;; ----------------------------- Dwim Shell Command ---------------------------- (use-package dwim-shell-command @@ -336,7 +318,7 @@ Otherwise, unzip it to an appropriately named subdirectory " (interactive) (dwim-shell-command-on-marked-files "Zip" (if (eq 1 (seq-length (dwim-shell-command--files))) - "zip -r '<<fne>>.<<e>>' '<<f>>'" + (cj/dwim-shell--zip-single-file-command) "zip -r '<<archive.zip(u)>>' '<<*>>'") :utils "zip")) @@ -344,9 +326,8 @@ Otherwise, unzip it to an appropriately named subdirectory " "Tar gzip all marked files into archive.tar.gz." (interactive) (dwim-shell-command-on-marked-files - "Tar gzip" (if (eq 1 (seq-length (dwim-shell-command--files))) - "tar czf '<<fne>>.tar.gz' '<<f>>'" - "tar czf '<<archive.tar.gz(u)>>' '<<*>>'") + "Tar gzip" (cj/dwim-shell--tar-gzip-command + (eq 1 (seq-length (dwim-shell-command--files)))) :utils "tar")) (defun cj/dwim-shell-commands-epub-to-org () @@ -435,34 +416,18 @@ process list, and the file is removed only after the spawned process exits." "Trim video with options for beginning, end, or both." (interactive) (let* ((trim-type (completing-read "Trim from: " - '("Beginning" "End" "Both") - nil t)) - (command (pcase trim-type - ("Beginning" - (let ((seconds (read-number "Seconds to trim from beginning: " 5))) - (when (< seconds 0) - (user-error "Seconds must be non-negative")) - (format "ffmpeg -i '<<f>>' -y -ss %d -c:v copy -c:a copy '<<fne>>_trimmed.<<e>>'" - seconds))) - ("End" - (let ((seconds (read-number "Seconds to trim from end: " 5))) - (when (< seconds 0) - (user-error "Seconds must be non-negative")) - (format "ffmpeg -sseof -%d -i '<<f>>' -y -c:v copy -c:a copy '<<fne>>_trimmed.<<e>>'" - seconds))) - ("Both" - (let ((start (read-number "Seconds to trim from beginning: " 5)) - (end (read-number "Seconds to trim from end: " 5))) - (when (or (< start 0) (< end 0)) - (user-error "Seconds must be non-negative")) - (format "ffmpeg -i '<<f>>' -y -ss %d -sseof -%d -c:v copy -c:a copy '<<fne>>_trimmed.<<e>>'" - start end)))))) - (dwim-shell-command-on-marked-files + '("Beginning" "End" "Both") + nil t)) + (start (if (member trim-type '("Beginning" "Both")) + (read-number "Seconds to trim from beginning: " 5) 0)) + (end (if (member trim-type '("End" "Both")) + (read-number "Seconds to trim from end: " 5) 0)) + (command (cj/dwim-shell--video-trim-command trim-type start end))) + (dwim-shell-command-on-marked-files (format "Trim video (%s)" trim-type) command :silent-success t :utils "ffmpeg"))) - (defun cj/dwim-shell-commands-drop-audio-from-video () "Drop audio from all marked videos." (interactive) @@ -546,8 +511,8 @@ clipboard contents cannot inject shell commands." (interactive) (dwim-shell-command-on-marked-files "Backup with date" - "cp -p '<<f>>' '<<f>>.$(date +%Y%m%d_%H%M%S).bak'" - :utils '("cp" "date"))) + (cj/dwim-shell--dated-backup-command) + :utils '("cp"))) (defun cj/dwim-shell-commands-optimize-image-for-web () "Optimize image(s) for web (reduce file size)." @@ -681,9 +646,7 @@ all marked files rather than once per file." "en"))) (dwim-shell-command-on-marked-files "Text to speech" - (if (eq system-type 'darwin) - (format "say -v %s -o '<<fne>>.aiff' -f '<<f>>'" voice) - "espeak -f '<<f>>' -w '<<fne>>.wav'") + (cj/dwim-shell--text-to-speech-command system-type voice) :utils (if (eq system-type 'darwin) "say" "espeak")))) (defun cj/dwim-shell-commands-remove-empty-directories () @@ -801,7 +764,7 @@ switching off the .7z format to gpg-wrapped tar." Uses =shred -u= so the file is unlinked after overwriting, matching the \"delete\" the command name and prompt promise." (interactive) - (when (yes-or-no-p "This will permanently destroy files. Continue? ") + (when (cj/confirm-strong "This will permanently destroy files. Continue? ") (dwim-shell-command-on-marked-files "Secure delete" "shred -vfzu -n 3 '<<f>>'" @@ -929,7 +892,7 @@ gpg: decryption failed: No pinentry" ;; Bind menu to keymaps after function is defined (with-eval-after-load 'dired - (keymap-set dired-mode-map "M-S-d" #'dwim-shell-commands-menu)) ;; was M-D, overrides kill-word + (keymap-set dired-mode-map "M-D" #'dwim-shell-commands-menu)) ;; Meta-Shift-d; matches the dirvish binding below (with-eval-after-load 'dirvish (keymap-set dirvish-mode-map "M-D" #'dwim-shell-commands-menu))) diff --git a/modules/eat-config.el b/modules/eat-config.el new file mode 100644 index 000000000..f53baed31 --- /dev/null +++ b/modules/eat-config.el @@ -0,0 +1,511 @@ +;;; eat-config.el --- EAT terminal emulator and the F12 eshell toggle -*- lexical-binding: t; coding: utf-8; -*- + +;;; Commentary: +;; +;; EAT (Emulate A Terminal, pure elisp) is the terminal emulator. Because EAT +;; renders entirely in elisp, its whole palette is real Emacs faces, so it themes +;; from the theme. This module owns the eat package configuration, the keymap +;; wiring that lets F12 and C-; reach Emacs from inside a terminal, and the F12 +;; dock-and-remember toggle. +;; +;; F12 opens eshell, which runs through EAT (eat-eshell-mode, set up in +;; eshell-config.el): the shell is eshell -- elisp functions as commands, TRAMP +;; transparency -- and EAT renders its visual commands. eshell-config.el holds +;; the shell itself; this module holds the emulator and the toggle. +;; +;; The toggle reuses the geometry-preservation pattern from cj-window-toggle-lib: +;; capture direction + body size at toggle-off, replay them via a custom display +;; action using frame-edge directions and body-relative sizes, so the docked +;; terminal returns at the same size and the result is divider-independent. + +;;; Code: + +(require 'keybindings) +(require 'system-lib) +(require 'cj-window-geometry-lib) +(require 'cj-window-toggle-lib) + +(declare-function eat "eat" (&optional program arg)) +(declare-function eshell "eshell" (&optional arg)) +(defvar eat-mode-map) +(defvar eat-semi-char-mode-map) +(defvar eshell-buffer-name) +(defvar cj/custom-keymap) + +;; EAT paints its palette with manual `face' text properties (the ANSI colors). +;; Left in `global-font-lock-mode', the terminal buffer also gets syntactic +;; fontification -- a "..." in program output becomes `font-lock-string-face', +;; overriding the foreground EAT painted (e.g. green-on-green inside a diff) -- +;; so exclude eat-mode, the same reason dashboard and mu4e are excluded. A +;; mode-hook can't do this: `global-font-lock-mode' runs after the mode hook. +(cj/exclude-from-global-font-lock 'eat-mode) + +(defun cj/turn-off-chrome-for-term () + "Turn off line numbers and hl-line in a terminal buffer." + (hl-line-mode -1) + (display-line-numbers-mode -1)) + +(defun cj/--eat-tame-scroll () + "Reduce the viewport bounce from full-frame inline redraws (Claude Code). +Such programs move the terminal cursor up to redraw their whole block and back +to the bottom on every tick; EAT follows the cursor with point, so the window +chases it. Line-scroll minimally instead of recentering, drop the scroll +margin, and disable auto vscroll, so the window follows with the smallest +movement. It cannot fully remove the bounce -- the inline redraw is the root -- +but it makes each jump gentler." + (setq-local scroll-conservatively 101) + (setq-local scroll-margin 0) + (setq-local auto-window-vscroll nil)) + +(defcustom cj/eat-reset-sgr-at-newline t + "When non-nil, EAT resets SGR (color) at each newline. +Claude Code and similar inline TUIs sometimes truncate a colored span without +emitting a reset; the unterminated color then bleeds onto every following line +in the buffer. Injecting a reset before each newline contains it to its own +line. Safe for the common case where programs re-open their color per line; a +program that carries a single color across newlines without re-opening it would +lose that color past the first line, so set this to nil if you hit that." + :type 'boolean + :group 'eat) + +(declare-function eat-term-process-output "eat") + +(defun cj/--eat-reset-sgr-at-newline (args) + "`:filter-args' advice for `eat-term-process-output'. +When `cj/eat-reset-sgr-at-newline' is non-nil, inject an SGR reset before each +newline in the pty OUTPUT so an unterminated color cannot bleed past its line. +ARGS is (TERMINAL OUTPUT)." + (if cj/eat-reset-sgr-at-newline + (list (car args) + (replace-regexp-in-string "\n" "\e[0m\n" (cadr args) t t)) + args)) + +(advice-add 'eat-term-process-output :filter-args #'cj/--eat-reset-sgr-at-newline) + +;; ------------------------------- eat package --------------------------------- + +(use-package eat + :ensure t + :commands (eat) + :hook ((eat-mode . cj/turn-off-chrome-for-term) + (eat-mode . cj/--eat-tame-scroll)) + :custom + ;; Close the EAT buffer when its shell exits. + (eat-kill-buffer-on-exit t) + ;; Shell-integration UX. These are EAT defaults, set explicitly to document + ;; intent and survive default changes. They only light up once the shell + ;; sources EAT's integration script -- see the EAT block in the zsh rc. + (eat-enable-directory-tracking t) ; Emacs follows the terminal's cwd + (eat-enable-shell-prompt-annotation t) ; the success/running/failure prompt glyphs + (eat-enable-shell-command-history t) ; terminal history into EAT line-mode isearch + ;; Interaction. + (eat-enable-mouse t) ; mouse clicks + selection in TUIs (default) + (eat-enable-kill-from-terminal t) ; terminal selection -> Emacs kill-ring (default) + (eat-enable-yank-to-terminal t) ; Emacs kill-ring -> the terminal (off by default) + ;; Fidelity. + (eat-enable-alternative-display t) ; alt-screen so TUIs restore scrollback on exit (default) + (eat-term-scrollback-size (* 10 1024 1024)) ; ~10MB of scrollback, matching the old ghostel + ;; Truecolor is already on: eat-term-name auto-selects the compiled eat-truecolor terminfo. + ;; Niceties. + (eat-sixel-render-formats '(xpm svg half-block background none)) ; inline images (on by default) + (eat-query-before-killing-running-terminal 'auto) ; confirm before killing a terminal with a live process + :config + ;; F12 and C-; must reach Emacs from inside EAT. In semi-char mode (EAT's + ;; default) EAT forwards unbound keys to the terminal -- a letter runs + ;; `eat-self-input' -- so bind these explicitly or they never reach Emacs: + ;; F12 toggles the terminal window, C-; opens the global prefix map. + (keymap-set eat-semi-char-mode-map "<f12>" #'cj/term-toggle) + (keymap-set eat-semi-char-mode-map "C-;" cj/custom-keymap) + (keymap-set eat-mode-map "<f12>" #'cj/term-toggle) + (keymap-set eat-mode-map "C-;" cj/custom-keymap)) + +;; ----------------------- F12 toggle (custom) ----------------------- +;; +;; Mirrors the geometry-preservation pattern shared with ai-term.el: capture +;; direction + body size at toggle-off, replay them via a custom display action +;; using frame-edge directions and body-relative sizes so the result is +;; divider-independent and layout-stable. Manages the EAT terminal only; +;; ai-term.el's agent buffers are separate (M-SPC). + +(defcustom cj/term-toggle-window-height 0.7 + "Default fraction of frame height for the F12 terminal window. +Used as the size fallback when F12 docks the terminal as a bottom split." + :type 'number + :group 'term) + +(defcustom cj/term-toggle-window-width 0.5 + "Default fraction of frame width for the F12 terminal window. +Used as the size fallback when F12 docks the terminal as a right-side +column (see `cj/--term-toggle-default-direction')." + :type 'number + :group 'term) + +(defun cj/--term-toggle-default-direction () + "Return the default dock direction for the F12 terminal: `right' or `below'. +Docks as a right-side column only when a side-by-side split would leave +both panes at least `cj/window-dock-min-columns' wide (the terminal's +share is `cj/term-toggle-window-width'); otherwise stacks below. See +`cj/preferred-dock-direction'." + (cj/preferred-dock-direction (frame-width) cj/term-toggle-window-width)) + +(defun cj/--term-toggle-default-size (direction) + "Return the default size fraction paired with DIRECTION for the F12 terminal. +`cj/term-toggle-window-width' for `right', `cj/term-toggle-window-height' +otherwise." + (if (eq direction 'right) + cj/term-toggle-window-width + cj/term-toggle-window-height)) + +(defvar cj/--term-toggle-last-direction nil + "Last user-chosen direction for the F12 terminal display. +Symbol: right, left, or below. `above' is never stored. nil means use the +default `below' for F12's traditional bottom split.") + +(defvar cj/--term-toggle-last-size nil + "Last user-chosen size for the F12 terminal display. +Positive integer: body-cols (right/left) or total-lines (below/above) -- see +`cj/window-replay-size' for why the vertical axis uses total, not body. +nil means fall back to `cj/term-toggle-window-height' as a fraction.") + +(defun cj/--term-toggle-buffer-p (buffer) + "Return non-nil when BUFFER is an eshell terminal F12 should manage. + +F12 opens eshell, which runs through EAT via eat-eshell-mode. ai-term's +agent buffers are managed separately via M-SPC, not F12." + (and (bufferp buffer) + (buffer-live-p buffer) + (with-current-buffer buffer + (derived-mode-p 'eshell-mode)))) + +(defun cj/--term-toggle-buffers () + "Return live F12-managed terminal buffers in `buffer-list' (MRU) order." + (seq-filter #'cj/--term-toggle-buffer-p (buffer-list))) + +(defun cj/--term-toggle-displayed-window (&optional frame) + "Return a window in FRAME currently displaying an F12 terminal buffer, or nil. +FRAME defaults to the selected frame. Minibuffer is excluded." + (seq-find (lambda (w) + (cj/--term-toggle-buffer-p (window-buffer w))) + (window-list (or frame (selected-frame)) 'never))) + +(defun cj/--term-toggle-capture-state (window) + "Capture WINDOW's direction + body size into module-level state. +The default direction (used when WINDOW fills its frame) is the +column-rule choice from `cj/--term-toggle-default-direction'." + (cj/window-toggle-capture-state + window (cj/--term-toggle-default-direction) + 'cj/--term-toggle-last-direction + 'cj/--term-toggle-last-size + '(right below left))) + +(defun cj/--term-toggle-display-saved (buffer alist) + "Display-buffer action: split per saved direction and body size. +Delegates to `cj/window-toggle-display-saved' against the F12 state vars, +falling back to the column-rule default direction +\(`cj/--term-toggle-default-direction') and its paired size." + (let ((dir (cj/--term-toggle-default-direction))) + (cj/window-toggle-display-saved + buffer alist + 'cj/--term-toggle-last-direction dir + 'cj/--term-toggle-last-size (cj/--term-toggle-default-size dir)))) + +(defun cj/--term-toggle-display-rule-list () + "Return the `display-buffer-alist' entry list installed by F12. +Routes any terminal buffer satisfying `cj/--term-toggle-buffer-p' through +reuse-window then the saved-geometry action. Excludes agent buffers." + '(((lambda (buffer-or-name _) + (cj/--term-toggle-buffer-p (get-buffer buffer-or-name))) + (display-buffer-reuse-window + cj/--term-toggle-display-saved) + (inhibit-same-window . t)))) + +(dolist (entry (cj/--term-toggle-display-rule-list)) + (add-to-list 'display-buffer-alist entry)) + +(defun cj/--term-toggle-dispatch () + "Compute the F12 (`cj/term-toggle') action without performing it. + +Returns one of: +- (toggle-off . WINDOW) -- terminal displayed in WINDOW; hide it. +- (show-recent . BUFFER) -- terminal alive but not shown; redisplay. +- (create-new) -- no terminal buffer alive; create one." + (let ((win (cj/--term-toggle-displayed-window))) + (cond + (win (cons 'toggle-off win)) + (t + (let ((buffers (cj/--term-toggle-buffers))) + (cond + (buffers (cons 'show-recent (car buffers))) + (t '(create-new)))))))) + +(defun cj/term-toggle () + "Toggle the F12 eshell terminal (the primary `*eshell*', run through EAT). + +- If it is displayed in this frame, capture its geometry and delete its window + (toggle off). Falls back to burying when it is the only window in the frame. +- Otherwise, if it is alive, display it via the saved-geometry action. +- Otherwise, open eshell, displaying it through the same saved-geometry action. + +eshell runs through EAT via eat-eshell-mode, so visual commands render in a real +terminal. ai-term's agent buffers are managed separately via M-SPC." + (interactive) + (pcase (cj/--term-toggle-dispatch) + (`(toggle-off . ,win) + (cj/--term-toggle-capture-state win) + (if (one-window-p) + (bury-buffer (window-buffer win)) + (delete-window win)) + nil) + (`(show-recent . ,buf) + (display-buffer buf) + (let ((w (get-buffer-window buf))) + (when w (select-window w))) + buf) + (`(create-new) + ;; Open the primary eshell without stealing the layout, then display it + ;; through the saved-geometry dock rule (same path as show-recent). + (save-window-excursion (eshell)) + (let ((buf (get-buffer (or (bound-and-true-p eshell-buffer-name) "*eshell*")))) + (when buf + (display-buffer buf) + (let ((w (get-buffer-window buf))) + (when w (select-window w)))) + buf)))) + +(keymap-global-set "<f12>" #'cj/term-toggle) + +;; ------------------- terminal copy mode + tmux history ----------------------- +;; Carried over from the ghostel era for the EAT agent terminals (ai-term). +;; Agents run EAT over tmux, so copy-mode is tmux's own copy-mode -- the same UX +;; ghostel-over-tmux had. C-<up> enters it and scrolls up in one stroke; C-; x c +;; enters it via the menu, and C-; x h grabs the whole pane history into a buffer. + +(declare-function cj/register-prefix-map "keybindings") +(declare-function eat-emacs-mode "eat") +(defvar eat--semi-char-mode) +(defvar eat--char-mode) +(defvar eat--line-mode) + +(defun cj/--term-send-string (string) + "Send STRING to the current terminal buffer's process (the pty)." + (let ((proc (get-buffer-process (current-buffer)))) + (when (process-live-p proc) + (process-send-string proc string)))) + +(defun cj/term-send-escape () + "Send ESC to the terminal. +In tmux copy-mode this cancels it (tmux binds Escape to cancel); in a TUI like +vim it forwards ESC normally. EAT's semi-char mode leaves the bare escape key +unbound and treats `ESC' only as the Meta prefix, so without this the key never +reaches the pty -- which is why C-<up>'s tmux copy-mode could not be exited with +Escape." + (interactive) + (cj/--term-send-string "\e")) + +(defun cj/term--tmux-output (&rest args) + "Run tmux with ARGS and return its stdout. +Signal `user-error' when tmux exits with a non-zero status." + (with-temp-buffer + (let ((exit-code (apply #'process-file "tmux" nil t nil args))) + (unless (zerop exit-code) + (user-error "tmux failed: %s" (string-trim (buffer-string)))) + (buffer-string)))) + +(defun cj/term--tmux-pane-id-for-tty (tty) + "Return the tmux pane id for client TTY." + (let* ((output (cj/term--tmux-output + "list-clients" "-F" "#{client_tty}\t#{pane_id}")) + (lines (split-string output "\n" t)) + (match (seq-find + (lambda (line) + (let ((fields (split-string line "\t"))) + (equal (car fields) tty))) + lines))) + (unless match + (user-error "No tmux client found for terminal tty %s" tty)) + (cadr (split-string match "\t")))) + +(defun cj/term--tmux-capture-pane (pane-id) + "Return full joined tmux history for PANE-ID." + (cj/term--tmux-output + "capture-pane" "-p" "-J" "-S" "-" "-E" "-" "-t" pane-id)) + +(defun cj/term--current-tmux-pane-id () + "Return the tmux pane id for the current EAT terminal buffer." + (unless (derived-mode-p 'eat-mode) + (user-error "Current buffer is not an EAT terminal")) + (let* ((proc (get-buffer-process (current-buffer))) + (tty (and proc (process-tty-name proc)))) + (unless (and tty (not (string-empty-p tty))) + (user-error "Could not determine terminal tty")) + (cj/term--tmux-pane-id-for-tty tty))) + +(defvar-local cj/term-tmux-history--origin-buffer nil + "Buffer active before opening the tmux history buffer.") +(defvar-local cj/term-tmux-history--origin-window nil + "Window active before opening the tmux history buffer.") +(defvar-local cj/term-tmux-history--origin-point nil + "Point in the origin buffer before opening the tmux history buffer.") + +(defun cj/term-tmux-history-quit () + "Quit tmux history and return to its origin buffer." + (interactive) + (let ((history-buffer (current-buffer)) + (origin-buffer cj/term-tmux-history--origin-buffer) + (origin-window cj/term-tmux-history--origin-window) + (origin-point cj/term-tmux-history--origin-point)) + (when (buffer-live-p origin-buffer) + (if (window-live-p origin-window) + (progn + (set-window-buffer origin-window origin-buffer) + (select-window origin-window)) + (pop-to-buffer origin-buffer)) + (with-current-buffer origin-buffer + (when (integer-or-marker-p origin-point) + (goto-char origin-point)))) + (when (buffer-live-p history-buffer) + (kill-buffer history-buffer)))) + +(defvar-keymap cj/term-tmux-history-mode-map + :doc "Keymap for `cj/term-tmux-history-mode'. +M-w copies the active region without leaving the buffer; C-g, <escape>, or q +returns to the terminal without copying. RET is left unbound." + "M-w" #'kill-ring-save + "C-g" #'cj/term-tmux-history-quit + "<escape>" #'cj/term-tmux-history-quit + "q" #'cj/term-tmux-history-quit) + +(define-derived-mode cj/term-tmux-history-mode special-mode "Tmux History" + "Mode for copying captured tmux pane history with normal Emacs keys." + (setq-local truncate-lines t) + (goto-address-mode 1)) + +(defun cj/term-tmux-history () + "Open full tmux pane history in a temporary Emacs buffer. + +The history buffer uses normal Emacs navigation and selection. `M-w' copies +the active region and stays open, so several pieces can be copied in a row; +`q', `<escape>', or `C-g' returns point to the terminal buffer that launched +it. The history view replaces the origin terminal buffer in the same window." + (interactive) + (let* ((origin-buffer (current-buffer)) + (origin-window (selected-window)) + (origin-point (point)) + (pane-id (cj/term--current-tmux-pane-id)) + (history (cj/term--tmux-capture-pane pane-id)) + (buffer (get-buffer-create + (format "*terminal tmux history: %s*" (buffer-name origin-buffer))))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert history)) + (cj/term-tmux-history-mode) + (setq-local cj/term-tmux-history--origin-buffer origin-buffer) + (setq-local cj/term-tmux-history--origin-window origin-window) + (setq-local cj/term-tmux-history--origin-point origin-point) + (goto-char (point-max))) + (switch-to-buffer buffer))) + +(defun cj/term--in-tmux-p () + "Return non-nil when the current EAT buffer has a tmux client attached. +Lookup errors (not eat-mode, no tty, no client, tmux absent) are treated as +nil so callers can use this as a cheap boolean predicate." + (and (derived-mode-p 'eat-mode) + (condition-case _ + (and (cj/term--current-tmux-pane-id) t) + (error nil)))) + +(defun cj/--term-in-emacs-mode-p () + "Return non-nil when the current EAT buffer is in emacs (navigation) mode. +EAT has no dedicated emacs-mode flag; emacs mode is the absence of the +semi-char, char, and line input modes." + (and (derived-mode-p 'eat-mode) + (not (or (bound-and-true-p eat--semi-char-mode) + (bound-and-true-p eat--char-mode) + (bound-and-true-p eat--line-mode))))) + +(defun cj/term-copy-mode-dwim () + "Enter copy-mode using the engine appropriate to this terminal. + +When tmux is attached (an agent terminal), write tmux's prefix sequence (C-b [) +into the pty so the user lands in tmux's copy-mode with the full pane history, +then C-a to land the cursor at column 0 so scrolling up runs up the left edge. +Without tmux, falls through to EAT's emacs mode (a navigable view of the +scrollback) and moves point to the start of the line." + (interactive) + (if (cj/term--in-tmux-p) + (cj/--term-send-string "\C-b[\C-a") + (eat-emacs-mode) + (beginning-of-line))) + +(defun cj/term--tmux-pane-in-copy-mode-p (pane-id) + "Return non-nil when tmux PANE-ID is currently displaying a mode. +tmux's `pane_in_mode' is 1 while a pane is in any mode; copy-mode is the only +mode this config enters. tmux failures are treated as nil." + (condition-case nil + (equal "1" (string-trim + (cj/term--tmux-output + "display-message" "-p" "-t" pane-id "#{pane_in_mode}"))) + (error nil))) + +(defun cj/term-copy-mode-up () + "Enter copy-mode if needed, then scroll up one line. +A single C-<up> lands in the terminal's copy-mode already moving up. Pressed +again while already in copy-mode it just moves up another line, so it never +re-enters and resets the cursor. In tmux, writes the up-arrow escape into the +pty; without tmux, moves point up in EAT's emacs-mode buffer." + (interactive) + (let ((pane (ignore-errors (cj/term--current-tmux-pane-id)))) + (cond + (pane + (unless (cj/term--tmux-pane-in-copy-mode-p pane) + (cj/term-copy-mode-dwim)) + (cj/--term-send-string "\e[A")) + (t + (unless (cj/--term-in-emacs-mode-p) + (cj/term-copy-mode-dwim)) + (forward-line -1))))) + +;; The C-; x terminal prefix (copy-mode, tmux history, the F12 toggle). C-<up> +;; enters copy-mode + scrolls in one stroke; bound in EAT's semi-char map so it +;; reaches Emacs from inside an agent terminal. +(defvar-keymap cj/term-map + :doc "Personal terminal command map.") +(cj/register-prefix-map "x" cj/term-map) +(keymap-set cj/term-map "c" #'cj/term-copy-mode-dwim) +(keymap-set cj/term-map "h" #'cj/term-tmux-history) +(keymap-set cj/term-map "t" #'cj/term-toggle) + +(defvar eat-mode-map) +(declare-function eat-semi-char-mode "eat") +(declare-function eat-self-input "eat") + +(defun cj/eat-text-scale-reset () + "Reset the text scale to its default in the current buffer." + (interactive) + (text-scale-set 0)) + +(with-eval-after-load 'eat + (keymap-set eat-semi-char-mode-map "C-<up>" #'cj/term-copy-mode-up) + ;; Zoom-out and reset reach Emacs, not the pty. EAT binds C-- to + ;; eat-self-input (forwarded to the terminal), so without this the font can + ;; only grow: C-= / C-+ pass through and zoom in, but C-- never reaches + ;; text-scale-decrease. Low cost -- the Claude TUI and tmux don't use Ctrl+-, + ;; and C-0 shadows digit-argument inside eat buffers only. + (keymap-set eat-semi-char-mode-map "C--" #'text-scale-decrease) + (keymap-set eat-semi-char-mode-map "C-0" #'cj/eat-text-scale-reset) + ;; Escape forwards ESC to the pty, so it cancels tmux copy-mode (tmux binds + ;; Escape to cancel) and works in TUIs; in EAT's own emacs/char mode it returns + ;; to semi-char. One key gets out of either copy view. + (keymap-set eat-semi-char-mode-map "<escape>" #'cj/term-send-escape) + (keymap-set eat-mode-map "<escape>" #'eat-semi-char-mode) + ;; Word-motion arrows edit the terminal program's input (claude, readline), so + ;; forward them to the pty. EAT's default leaves them in the non-bound-keys + ;; list, which moved Emacs point instead and desynced it from the real cursor + ;; (point jumped back on the next keystroke). Window arrows (S-, C-M-) keep + ;; reaching Emacs for windmove / buffer-move. + (dolist (key '("C-<left>" "C-<right>" "M-<left>" "M-<right>")) + (keymap-set eat-semi-char-mode-map key #'eat-self-input))) + +(provide 'eat-config) +;;; eat-config.el ends here diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index ad7bda83a..e5cbb36c0 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -29,21 +29,33 @@ (require 'system-lib) (require 'media-utils) +(declare-function elfeed "elfeed") +(declare-function elfeed-update "elfeed") +(declare-function elfeed-entry-link "elfeed") +(declare-function elfeed-untag "elfeed") +(declare-function elfeed-search-selected "elfeed") +(declare-function elfeed-search-tag-all "elfeed") +(declare-function elfeed-search-update-entry "elfeed") +(declare-function elfeed-search-update--force "elfeed") +(declare-function elfeed-search-untag-all-unread "elfeed") +(declare-function eww-browse-url "eww") +(declare-function eww-readable "eww") + +;; elfeed paints its search and entry buffers with manual `face' text properties +;; (the date, title, feed, and tag faces the theme styles). Left in +;; `global-font-lock-mode', font-lock overwrites those with syntactic string +;; fontification, so the buffer loses the theme colors. Exclude both modes, the +;; same reason dashboard and mu4e are excluded. +(cj/exclude-from-global-font-lock 'elfeed-search-mode 'elfeed-show-mode) + ;; ------------------------------- Elfeed Config ------------------------------- (use-package elfeed :bind - ("M-S-r" . cj/elfeed-open) ;; was M-R (:map elfeed-show-mode-map ("w" . eww-open-in-new-buffer)) (:map elfeed-search-mode-map - ("w" . cj/elfeed-eww-open) ;; opens in eww - ("b" . cj/elfeed-browser-open) ;; opens in external browser - ("d" . cj/elfeed-youtube-dl) ;; async download with yt-dlp and tsp - ("v" . cj/play-with-video-player)) ;; async play with mpv - ("V" . cj/select-media-player) ;; Capital V to select player - ("R" . cj/elfeed-mark-all-as-read) ;; capital marks all as read, since upper case marks one as read - ("U" . cj/elfeed-mark-all-as-unread) ;; capital marks all as unread, since lower case marks one as unread + ("V" . cj/select-media-player)) ;; Capital V to select player :config (setq elfeed-db-directory (concat user-emacs-directory ".elfeed-db")) (setq-default elfeed-search-title-max-width 150) @@ -60,11 +72,26 @@ ;; Pivot with Kara Swisher and Scott Galloway ("https://www.youtube.com/feeds/videos.xml?channel_id=UCBHGZpDF2fsqPIPi0pNyuTg" yt pivot) + ;; Platypus Economics with Justin Wolfers + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCB5eaPWEwR6wR2MxRx64s0g" yt platypus) + + ;; Conversations with Tyler (Tyler Cowen) + ("https://www.youtube.com/feeds/videos.xml?channel_id=UC_AnpBvnhXTcipgGEHLWoOg" yt cwt) + + ;; Plain English with Derek Thompson + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCoOUW7SiXzLbc_O3nSDOBYA" yt plain-english) + + ;; Odd Lots (Bloomberg) -- Joe Weisenthal & Tracy Alloway + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLe4PRejZgr0MuA6M0zkZyy-99-qc87wKV" yt oddlots) + + ;; All-In Podcast + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCESLZhusAkFfsNsApnjF_Cg" yt allin) + ;; The Prof G Pod ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLtQ-jBytlXCasRuBG86m22rOQfrEPcctq" yt profg) ;; On with Kara Swisher - ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLKof9YSAshgxI6odrEJFKsJbxamwoQBju" yt) + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLKof9YSAshgxI6odrEJFKsJbxamwoQBju" yt on) ;; Raging Moderates ("https://www.youtube.com/feeds/videos.xml?channel_id=UCcvDWzvxz6Kn1iPQHMl2teA" yt raging-moderates) @@ -76,7 +103,7 @@ ("https://www.youtube.com/feeds/videos.xml?playlist_id=PL45Mc1cDgnsB-u1iLPBYNF1fk-y1cVzTJ" yt trae) ;; Tropical Tidbits - ("https://www.youtube.com/feeds/videos.xml?channel_id=UCrFIk7g_riIm2G2Vi90pxDA" yt) + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCrFIk7g_riIm2G2Vi90pxDA" yt tropical) ;; If You're Listening | ABC News In-depth ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLDTPrMoGHssAfgMMS3L5LpLNFMNp1U_Nq" yt listening) @@ -90,19 +117,22 @@ (elfeed) (elfeed-update) (elfeed-search-update--force)) +(keymap-global-set "M-S-r" #'cj/elfeed-open) ;; was M-R ;; -------------------------- Elfeed Filter Functions -------------------------- (defun cj/elfeed-mark-all-as-read () "Remove the \='unread\=' tag from all visible entries in search buffer." (interactive) - (mark-whole-buffer) + (goto-char (point-min)) + (push-mark (point-max) nil t) (elfeed-search-untag-all-unread)) (defun cj/elfeed-mark-all-as-unread () "Add the \='unread\=' tag from all visible entries in the search buffer." (interactive) - (mark-whole-buffer) + (goto-char (point-min)) + (push-mark (point-max) nil t) (elfeed-search-tag-all 'unread)) (defun cj/elfeed-set-filter-and-update (filterstring) @@ -126,23 +156,13 @@ Returns the stream URL or nil on failure." (cmd-args (append '("yt-dlp" "-q" "-g") format-args (list url))) - ;; DEBUG: Log the command - (_ (cj/log-silently "DEBUG: Extracting with command: %s" - (mapconcat #'shell-quote-argument cmd-args " "))) (output (with-temp-buffer (let ((exit-code (apply #'call-process (car cmd-args) nil t nil (cdr cmd-args)))) (if (zerop exit-code) (string-trim (buffer-string)) - (progn - ;; DEBUG: Log failure - (cj/log-silently "DEBUG: yt-dlp failed with exit code %d" exit-code) - (cj/log-silently "DEBUG: Error output: %s" (buffer-string)) - nil)))))) - ;; DEBUG: Log the result - (cj/log-silently "DEBUG: Extracted URL: %s" - (if output (truncate-string-to-width output 100) "nil")) + nil))))) (when (and output (string-match-p "^https?://" output)) output))) @@ -223,6 +243,15 @@ Note: Function name kept for backwards compatibility." "Seconds to wait for a synchronous YouTube page fetch before giving up. Without a timeout a hung request would block Emacs indefinitely.") +(defun cj/--decode-html-entities (text) + "Decode the common HTML entities in TEXT. +Handles & < > " ' and ' -- the entities YouTube's +og:title meta tag emits. Decoded left-to-right, & first." + (let ((entities '(("&" . "&") ("<" . "<") (">" . ">") + (""" . "\"") ("'" . "'") ("'" . "'")))) + (dolist (pair entities text) + (setq text (replace-regexp-in-string (car pair) (cdr pair) text))))) + (defun cj/youtube-to-elfeed-feed-format (url type) "Convert YouTube URL to elfeed-feeds format. @@ -274,13 +303,8 @@ TYPE should be either \='channel or \='playlist." (goto-char (point-min)) (when (re-search-forward "<meta property=\"og:title\" content=\"\\([^\"]+\\)\"" nil t) (setq title (match-string 1)) - ;; Simple HTML entity decoding - (setq title (replace-regexp-in-string "&" "&" title)) - (setq title (replace-regexp-in-string "<" "<" title)) - (setq title (replace-regexp-in-string ">" ">" title)) - (setq title (replace-regexp-in-string """ "\"" title)) - (setq title (replace-regexp-in-string "'" "'" title)) - (setq title (replace-regexp-in-string "'" "'" title)))))) + ;; Decode HTML entities in the extracted title + (setq title (cj/--decode-html-entities title)))))) ;; Always kill the temporary URL buffer, even when extraction failed -- ;; the old code only killed it when an ID was found, leaking it otherwise. (when (buffer-live-p buffer) @@ -308,5 +332,18 @@ TYPE should be either \='channel or \='playlist." (insert result)) result)) +;; --------------------------- Search-Mode Keybindings ------------------------- +;; Bound here (not in use-package :bind) because these commands are defined in +;; this file; a :bind autoload stub plus the defun triggers a "defined multiple +;; times" byte-compile warning. + +(with-eval-after-load 'elfeed + (keymap-set elfeed-search-mode-map "w" #'cj/elfeed-eww-open) ;; opens in eww + (keymap-set elfeed-search-mode-map "b" #'cj/elfeed-browser-open) ;; opens in external browser + (keymap-set elfeed-search-mode-map "d" #'cj/elfeed-youtube-dl) ;; async download with yt-dlp and tsp + (keymap-set elfeed-search-mode-map "v" #'cj/play-with-video-player) ;; async play with mpv + (keymap-set elfeed-search-mode-map "R" #'cj/elfeed-mark-all-as-read) ;; capital R marks all read (lower case marks one) + (keymap-set elfeed-search-mode-map "U" #'cj/elfeed-mark-all-as-unread)) ;; capital U marks all unread (lower case marks one) + (provide 'elfeed-config) ;;; elfeed-config.el ends here. diff --git a/modules/erc-config.el b/modules/erc-config.el index 22ba7f53d..4eac812c4 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -28,8 +28,37 @@ ;; Load cl-lib at compile time and runtime (lightweight, already loaded in most configs) (require 'cl-lib) (require 'keybindings) ;; provides cj/custom-keymap -(eval-when-compile (require 'erc) - (require 'user-constants)) +(eval-when-compile (require 'erc)) +;; user-constants is required at runtime, not just compile time: `user-whole-name' +;; is read at load time below (erc-user-full-name), so a standalone .elc needs it. +(require 'user-constants) + +;; ERC loads lazily (use-package :commands), so these symbols aren't bound at +;; this file's compile time. Declare them to keep the byte-compiler quiet +;; without forcing an eager require. + +;; Functions provided by the erc package. +(declare-function erc-buffer-list "erc") +(declare-function erc-server-process-alive "erc") +(declare-function erc-server-or-unjoined-channel-buffer-p "erc") +(declare-function erc-current-nick "erc") +(declare-function erc-join-channel "erc") +(declare-function erc-part-from-channel "erc") +(declare-function erc-quit-server "erc") + +;; Variables read/set in the use-package :config block below. +(defvar erc-log-channels-directory) +(defvar erc-track-exclude-types) +(defvar erc-track-exclude-server-buffer) +(defvar erc-track-visibility) +(defvar erc-track-switch-direction) +(defvar erc-track-showcount) +;; NOTE: erc-unique-buffers and erc-generate-buffer-name-function are not ERC +;; variables in Emacs 30.x (no defcustom/defvar in the package); the setq below +;; only creates inert globals. Declared here to silence the warning without +;; changing the existing (no-op) behavior -- see the SUSPICIOUS note. +(defvar erc-unique-buffers) +(defvar erc-generate-buffer-name-function) ;; ------------------------------------ ERC ------------------------------------ ;; Server definitions and connection settings @@ -97,7 +126,7 @@ Change this value to use a different nickname.") (let ((server-buffers '())) (dolist (buf (erc-buffer-list)) (with-current-buffer buf - (when (eq (buffer-local-value 'erc-server-process buf) erc-server-process) + (when (and (erc-server-or-unjoined-channel-buffer-p) (erc-server-process-alive)) (unless (member (buffer-name) server-buffers) (push (buffer-name) server-buffers))))) @@ -111,6 +140,8 @@ Change this value to use a different nickname.") server-buffers)) +(require 'system-lib) + (defun cj/erc-switch-to-buffer-with-completion () "Switch to an ERC buffer using completion. If no ERC buffers exist, prompt to connect to a server. @@ -119,7 +150,7 @@ Buffer names are shown with server context for clarity." (let* ((erc-buffers (erc-buffer-list)) (buffer-names (mapcar #'buffer-name erc-buffers))) (if buffer-names - (let ((selected (completing-read "Switch to ERC buffer: " buffer-names nil t))) + (let ((selected (completing-read "Switch to ERC buffer: " (cj/completion-table 'buffer buffer-names) nil t))) (switch-to-buffer selected)) (message "No ERC buffers found.") (when (y-or-n-p "Connect to an IRC server? ") @@ -130,7 +161,7 @@ Buffer names are shown with server context for clarity." "Return t if the current buffer is an active ERC server buffer." (and (derived-mode-p 'erc-mode) (erc-server-process-alive) - (erc-server-buffer-p))) + (erc-server-or-unjoined-channel-buffer-p))) (defun cj/erc-get-channels-for-current-server () @@ -156,7 +187,7 @@ Auto-adds # prefix if missing. Offers completion from configured channels." (let ((server-buffers (cl-remove-if-not (lambda (buf) (with-current-buffer buf - (and (erc-server-buffer-p) + (and (erc-server-or-unjoined-channel-buffer-p) (erc-server-process-alive)))) (erc-buffer-list)))) (if server-buffers @@ -182,6 +213,14 @@ Auto-adds # prefix if missing. Offers completion from configured channels." (erc-join-channel channel))) (message "Failed to establish an active ERC connection"))) +(defun cj/erc-generate-buffer-name (parms) + "Generate buffer name in the format SERVER-CHANNEL." + (let ((network (plist-get parms :server)) + (target (plist-get parms :target))) + (if target + (concat (or network "") "-" (or target "")) + (or network "")))) + ;; Keymap for ERC commands (must be defined before use-package erc) (defvar-keymap cj/erc-keymap :doc "Keymap for ERC-related commands" @@ -222,7 +261,6 @@ Auto-adds # prefix if missing. Offers completion from configured channels." match move-to-prompt noncommands - notifications readonly services stamp @@ -258,15 +296,7 @@ Auto-adds # prefix if missing. Offers completion from configured channels." ;; Note: erc-rename-buffers is obsolete as of Emacs 29.1 (old behavior is now permanent) (setq erc-unique-buffers t) - ;; Custom buffer naming function - (defun cj/erc-generate-buffer-name (parms) - "Generate buffer name in the format SERVER-CHANNEL." - (let ((network (plist-get parms :server)) - (target (plist-get parms :target))) - (if target - (concat (or network "") "-" (or target "")) - (or network "")))) - + ;; Custom buffer naming (cj/erc-generate-buffer-name is defined at top level) (setq erc-generate-buffer-name-function 'cj/erc-generate-buffer-name) ;; Configure erc-track (show channel activity in modeline) @@ -337,16 +367,15 @@ NICK is the sender and MESSAGE is the message text." :after erc :hook (erc-mode . erc-nicks-mode)) -;; ------------------------------ ERC Yank To Gist ----------------------------- -;; automatically create a Gist if pasting more than 5 lines -;; this module requires https://github.com/defunkt/gist -;; via ruby: 'gem install gist' via the aur: yay -S gist - -(use-package erc-yank - :after erc - :bind - (:map erc-mode-map - ("C-y" . erc-yank))) +;; -------------------------------- ERC Yank ---------------------------------- +;; The erc-yank package was dropped 2026-06-20: a paste over 5 lines became a +;; PUBLIC gist (it called `gist -P', the clipboard paste flag, with no +;; `--private'), behind only a single y-or-n-p and with no guard if the `gist' +;; binary was absent -- a one-keystroke path to publishing whatever sat on the +;; system clipboard. No replacement binding is needed: erc-mode-map defines no +;; C-y of its own, so with erc-yank gone C-y falls through to the ordinary +;; global `yank' and a paste stays local. Gist a large snippet by hand when +;; that's actually wanted. (provide 'erc-config) ;;; erc-config.el ends here diff --git a/modules/eshell-config.el b/modules/eshell-config.el index 0439a4673..7379795d2 100644 --- a/modules/eshell-config.el +++ b/modules/eshell-config.el @@ -26,6 +26,35 @@ (require 'system-utils) +;; Eshell is loaded lazily (:commands eshell), so its vars and functions are +;; not defined when this file is byte-compiled standalone. Declare them to +;; silence compile-time free-variable / undefined-function warnings. +(defvar eshell-banner-message) +(defvar eshell-scroll-to-bottom-on-input) +(defvar eshell-error-if-no-glob) +(defvar eshell-hist-ignoredups) +(defvar eshell-save-history-on-exit) +(defvar eshell-prefer-lisp-functions) +(defvar eshell-destroy-buffer-when-process-dies) +(defvar eshell-prompt-function) +(defvar eshell-cmpl-cycle-completions) +(defvar eshell-modules-list) +(defvar eshell-hist-mode-map) +(defvar eshell-visual-commands) +(defvar eshell-visual-subcommands) +(defvar eshell-visual-options) +(defvar eshell-history-ring) +(defvar eshell-preoutput-filter-functions) +(defvar eshell-output-filter-functions) + +(declare-function ring-elements "ring") +(declare-function eshell-send-input "esh-mode") +(declare-function eshell/pwd "em-dirs") +(declare-function eshell/alias "em-alias") +(declare-function eshell/cd "em-dirs") +(declare-function eshell-stringify "esh-util") +(declare-function eat-eshell-mode "eat") + (defgroup cj/eshell nil "Personal Eshell configuration." :group 'eshell) @@ -57,6 +86,59 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (dolist (pair (cj/--eshell-ssh-alias-commands hosts)) (eshell/alias (car pair) (cdr pair)))) +;; ---------------------------- prompt segments -------------------------------- + +(defun cj/--eshell-git-branch () + "Return the current git branch for `default-directory', or nil. +Reads .git/HEAD directly so it adds no subprocess per prompt, and skips remote +directories so a TRAMP prompt stays fast." + (unless (file-remote-p default-directory) + (when-let* ((root (locate-dominating-file default-directory ".git")) + (head (expand-file-name ".git/HEAD" root))) + (when (file-readable-p head) + (with-temp-buffer + (insert-file-contents head) + (when (looking-at "ref: refs/heads/\\(.*\\)") + (string-trim (match-string 1)))))))) + +(defun cj/--eshell-prompt-status-segment () + "Return the eshell prompt's exit-status segment, or an empty string. +Shows the last command's exit code in brackets when it was non-zero, mirroring +the zsh prompt's failure indicator." + (let ((status (bound-and-true-p eshell-last-command-status))) + (if (or (null status) (zerop status)) + "" + (format " [%d]" status)))) + +;; ------------------------------- zoxide -------------------------------------- +;; Share the same frecency database as the zsh shell by calling the zoxide +;; binary: `z' jumps to a remembered directory, and every eshell directory +;; change feeds `zoxide add' so eshell visits accrue in the same database. + +(defun eshell/z (&rest args) + "Jump to a directory via zoxide, sharing the zsh zoxide database. +With no ARGS, cd home. Otherwise query zoxide for the best match and cd there." + (if (null args) + (eshell/cd) + (let ((dir (string-trim + (shell-command-to-string + (concat "zoxide query -- " + (mapconcat #'shell-quote-argument + (mapcar #'eshell-stringify args) " ")))))) + (if (and (not (string-empty-p dir)) (file-directory-p dir)) + (eshell/cd dir) + (error "zoxide: no match for %s" + (string-join (mapcar #'eshell-stringify args) " ")))))) + +(defun cj/--eshell-zoxide-add () + "Record `default-directory' in the zoxide database (skips remote dirs)." + (when (and (not (file-remote-p default-directory)) + (executable-find "zoxide")) + (call-process "zoxide" nil 0 nil "add" "--" + (expand-file-name default-directory)))) + +(add-hook 'eshell-directory-change-hook #'cj/--eshell-zoxide-add) + (use-package eshell :ensure nil ;; built-in :commands (eshell) @@ -75,15 +157,18 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (setq eshell-prompt-function (lambda () (concat - (propertize (format-time-string "[%d-%m-%y %T]") 'face '(:foreground "gray")) + (propertize (format-time-string "[%d-%m-%y %T]") 'face 'default) " " - (propertize (user-login-name) 'face '(:foreground "gray")) + (propertize (user-login-name) 'face 'default) " " - (propertize (system-name) 'face '(:foreground "gray")) + (propertize (system-name) 'face 'default) ":" - (propertize (abbreviate-file-name (eshell/pwd)) 'face '(:foreground "gray")) + (propertize (abbreviate-file-name (eshell/pwd)) 'face 'default) + (let ((branch (cj/--eshell-git-branch))) + (if branch (propertize (concat " (" branch ")") 'face 'default) "")) + (propertize (cj/--eshell-prompt-status-segment) 'face 'default) "\n" - (propertize "%" 'face '(:foreground "white")) + (propertize "%" 'face 'default) " "))) (add-hook @@ -101,7 +186,8 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (add-hook 'eshell-mode-hook (lambda () - (add-to-list 'eshell-visual-commands '("lf" "ranger" "tail" "htop" "gotop" "mc" "ncdu" "top")) + (dolist (cmd '("lf" "ranger" "tail" "htop" "gotop" "mc" "ncdu" "top")) + (add-to-list 'eshell-visual-commands cmd)) (add-to-list 'eshell-visual-subcommands '("git" "log" "diff" "show")) (add-to-list 'eshell-visual-options '("git" "--help" "--paginate")) @@ -152,30 +238,20 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (delete-window))) (advice-add 'eshell-life-is-too-much :after 'cj/eshell-delete-window-on-exit) -(use-package eshell-toggle - :custom - (eshell-toggle-size-fraction 2) - (eshell-toggle-run-command nil) - (eshell-toggle-init-function #'eshell-toggle-init-eshell) - :bind - ("C-<f12>" . eshell-toggle)) +;; Run eshell's external commands through EAT (a real terminal): visual commands +;; (vim, htop, less) render properly and ANSI output is faithful, while eshell +;; stays the shell -- elisp functions as commands + TRAMP transparency. EAT +;; handles color itself, so it supersedes xterm-color for eshell; the +;; xterm-color block below stays for now and steps aside if colors double up. +(with-eval-after-load 'esh-mode + (require 'eat) + (eat-eshell-mode 1)) -(use-package xterm-color - :after eshell - :hook - (eshell-before-prompt-hook . (lambda () - (setq xterm-color-preserve-properties t))) - ;; Scope `TERM=xterm-256color' to eshell-spawned processes only by - ;; binding the env var on the eshell mode hook. The previous global - ;; `setenv' at config-time changed `process-environment' for the - ;; whole Emacs process, so every subsequent `start-process' inherited - ;; `xterm-256color' regardless of whether the receiver was a terminal - ;; that could actually interpret the escapes. - :hook - (eshell-mode . (lambda () - (setq-local process-environment - (cons "TERM=xterm-256color" - process-environment))))) +;; eshell-toggle and xterm-color are retired. F12 opens eshell now (the +;; dock-and-remember toggle in eat-config.el), and eat-eshell-mode renders +;; eshell's output through EAT, which handles ANSI color natively -- so +;; xterm-color's filter and its TERM=xterm-256color override are redundant and +;; would fight EAT's own TERM=eat-truecolor. (use-package eshell-syntax-highlighting :after esh-mode diff --git a/modules/eww-config.el b/modules/eww-config.el index 066fae989..3b0e22dcd 100644 --- a/modules/eww-config.el +++ b/modules/eww-config.el @@ -32,6 +32,8 @@ (require 'cl-lib) +(declare-function eww-add-bookmark "eww") + (defgroup my-eww-user-agent nil "EWW-only User-Agent management." :group 'eww) @@ -42,6 +44,13 @@ :type 'string :group 'my-eww-user-agent) +;; This file is lexical-binding, so `let'-binding url.el's special var below +;; needs it declared special at compile time. Without this the byte-compiled +;; advice binds `url-request-extra-headers' lexically and the injected +;; User-Agent never reaches `url-retrieve' (it reads the dynamic value) -- the +;; UA injection silently no-ops in compiled production, and the test sees nil. +(defvar url-request-extra-headers) + (defun my-eww--inject-user-agent (orig-fun &rest args) "Set a User-Agent only when making requests from an EWW buffer." (if (derived-mode-p 'eww-mode) @@ -64,6 +73,12 @@ ;; --------------------------------- EWW Config -------------------------------- +(require 'system-lib) +;; eww renders pages with shr, which paints with manual `face' properties. Left +;; in `global-font-lock-mode' font-lock overwrites them and the page loses its +;; colors, the same issue as elfeed-show and mu4e-view. Exclude eww-mode. +(cj/exclude-from-global-font-lock 'eww-mode) + (use-package eww :ensure nil ;; built-in :bind @@ -119,11 +134,8 @@ (unless (derived-mode-p 'eww-mode) (user-error "Not in EWW buffer")) (when-let ((title (plist-get eww-data :title))) - (let ((eww-bookmarks-directory (expand-file-name "eww-bookmarks" user-emacs-directory))) - (unless (file-exists-p eww-bookmarks-directory) - (make-directory eww-bookmarks-directory t)) - (eww-add-bookmark) - (message "Bookmarked: %s" title)))) + (eww-add-bookmark) + (message "Bookmarked: %s" title))) (defun cj/eww-copy-url () "Copy the current EWW URL to clipboard." diff --git a/modules/external-open-lib.el b/modules/external-open-lib.el index aa90eb67b..d6e70354f 100644 --- a/modules/external-open-lib.el +++ b/modules/external-open-lib.el @@ -12,7 +12,7 @@ ;; instead of the feature module. ;; ;; Pulled out of `external-open.el' as part of utility-consolidation -;; Phase 4. See `docs/design/utility-consolidation.org'. +;; Phase 4. See `docs/specs/utility-consolidation-spec-doing.org'. ;;; Code: diff --git a/modules/external-open.el b/modules/external-open.el index 22e56a290..811c32c28 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -42,15 +42,33 @@ "Open certain files with the OS default handler." :group 'files) -(defcustom default-open-extensions - '( - ;; Video - "\\.3g2\\'" "\\.3gp\\'" "\\.asf\\'" "\\.avi\\'" "\\.divx\\'" "\\.dv\\'" +(defcustom cj/video-extensions + '("\\.3g2\\'" "\\.3gp\\'" "\\.asf\\'" "\\.avi\\'" "\\.divx\\'" "\\.dv\\'" "\\.f4v\\'" "\\.flv\\'" "\\.m1v\\'" "\\.m2ts\\'" "\\.m2v\\'" "\\.m4v\\'" "\\.mkv\\'" "\\.mov\\'" "\\.mpe\\'" "\\.mpeg\\'" "\\.mpg\\'" "\\.mp4\\'" "\\.mts\\'" "\\.ogv\\'" "\\.rm\\'" "\\.rmvb\\'" "\\.vob\\'" - "\\.webm\\'" "\\.wmv\\'" + "\\.webm\\'" "\\.wmv\\'") + "Regexps matching video files opened in a looping player. +These route through `cj/open-video-looping' (mpv --loop-file=inf by default) +instead of the OS default handler, so a video opened from dirvish plays on +repeat." + :type '(repeat (regexp :tag "Video extension regexp")) + :group 'external-open) + +(defcustom cj/video-open-command "mpv" + "Player command used to open local video files on repeat. +Launched detached from Emacs with `cj/video-open-args' before the file name." + :type 'string + :group 'external-open) + +(defcustom cj/video-open-args '("--loop-file=inf") + "Arguments passed to `cj/video-open-command' before the file name. +Defaults to mpv's infinite single-file loop so the video plays on repeat." + :type '(repeat string) + :group 'external-open) +(defcustom default-open-extensions + '( ;; Audio "\\.aac\\'" "\\.ac3\\'" "\\.aif\\'" "\\.aifc\\'" "\\.aiff\\'" "\\.alac\\'" "\\.amr\\'" "\\.ape\\'" "\\.caf\\'" @@ -142,18 +160,49 @@ Logs output and exit code to buffer *external-open.log*." nil 0))))) +;; -------------------------- Open Videos On Repeat ---------------------------- + +(defun cj/--video-file-p (file) + "Return non-nil when FILE matches a regexp in `cj/video-extensions'." + (and (stringp file) + (let ((case-fold-search t)) + (cl-some (lambda (re) (string-match-p re file)) cj/video-extensions)))) + +(defun cj/--video-open-arglist (file) + "Return the argument list to play FILE on repeat: `cj/video-open-args' + FILE." + (append cj/video-open-args (list file))) + +(defun cj/open-video-looping (&optional filename) + "Open FILENAME (or the file at point) in a looping video player, detached. +Uses `cj/video-open-command' and `cj/video-open-args' (mpv --loop-file=inf by +default) so the video plays on repeat. Launched asynchronously so it never +blocks Emacs." + (interactive) + (let* ((file (expand-file-name + (or (cj/file-from-context filename) + (user-error "No file associated with this buffer")))) + (args (cj/--video-open-arglist file))) + (if (env-windows-p) + (w32-shell-execute "open" cj/video-open-command + (mapconcat (lambda (a) (format "\"%s\"" a)) args " ")) + (apply #'call-process cj/video-open-command nil 0 nil args)))) + ;; -------------------- Open Files With Default File Handler ------------------- (defun cj/find-file-auto (orig-fun &rest args) - "If file has an extension in `default-open-extensions', open externally. -Else call ORIG-FUN with ARGS." + "Open FILE externally based on its extension, else call ORIG-FUN with ARGS. +A video (`cj/video-extensions') opens in a looping player; any other extension +in `default-open-extensions' opens with the OS default handler." (let* ((file (car args)) (case-fold-search t)) - (if (and (stringp file) - (cl-some (lambda (re) (string-match-p re file)) - default-open-extensions)) - (cj/xdg-open file) - (apply orig-fun args)))) + (cond + ((cj/--video-file-p file) + (cj/open-video-looping file)) + ((and (stringp file) + (cl-some (lambda (re) (string-match-p re file)) + default-open-extensions)) + (cj/xdg-open file)) + (t (apply orig-fun args))))) (defun cj/external-open-install-advice () "Install the `cj/find-file-auto' advice on `find-file'. diff --git a/modules/face-diagnostic.el b/modules/face-diagnostic.el new file mode 100644 index 000000000..6f0722099 --- /dev/null +++ b/modules/face-diagnostic.el @@ -0,0 +1,474 @@ +;;; face-diagnostic.el --- Diagnose the face and font at point -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 4 (Added features). +;; Category: O (optional command). +;; Load shape: eager. +;; Eager reason: none; a diagnostic command, a command-loaded deferral candidate. +;; Top-level side effects: defines cj/face-diagnostic-mode and the +;; cj/describe-face-at-point command; binds it to C-h F in help-map. +;; Runtime requires: seq. +;; Direct test load: yes (the pure core is tested by requiring this module). +;; +;; A read-only diagnostic for "why does the character at point paint this way?" +;; It separates the face stack by source (text properties, overlays, active +;; remaps, the default) and -- in later phases -- the merged attributes, the +;; real font versus the declared family, and per-face theme/config/inherit +;; provenance. See docs/specs/face-font-diagnostic-popup-spec-implemented.org. +;; +;; This file is Phase 1: the pure read model. `cj/--face-diagnosis-at' returns +;; a plist with the buffer classification, the character context, and the face +;; stack by source. No prompts, no display -- the interactive command and the +;; rendering land in a later phase. + +;;; Code: + +(require 'seq) + +;; ------------------------------ Buffer classify ------------------------------ + +(defun cj/--face-diag-classify-buffer (&optional buffer) + "Classify BUFFER (default current) for face-diagnosis scope. +Return one of `theme-faced', `terminal-ansi', `document-shr', or +`image-no-text', from the major mode. Out-of-scope buckets get a banner and a +best-effort dump rather than a full provenance trace." + (with-current-buffer (or buffer (current-buffer)) + (cond + ((derived-mode-p 'term-mode 'comint-mode 'eshell-mode 'eat-mode) + 'terminal-ansi) + ((derived-mode-p 'eww-mode 'nov-mode 'elfeed-show-mode 'mu4e-view-mode) + 'document-shr) + ((derived-mode-p 'image-mode 'doc-view-mode 'pdf-view-mode) + 'image-no-text) + (t 'theme-faced)))) + +;; ----------------------------- Character context ----------------------------- + +(defun cj/--face-diag-char-context (pos &optional buffer) + "Return a plist for the character at POS in BUFFER, or nil when there is none. +Keys: :char (the character), :codepoint (its integer value), :name (the Unicode +name string or nil), :script (the script symbol or nil)." + (with-current-buffer (or buffer (current-buffer)) + (let ((ch (char-after pos))) + (when ch + (list :char ch + :codepoint ch + :name (get-char-code-property ch 'name) + :script (aref char-script-table ch)))))) + +;; ------------------------------- Face stack ---------------------------------- + +(defun cj/--face-diag-normalize-faces (val) + "Normalize a `face'-style property VAL into a list of faces or specs. +A face symbol or an anonymous (:attr val ...) plist becomes a one-element list; +a list of faces is returned as-is; nil becomes nil." + (cond + ((null val) nil) + ((symbolp val) (list val)) + ((keywordp (car-safe val)) (list val)) ; anonymous spec, e.g. (:foreground "red") + ((listp val) val) + (t (list val)))) + +(defun cj/--face-diag-text-property-faces (pos &optional buffer) + "Return the faces from the `face' and `font-lock-face' props at POS in BUFFER. +The two properties are concatenated in that order, each normalized to a list." + (with-current-buffer (or buffer (current-buffer)) + (let ((result '())) + (dolist (prop '(face font-lock-face)) + (setq result (append result + (cj/--face-diag-normalize-faces + (get-text-property pos prop))))) + result))) + +(defun cj/--face-diag-overlay-faces (pos &optional buffer) + "Return overlay face entries covering POS in BUFFER, highest priority first. +Each entry is a plist with :face, :priority (number or nil), and :overlay. +Overlays without a `face' property are skipped." + (with-current-buffer (or buffer (current-buffer)) + (let ((entries + (delq nil + (mapcar + (lambda (ov) + (let ((face (overlay-get ov 'face))) + (when face + (list :face face + :priority (overlay-get ov 'priority) + :overlay ov)))) + (overlays-at pos))))) + (sort entries + (lambda (a b) + (> (or (plist-get a :priority) 0) + (or (plist-get b :priority) 0))))))) + +(defun cj/--face-diag-active-remaps (faces &optional buffer) + "Return the `face-remapping-alist' entries in BUFFER that remap any of FACES. +FACES is a list of face symbols from the stack. Each result is the raw +\(FACE . SPEC) entry from the alist." + (with-current-buffer (or buffer (current-buffer)) + (seq-filter (lambda (entry) (memq (car-safe entry) faces)) + face-remapping-alist))) + +(defun cj/--face-diag-stack (pos &optional buffer) + "Return the face stack at POS in BUFFER as a plist separated by source. +Keys: :text-property (list of faces/specs), :overlays (list of plists), +:remaps (matching `face-remapping-alist' entries), :default (the symbol +`default')." + (let* ((tp (cj/--face-diag-text-property-faces pos buffer)) + (ov (cj/--face-diag-overlay-faces pos buffer)) + (stack-syms + (append (seq-filter #'symbolp tp) + (delq nil (mapcar (lambda (e) + (let ((f (plist-get e :face))) + (and (symbolp f) f))) + ov)) + '(default)))) + (list :text-property tp + :overlays ov + :remaps (cj/--face-diag-active-remaps stack-syms buffer) + :default 'default))) + +;; -------------------------- Effective merged attributes ---------------------- +;; Emacs exposes no single call for the final merged attribute plist at a +;; position (the C redisplay engine merges text-prop + overlay faces, applies +;; remaps, and picks a font). The core folds the ordered, remap-expanded spec +;; list itself and labels the result "computed": exotic relative-height or deep +;; :inherit cases may diverge slightly from the engine. + +(defconst cj/--face-diag-attributes + '(:family :height :weight :slant :foreground :background + :underline :overline :strike-through :box :inverse-video) + "Face attributes reported in the effective-merge group, in display order.") + +(defun cj/--face-diag-spec-attr (spec attr) + "Return ATTR's value from a single face SPEC, or the symbol `unspecified'. +A face symbol resolves through `face-attribute' (following :inherit); an +attribute plist is read directly; anything else is `unspecified'." + (cond + ((and spec (symbolp spec)) (face-attribute spec attr nil t)) + ((and (consp spec) (keywordp (car spec))) + (if (plist-member spec attr) (plist-get spec attr) 'unspecified)) + (t 'unspecified))) + +(defun cj/--face-diag-remap-specs (face &optional buffer) + "Return the remap specs for FACE from `face-remapping-alist' in BUFFER, or nil. +Only symbol faces are looked up. The remapping is normalized to a list of +specs: a lone face symbol or an attribute plist becomes a one-element list." + (with-current-buffer (or buffer (current-buffer)) + (when (symbolp face) + (let ((entry (assq face face-remapping-alist))) + (when entry + (let ((remap (cdr entry))) + (cond + ((null remap) nil) + ((keywordp (car-safe remap)) (list remap)) ; (:attr val ...) + ((listp remap) remap) ; (spec spec ...) + (t (list remap))))))))) ; a lone face symbol + +(defun cj/--face-diag-ordered-specs (pos &optional buffer) + "Return the ordered face specs at POS in BUFFER, highest priority first. +Overlay faces (priority descending), then text-property faces, then the +default. Each contributing face's remap specs come ahead of the face itself, +mirroring how a remap overrides its base." + (let ((bases (append (mapcar (lambda (e) (plist-get e :face)) + (cj/--face-diag-overlay-faces pos buffer)) + (cj/--face-diag-text-property-faces pos buffer) + '(default))) + (specs '())) + (dolist (face bases) + (setq specs (append specs + (cj/--face-diag-remap-specs face buffer) + (list face)))) + specs)) + +(defun cj/--face-diag-merged-attributes (pos &optional buffer) + "Return the computed effective attribute plist at POS in BUFFER. +For each attribute the first non-`unspecified' value down the ordered, +remap-expanded spec list wins; if none specifies it the value is `unspecified'." + (let ((specs (cj/--face-diag-ordered-specs pos buffer)) + (result '())) + (dolist (attr cj/--face-diag-attributes) + (let ((found (seq-some (lambda (spec) + (let ((v (cj/--face-diag-spec-attr spec attr))) + (unless (eq v 'unspecified) (list v)))) + specs))) + (setq result (append result (list attr (if found (car found) 'unspecified)))))) + result)) + +;; ------------------------------- Real font ----------------------------------- + +(defun cj/--face-diag-real-font (pos &optional buffer) + "Return a plist for the font actually used at POS in BUFFER. +Keys: :font (the font's name, or \"unavailable\") and :family (its family or +nil). `font-at' is nil in batch and on text terminals, reported as +\"unavailable\" rather than an error -- this exposes fontset substitution when +the real family differs from the merged :family." + (with-current-buffer (or buffer (current-buffer)) + (let ((font (ignore-errors (font-at pos)))) + (if (null font) + (list :font "unavailable" :family nil) + (list :font (or (ignore-errors (font-get font :name)) + (ignore-errors (aref (query-font font) 0)) + "unknown") + :family (ignore-errors (font-get font :family))))))) + +;; ------------------------------ Provenance ----------------------------------- +;; Where a named face's attributes come from: which themes set it, whether +;; config saved/customized it, its :inherit chain, and which attributes stay +;; unspecified so they fall through to the default. The theme-face and +;; saved-face properties are version-sensitive internals, read behind small +;; accessors and treated as absent rather than erroring when missing. + +(defun cj/--face-diag-face-themes (face) + "Return the themes that set FACE, newest first, from its `theme-face' property." + (when (symbolp face) + (mapcar #'car (get face 'theme-face)))) + +(defun cj/--face-diag-config-source (face) + "Return how config set FACE: `saved', `customized', or nil. +`saved' is a persisted customize (saved-face); `customized' is an unsaved +customize this session. A plain `set-face-attribute' leaves no marker and so +reads as nil." + (cond + ((get face 'saved-face) 'saved) + ((get face 'customized-face) 'customized) + (t nil))) + +(defun cj/--face-diag-inherit-chain (face) + "Return FACE's :inherit chain as a list of faces, nearest first. +Follows single-symbol :inherit links, guarding against cycles; a list-valued +:inherit is recorded and the walk stops there." + (let ((chain '()) (cur face) (seen '())) + (while (and cur (symbolp cur) (facep cur) (not (memq cur seen))) + (push cur seen) + (let ((inh (face-attribute cur :inherit nil))) + (cond + ((or (null inh) (eq inh 'unspecified)) (setq cur nil)) + ((symbolp inh) (setq chain (append chain (list inh))) (setq cur inh)) + ((listp inh) (setq chain (append chain inh)) (setq cur nil)) + (t (setq cur nil))))) + chain)) + +(defun cj/--face-diag-unspecified-attrs (face) + "Return attributes still unspecified on FACE after inherit-following. +These fall through to the default face -- the direct read on an +\"attribute never set\" bug like the all-white elfeed case." + (when (facep face) + (seq-filter (lambda (attr) + (eq (face-attribute face attr nil t) 'unspecified)) + cj/--face-diag-attributes))) + +(defun cj/--face-diag-face-provenance (face) + "Return the provenance plist for the named FACE. +Keys: :face, :themes (list), :config (`saved'/`customized'/nil), +:inherit-chain (list of faces), :unspecified (attributes falling to default)." + (list :face face + :themes (cj/--face-diag-face-themes face) + :config (cj/--face-diag-config-source face) + :inherit-chain (cj/--face-diag-inherit-chain face) + :unspecified (cj/--face-diag-unspecified-attrs face))) + +(defun cj/--face-diag-provenance (pos &optional buffer) + "Return per-face provenance for the named faces in the stack at POS in BUFFER. +A list of provenance plists for the distinct real faces contributing at POS: +text-property and overlay face symbols, then the default." + (let* ((tp (seq-filter #'symbolp (cj/--face-diag-text-property-faces pos buffer))) + (ov (delq nil (mapcar (lambda (e) + (let ((f (plist-get e :face))) + (and (symbolp f) f))) + (cj/--face-diag-overlay-faces pos buffer)))) + (faces (seq-filter #'facep (seq-uniq (append ov tp '(default)))))) + (mapcar #'cj/--face-diag-face-provenance faces))) + +;; ------------------------------- Assembled core ------------------------------ + +(defun cj/--face-diagnosis-at (pos &optional buffer) + "Return the face-diagnosis plist for POS in BUFFER (groups 0-5). +Keys: :classification (symbol), :char (plist or nil at end-of-buffer), :stack +\(plist), :attributes (computed merged plist), :font (real-font plist), +:provenance (per-face list). Pure: no prompts, no display, no buffer or frame +mutation." + (list :classification (cj/--face-diag-classify-buffer buffer) + :char (cj/--face-diag-char-context pos buffer) + :stack (cj/--face-diag-stack pos buffer) + :attributes (cj/--face-diag-merged-attributes pos buffer) + :font (cj/--face-diag-real-font pos buffer) + :provenance (cj/--face-diag-provenance pos buffer))) + +;; ------------------------------- Rendering ----------------------------------- + +(defun cj/--face-diag-face-button (face) + "Render FACE as a button that runs `describe-face' on it. +A real, named face becomes a `buttonize'd string (RET or mouse opens its +`describe-face' help); anything else -- an anonymous (:attr val ...) spec or a +symbol that is not a face -- is returned as a plain string so the report still +reads cleanly." + (let ((label (format "%s" face))) + (if (and (symbolp face) (facep face)) + (buttonize label (lambda (f) (describe-face f)) face + (format "describe-face: %s" face)) + label))) + +(defun cj/--face-diag-render-banner (classification) + "Return a one-line banner for an out-of-scope CLASSIFICATION, or \"\"." + (pcase classification + ('terminal-ansi + "NOTE: terminal buffer -- colors come from the ANSI palette, not the theme.\n\n") + ('document-shr + "NOTE: document buffer -- colors come from the rendered document, not the theme.\n\n") + ('image-no-text + "NOTE: image/no-text buffer -- little face information applies here.\n\n") + (_ ""))) + +(defun cj/--face-diag-render-char (char) + "Render the CHAR context plist as a line, or a no-character notice." + (if (null char) + "Character: none at point.\n\n" + (format "Character: %S (U+%04X %s, script: %s)\n\n" + (plist-get char :char) + (plist-get char :codepoint) + (or (plist-get char :name) "no name") + (or (plist-get char :script) "none")))) + +(defun cj/--face-diag-render-faces (faces) + "Render a list of FACES (symbols or specs) comma-separated, or \"(none)\". +Real faces render as `describe-face' buttons (see `cj/--face-diag-face-button')." + (if faces (mapconcat #'cj/--face-diag-face-button faces ", ") "(none)")) + +(defun cj/--face-diag-render-stack (stack) + "Render the STACK plist (faces by source) as a block." + (concat + "Face stack (highest priority first):\n" + (format " text properties: %s\n" + (cj/--face-diag-render-faces (plist-get stack :text-property))) + " overlays: " + (let ((ov (plist-get stack :overlays))) + (if ov + (mapconcat (lambda (e) + (concat (cj/--face-diag-face-button (plist-get e :face)) + (format " (priority %s)" + (or (plist-get e :priority) "nil")))) + ov ", ") + "(none)")) + "\n" + " active remaps: " + (let ((rm (plist-get stack :remaps))) + (if rm (mapconcat (lambda (e) (cj/--face-diag-face-button (car e))) rm ", ") + "(none)")) + "\n" + " default: default\n\n")) + +(defun cj/--face-diag-render-attributes (attrs) + "Render the merged ATTRS plist as a block." + (concat + "Effective attributes (computed):\n" + (mapconcat (lambda (attr) (format " %s: %s" attr (plist-get attrs attr))) + cj/--face-diag-attributes "\n") + "\n\n")) + +(defun cj/--face-diag-render-font (font attrs) + "Render the real FONT plist beside the merged ATTRS declared :family." + (let ((real (plist-get font :font)) + (declared (plist-get attrs :family)) + (real-family (plist-get font :family))) + (concat + (format "Real font: %s\n" real) + (format "Declared family: %s\n" declared) + (if (and (stringp real-family) (stringp declared) + (not (string-equal-ignore-case real-family declared))) + (format " (substituted: real family %s differs from declared %s)\n\n" + real-family declared) + "\n")))) + +(defun cj/--face-diag-render-provenance (prov) + "Render the per-face PROV list as a block." + (concat + "Provenance:\n" + (if prov + (mapconcat + (lambda (p) + (concat + " " + (cj/--face-diag-face-button (plist-get p :face)) + (format (concat "\n themes: %s\n config: %s\n" + " inherits: %s\n unspecified (-> default): %s") + (or (plist-get p :themes) "(none)") + (or (plist-get p :config) "(none)") + (or (plist-get p :inherit-chain) "(none)") + (or (plist-get p :unspecified) "(none)")))) + prov "\n") + " (no named faces)") + "\n")) + +(defun cj/--face-diag-render (diag) + "Render the face-diagnosis DIAG plist into a report string." + (concat + (cj/--face-diag-render-banner (plist-get diag :classification)) + (cj/--face-diag-render-char (plist-get diag :char)) + (cj/--face-diag-render-stack (plist-get diag :stack)) + (cj/--face-diag-render-attributes (plist-get diag :attributes)) + (cj/--face-diag-render-font (plist-get diag :font) (plist-get diag :attributes)) + (cj/--face-diag-render-provenance (plist-get diag :provenance)))) + +;; ------------------------------- Region mode --------------------------------- + +(defun cj/--face-diag-run-starts (beg end) + "Return the positions in [BEG, END) where the `face' property run begins." + (let ((pos beg) (starts (list beg))) + (while (and (setq pos (next-single-property-change pos 'face nil end)) + (< pos end)) + (push pos starts)) + (nreverse starts))) + +(defun cj/--face-diag-render-region (beg end) + "Render a diagnosis for each distinct face-run in [BEG, END), capped at 20." + (let* ((starts (cj/--face-diag-run-starts beg end)) + (cap 20) + (shown (seq-take starts cap))) + (concat + (mapconcat (lambda (pos) + (concat (format "=== position %d ===\n" pos) + (cj/--face-diag-render (cj/--face-diagnosis-at pos)))) + shown "\n") + (when (> (length starts) cap) + (format "\n... %d more face-runs not shown (cap %d).\n" + (- (length starts) cap) cap))))) + +;; ------------------------------- Command ------------------------------------- + +(define-derived-mode cj/face-diagnostic-mode special-mode "Face-Diag" + "Major mode for the read-only face/font diagnosis report.") + +(defun cj/--face-diag-display (report) + "Show REPORT in the read-only *Face Diagnosis* buffer; return the buffer." + (let ((buf (get-buffer-create "*Face Diagnosis*"))) + (with-current-buffer buf + (cj/face-diagnostic-mode) + (let ((inhibit-read-only t)) + (erase-buffer) + (insert report) + (goto-char (point-min)))) + (display-buffer buf) + buf)) + +(defun cj/describe-face-at-point () + "Pop up a read-only diagnosis of the face and font at point. +With an active region, diagnose each distinct face-run in the region. The +report separates the face stack by source, shows the computed merged +attributes, the real font versus the declared family, and per-face +theme/config/inherit provenance. Read-only; never mutates buffer or frame. +See docs/specs/face-font-diagnostic-popup-spec-implemented.org." + (interactive) + (cj/--face-diag-display + (if (use-region-p) + (cj/--face-diag-render-region (region-beginning) (region-end)) + (cj/--face-diag-render (cj/--face-diagnosis-at (point)))))) + +;; Bound on C-h F (Face) in the help cluster. This shadows helpful-function, +;; which also sits on C-h F here; face-diagnostic loads after help-config, so +;; this binding wins. +(keymap-set help-map "F" #'cj/describe-face-at-point) + +(provide 'face-diagnostic) +;;; face-diagnostic.el ends here diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index 5626095c5..613817444 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -6,45 +6,30 @@ ;; Layer: 2 (Core UX). ;; Category: C/P. ;; Load shape: eager. -;; Eager reason: general linting setup; spec target is hook-loaded, a deferral -;; candidate. -;; Top-level side effects: package configuration via use-package, binds into -;; cj/custom-keymap through use-package :map. +;; Eager reason: linting keymap and mode hooks; could become hook-loaded. +;; Top-level side effects: package config and C-; ? binding. ;; Runtime requires: keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; This file configures Flycheck for on-demand syntax and grammar checking. -;; - Flycheck starts automatically only in sh-mode and emacs-lisp-mode - -;; - This binds a custom helper (=cj/flycheck-list-errors=) to "C-; ?" -;; for popping up Flycheck's error list in another window. - -;; - It also customizes Checkdoc to suppress only the "sentence-end-double-space" -;; and "warn-escape" warnings. - -;; - It registers LanguageTool for comprehensive grammar checking of prose files -;; (text-mode, markdown-mode, gfm-mode, org-mode). - -;; Note: Grammar checking is on-demand only to avoid performance issues. -;; Hitting "C-; ?" runs cj/flycheck-prose-on-demand if in an org buffer. - -;; The cj/flycheck-prose-on-demand function: -;; - Turns on flycheck for the local buffer -;; - Enables LanguageTool checker -;; - Triggers an immediate check -;; - Displays errors in the *Flycheck errors* buffer - -;; Installation: -;; On Arch Linux: -;; sudo pacman -S languagetool +;; Flycheck configuration for automatic shell/Elisp linting and on-demand prose +;; grammar checks. C-; ? opens the Flycheck error list, enabling prose checking +;; first when appropriate. ;; -;; The wrapper script at scripts/languagetool-flycheck formats LanguageTool's -;; JSON output into flycheck-compatible format. It requires Python 3. +;; LanguageTool uses scripts/languagetool-flycheck to adapt JSON output to +;; Flycheck's checker protocol. ;;; Code: (require 'keybindings) ;; provides cj/custom-keymap (use-package :map below) +;; ------------------------------- Declarations -------------------------------- + +(declare-function flycheck-mode "flycheck") +(declare-function flycheck-list-errors "flycheck") +(declare-function flycheck-add-mode "flycheck") +(declare-function flycheck-buffer "flycheck") +(declare-function cj/flycheck-prose-on-demand "flycheck-config") + (defun cj/prose-helpers-on () "Ensure that `abbrev-mode' and `flycheck-mode' are on in the current buffer." (interactive) diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index 376a9dc51..b73bfdf32 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -6,48 +6,18 @@ ;; Layer: 2 (Core UX). ;; Category: C/P. ;; Load shape: eager. -;; Eager reason: text-mode spelling and abbrev hooks; spec target is hook-loaded. -;; Top-level side effects: package configuration via use-package (mode hooks). +;; Eager reason: text-mode spelling and abbrev hooks. +;; Top-level side effects: package configuration via use-package. ;; Runtime requires: cl-lib. ;; Direct test load: yes. ;; -;; WORKFLOW: -;; This module provides intelligent spell checking with automatic abbreviation -;; creation to prevent repeated misspellings. +;; On-demand Flyspell workflow with automatic abbrev creation from accepted +;; corrections. C-' checks/corrects nearby misspellings; C-c f toggles Flyspell +;; with mode-aware behavior. ;; -;; KEYBINDINGS: -;; C-' - Main spell check interface (cj/flyspell-then-abbrev) -;; C-c f - Toggle flyspell on/off (cj/flyspell-toggle) -;; M-o - Access 'other options' during correction (save to dictionary, etc.) -;; -;; SPELL CHECKING WORKFLOW: -;; 1. Press C-' to start spell checking -;; 2. Finds the nearest misspelled word above the cursor -;; 3. Prompts for correction or allows saving to personal dictionary -;; 4. Press C-' again to move to the next misspelling -;; 5. Each correction automatically creates an abbrev for future auto-expansion -;; -;; FLYSPELL ACTIVATION: -;; Flyspell is NOT automatically enabled. You activate it manually: -;; - C-c f - Toggle flyspell on (uses smart mode detection) or off -;; - C-' - Runs flyspell-buffer then starts correction workflow -;; -;; When enabled, flyspell adapts to the buffer type: -;; - Programming modes (prog-mode): Only checks comments and strings -;; - Text modes (text-mode): Checks all text -;; - Other modes: Must enable manually with C-c f -;; -;; ABBREVIATION AUTO-EXPANSION: -;; Each spell correction creates an abbrev that auto-expands the misspelling -;; to the correct spelling when you type it in the future. This significantly -;; increases typing speed over time. -;; -;; Original idea from Artur Malabarba: -;; http://endlessparentheses.com/ispell-and-abbrev-the-perfect-auto-correct.html -;; -;; NOTES: -;; The default flyspell keybinding "C-;" is unbound in this config as it's -;; used for the custom keymap (cj/custom-keymap). +;; Flyspell is not enabled globally. Programming buffers check comments/strings +;; when enabled; prose buffers check all text. The default C-; Flyspell binding +;; is intentionally left free for cj/custom-keymap. ;;; Code: diff --git a/modules/font-config.el b/modules/font-config.el index 39d21364c..7617ba01e 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -6,56 +6,26 @@ ;; Layer: 2 (Core UX). ;; Category: C/P/S. ;; Load shape: eager. -;; Eager reason: font setup for the first frame, plus font keybindings. -;; Top-level side effects: binds five global font keys, runs font-installation -;; checks, configures packages via use-package. +;; Eager reason: first-frame font setup and font keybindings. +;; Top-level side effects: font keys, font checks, package config. ;; Runtime requires: host-environment, keybindings. ;; Direct test load: yes. ;; -;; This module provides font configuration, including: -;; -;; 1. Font Management: -;; - Dynamic font preset switching via `fontaine' package -;; - Separate configurations for fixed-pitch and variable-pitch fonts -;; - Multiple size presets for different viewing contexts -;; - Per-frame font configuration tracking for daemon mode compatibility -;; -;; 2. Icon Support: -;; - All-the-icons integration with automatic font installation -;; - Nerd fonts support for enhanced icons in terminals and GUI -;; - Platform-specific emoji font configuration (Noto, Apple, Segoe) -;; - Emojify package for emoji rendering and insertion -;; -;; 3. Typography Enhancements: -;; - Programming ligatures via `ligature' package -;; - Mode-specific ligature rules for markdown and programming -;; - Text scaling keybindings for quick size adjustments -;; -;; 4. Utility Functions: -;; - `cj/font-installed-p': Check font availability -;; - `cj/display-available-fonts': Interactive font browser with samples -;; - Frame-aware font application for client/server setups -;; -;; Configuration Notes: -;; - Default preset: BerkeleyMono Nerd Font; height 120 on laptops, 140 on desktops -;; - Variable pitch: Lexend in the default preset; Merriweather for fallback presets -;; - Handles both standalone and daemon mode Emacs instances -;; - Emoji fonts selected based on OS availability -;; -;; Keybindings: -;; - M-S-f: Select font preset (fontaine-set-preset) -;; - C-z F: Display available fonts -;; - C-+/C-=: Increase text scale -;; - C--/C-_: Decrease text scale -;; - C-c E i: Insert emoji -;; - C-c E l: List emojis -;; +;; Configures fontaine presets, text scaling keys, icon/emoji fonts, and +;; programming ligatures. Presets are applied per frame so daemon clients get +;; the intended fixed/variable pitch sizes. ;; +;; Also carries font-rendering safeguards for known HarfBuzz/font-cache crashes +;; triggered by emoji and Arabic shaping in this setup. + ;;; Code: (require 'host-environment) (require 'keybindings) ;; establishes the C-z prefix used for "C-z F" below +(defvar text-scale-mode-step) +(declare-function cj/disable-emojify-mode "font-config") + ;; ---------------------- HarfBuzz Font Cache Crash Fix ----------------------- ;; Prevents Emacs from compacting font caches during GC. Without this, GC can ;; free font cache entries that HarfBuzz still references, causing SIGSEGV @@ -153,36 +123,38 @@ :italic-slant italic :line-spacing nil)))) -(with-eval-after-load 'fontaine - ;; Track which frames have had fonts applied - (defvar cj/fontaine-configured-frames nil - "List of frames that have had fontaine configuration applied.") +;; Track which frames have had fonts applied +(defvar cj/fontaine-configured-frames nil + "List of frames that have had fontaine configuration applied.") - (defun cj/apply-font-settings-to-frame (&optional frame) - "Apply font settings to FRAME if not already configured. +(declare-function fontaine-set-preset "fontaine") + +(defun cj/apply-font-settings-to-frame (&optional frame) + "Apply font settings to FRAME if not already configured. If FRAME is nil, uses the selected frame." - (let ((target-frame (or frame (selected-frame)))) - (unless (member target-frame cj/fontaine-configured-frames) - (with-selected-frame target-frame - (when (env-gui-p) - (fontaine-set-preset 'default) - (push target-frame cj/fontaine-configured-frames)))))) - - (defun cj/cleanup-frame-list (frame) - "Remove FRAME from the configured frames list when deleted." - (setq cj/fontaine-configured-frames - (delq frame cj/fontaine-configured-frames))) + (let ((target-frame (or frame (selected-frame)))) + (unless (member target-frame cj/fontaine-configured-frames) + (with-selected-frame target-frame + (when (env-gui-p) + (fontaine-set-preset 'default) + (push target-frame cj/fontaine-configured-frames)))))) + +(defun cj/cleanup-frame-list (frame) + "Remove FRAME from the configured frames list when deleted." + (setq cj/fontaine-configured-frames + (delq frame cj/fontaine-configured-frames))) +(with-eval-after-load 'fontaine ;; Handle daemon mode and regular mode (if (daemonp) - (progn - ;; Apply to each new frame in daemon mode - (add-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) - ;; Clean up deleted frames from tracking list - (add-hook 'delete-frame-functions #'cj/cleanup-frame-list)) - ;; Apply immediately in non-daemon mode - (when (env-gui-p) - (cj/apply-font-settings-to-frame)))) + (progn + ;; Apply to each new frame in daemon mode + (add-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) + ;; Clean up deleted frames from tracking list + (add-hook 'delete-frame-functions #'cj/cleanup-frame-list)) + ;; Apply immediately in non-daemon mode + (when (env-gui-p) + (cj/apply-font-settings-to-frame)))) ;; ----------------------------- Font Install Check ---------------------------- ;; convenience function to indicate whether a font is available by name. @@ -196,22 +168,23 @@ If FRAME is nil, uses the selected frame." ;; ------------------------------- All The Icons ------------------------------- ;; icons made available through fonts +(declare-function all-the-icons-install-fonts "all-the-icons") + +(defun cj/maybe-install-all-the-icons-fonts (&optional _frame) + "Install all-the-icons fonts if needed and we have a GUI." + (when (and (env-gui-p) + (not (cj/font-installed-p "all-the-icons"))) + (all-the-icons-install-fonts t) + ;; Remove this hook after successful installation + (remove-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts))) + (use-package all-the-icons :demand t :config - ;; Check for font installation after frame creation - (defun cj/maybe-install-all-the-icons-fonts (&optional _frame) - "Install all-the-icons fonts if needed and we have a GUI." - (when (and (env-gui-p) - (not (cj/font-installed-p "all-the-icons"))) - (all-the-icons-install-fonts t) - ;; Remove this hook after successful installation - (remove-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts))) - ;; Handle both daemon and non-daemon modes (if (daemonp) - (add-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts) - (cj/maybe-install-all-the-icons-fonts))) + (add-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts) + (cj/maybe-install-all-the-icons-fonts))) (use-package all-the-icons-nerd-fonts :after all-the-icons @@ -220,7 +193,6 @@ If FRAME is nil, uses the selected frame." (all-the-icons-nerd-fonts-prefer)) ;; ----------------------------- Emoji Fonts Per OS ---------------------------- -;; Set emoji fonts in priority order (first found wins) (defun cj/setup-emoji-fontset (&optional _frame) "Set emoji fonts in priority order (first found wins). @@ -262,13 +234,12 @@ the fontset repeatedly is harmless, so it can be called from (setq emojify-display-style (if (env-gui-p) 'image 'unicode)) (setq emojify-emoji-styles '(ascii unicode github)) - ;; Disable emojify in programming and gptel modes + ;; Disable emojify in programming modes (defun cj/disable-emojify-mode () "Disable emojify-mode in the current buffer." (emojify-mode -1)) - (add-hook 'prog-mode-hook #'cj/disable-emojify-mode) - (add-hook 'gptel-mode-hook #'cj/disable-emojify-mode)) + (add-hook 'prog-mode-hook #'cj/disable-emojify-mode)) ;; -------------------------- Display Available Fonts -------------------------- ;; display all available fonts on the system in a side panel diff --git a/modules/games-config.el b/modules/games-config.el index 9aa598168..0ff01c809 100644 --- a/modules/games-config.el +++ b/modules/games-config.el @@ -5,32 +5,30 @@ ;; ;; Layer: 4 (Optional). ;; Category: O. -;; Load shape: eager. -;; Eager reason: none; optional games, a command-loaded deferral candidate. -;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none. +;; Load shape: command (deferred). +;; Eager reason: none; loaded by init.el when malyon loads. +;; Top-level side effects: sets malyon-stories-directory after malyon loads. +;; Runtime requires: user-constants. ;; Direct test load: yes. ;; ;; Configuration for game packages. ;; -;; - Malyon for playing interactive fiction and text adventures in Z-machine format -;; (stories directory: ~/sync/org/text.games/) -;; - 2048 number-tile puzzle game +;; - Malyon: interactive fiction / Z-machine player (stories under ~/sync/org/text.games/). +;; - 2048: number-tile puzzle. +;; +;; malyon and 2048-game autoload their own commands via package.el, so this +;; module owns neither command -- it only supplies malyon's stories directory. +;; init.el loads it via `with-eval-after-load 'malyon', so it loads on first +;; use rather than at startup. ;; ;;; Code: -;; ----------------------------------- Malyon ---------------------------------- -;; text based adventure player +(require 'user-constants) ;; org-dir -(use-package malyon - :defer 1 - :config - (setq malyon-stories-directory (concat org-dir "text.games/"))) +(defvar malyon-stories-directory) -;; ------------------------------------ 2048 ----------------------------------- -;; combine numbered tiles to create the elusive number 2048. -(use-package 2048-game - :defer 1) +(with-eval-after-load 'malyon + (setq malyon-stories-directory (concat org-dir "text.games/"))) (provide 'games-config) ;;; games-config.el ends here. diff --git a/modules/gcmh-config.el b/modules/gcmh-config.el new file mode 100644 index 000000000..beceb1a01 --- /dev/null +++ b/modules/gcmh-config.el @@ -0,0 +1,30 @@ +;;; gcmh-config.el --- Garbage collection strategy via gcmh -*- lexical-binding: t -*- + +;;; Commentary: +;; gcmh (the Garbage Collector Magic Hack) owns `gc-cons-threshold' for the +;; session. It keeps the threshold very high while you are active so GC never +;; pauses mid-edit, then drops it and collects on idle, when a pause is +;; invisible. This replaces the old hand-rolled scheme -- a stock-800KB restore +;; in early-init.el plus a minibuffer setup/exit bump -- which pinned GC at +;; 800000 (Emacs's bare-editor default), far too low for a config this size and +;; the cause of frequent GC pauses during completion, agenda builds, and LSP/AI +;; activity. +;; +;; Kept in its own module, not system-defaults.el: that module is pre-loaded by +;; the comp-errors test harness, which has no package system, so an `:ensure' +;; package there errors at load time. early-init.el bumps the threshold to +;; `most-positive-fixnum' for startup and deliberately does not restore it; +;; `gcmh-mode' takes ownership from here on. + +;;; Code: + +(use-package gcmh + :ensure t + :demand t + :config + (setq gcmh-idle-delay 'auto ; scale the idle GC delay to GC cost + gcmh-high-cons-threshold (* 1 1024 1024 1024)) ; 1 GB during activity + (gcmh-mode 1)) + +(provide 'gcmh-config) +;;; gcmh-config.el ends here diff --git a/modules/google-keep-config.el b/modules/google-keep-config.el new file mode 100644 index 000000000..1738fa6e0 --- /dev/null +++ b/modules/google-keep-config.el @@ -0,0 +1,210 @@ +;;; google-keep-config.el --- Google Keep -> org integration -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; A read-only view of Google Keep notes as an org page. `cj/keep-refresh' +;; runs a Python gkeepapi bridge (scripts/google-keep/keep-bridge.py), parses +;; its JSON, and regenerates `keep-file' with one org header per note. Editing +;; the file does NOT sync back to Keep -- that is v2. +;; +;; The pure JSON-to-org core (the cj/keep--render* / --note-* helpers) is kept +;; free of .emacs.d specifics so it can later extract to a standalone package; +;; the IO layer and this module supply paths, auth, and keys. +;; +;; One-time setup: install the client (pip install gkeepapi), obtain a Google +;; master token, set `cj/keep-email', and store the token in authinfo.gpg as +;; machine google-keep login <you@gmail.com> password <master-token> +;; See docs/specs/google-keep-emacs-integration-spec.org. + +;;; Code: + +(require 'json) +(require 'subr-x) +(require 'system-lib) ;; cj/auth-source-secret-value, cj/executable-find-or-warn +(require 'user-constants) ;; keep-file + +;; ------------------------------ Configuration -------------------------------- + +(defgroup cj/keep nil + "Google Keep to org integration." + :group 'applications + :prefix "cj/keep-") + +(defcustom cj/keep-email nil + "Google account email for the Keep bridge, also the authinfo login. +Unset until the one-time setup is done; `cj/keep-refresh' warns when nil." + :type '(choice (const :tag "Unset" nil) string) + :group 'cj/keep) + +(defcustom cj/keep-auth-host "google-keep" + "The authinfo.gpg machine entry holding the Keep master token." + :type 'string + :group 'cj/keep) + +(defcustom cj/keep-python "python3" + "Python interpreter used to run the Keep bridge." + :type 'string + :group 'cj/keep) + +(defvar cj/keep--bridge-script + (expand-file-name "scripts/google-keep/keep-bridge.py" user-emacs-directory) + "Path to the gkeepapi bridge script.") + +(defconst cj/keep--web-base "https://keep.google.com/#NOTE/" + "Base URL for a Keep note back-link.") + +;; --------------------------- Pure core: JSON -> org -------------------------- +;; These take plain data and return strings -- no IO, no .emacs.d paths -- so +;; they unit-test directly and lift out to a package unchanged. + +(defun cj/keep--parse-json (json-string) + "Parse the bridge JSON-STRING into a list of note alists." + (json-parse-string json-string + :object-type 'alist :array-type 'list + :false-object nil :null-object nil)) + +(defun cj/keep--label-to-tag (label) + "Sanitize LABEL into a valid org tag (alphanumerics / _ / @ / # / %)." + (replace-regexp-in-string "[^[:alnum:]_@#%]" "_" label)) + +(defun cj/keep--note-tags (note) + "Return the trailing org-tag string for NOTE (labels + archived), or \"\"." + (let ((tags (append (mapcar #'cj/keep--label-to-tag (alist-get 'labels note)) + (and (alist-get 'archived note) '("archived"))))) + (if tags (concat " :" (string-join tags ":") ":") ""))) + +(defun cj/keep--note-heading (note) + "Render NOTE (an alist) as one org subtree string." + (let* ((id (alist-get 'id note)) + (title (alist-get 'title note)) + (text (alist-get 'text note)) + (heading (if (and title (> (length title) 0)) title "(untitled)"))) + (concat + "* " heading (cj/keep--note-tags note) "\n" + ":PROPERTIES:\n" + ":KEEP_ID: " (or id "") "\n" + ":PINNED: " (if (alist-get 'pinned note) "t" "nil") "\n" + ":COLOR: " (or (alist-get 'color note) "") "\n" + ":ARCHIVED: " (if (alist-get 'archived note) "t" "nil") "\n" + ":UPDATED: " (or (alist-get 'updated note) "") "\n" + ":END:\n" + (if (and id (> (length id) 0)) + (concat "[[" cj/keep--web-base id "][open in Keep]]\n") + "") + "\n" + (if (and text (> (length text) 0)) (concat text "\n") "")))) + +(defun cj/keep--sort-pinned-first (notes) + "Return NOTES with pinned ones first, original order otherwise preserved." + (let (pinned rest) + (dolist (n notes) + (if (alist-get 'pinned n) (push n pinned) (push n rest))) + (append (nreverse pinned) (nreverse rest)))) + +(defun cj/keep--render (notes &optional generated-at) + "Render NOTES (a list of alists) into the full org page string. +GENERATED-AT is an optional last-refresh timestamp string for the header." + (concat + "# Generated by cj/keep-refresh -- read-only view; edits here do NOT sync to Keep.\n" + "#+TITLE: Google Keep\n" + (if generated-at (concat "# Last refresh: " generated-at "\n") "") + "\n" + (mapconcat #'cj/keep--note-heading (cj/keep--sort-pinned-first notes) ""))) + +;; ------------------------------- IO: run + write ----------------------------- + +(defun cj/keep--write-atomically (content file) + "Write CONTENT to FILE via a temp file in FILE's directory + atomic rename." + (let ((tmp (make-temp-file + (expand-file-name (concat "." (file-name-nondirectory file) ".") + (file-name-directory file)) + nil nil content))) + (rename-file tmp file t))) + +(defun cj/keep--warn (token) + "Surface a Keep bridge failure TOKEN as a `display-warning'." + (display-warning + 'cj/keep + (pcase token + ("no-gkeepapi" "Keep bridge: gkeepapi is not installed (pip install gkeepapi).") + ("no-token" "Keep bridge: no master token in authinfo.gpg, or `cj/keep-email' is unset.") + ("auth-failed" "Keep bridge: Google rejected the credentials (token expired or revoked?).") + ("network" "Keep bridge: network error reaching Google Keep.") + (_ (format "Keep bridge failed: %s" (if (string-empty-p token) "unknown error" token)))) + :error)) + +(defun cj/keep--write-notes (json) + "Parse bridge JSON, render, and write `keep-file' atomically. +Returns the note count." + (let* ((notes (cj/keep--parse-json json)) + (org (cj/keep--render notes (format-time-string "%Y-%m-%d %H:%M")))) + (cj/keep--write-atomically org keep-file) + (length notes))) + +;;;###autoload +(defun cj/keep-refresh () + "Fetch Google Keep notes and regenerate `keep-file' (a read-only view)." + (interactive) + (let ((token (and cj/keep-email + (cj/auth-source-secret-value cj/keep-auth-host cj/keep-email)))) + (cond + ((not (file-exists-p cj/keep--bridge-script)) + (user-error "Keep bridge script not found: %s" cj/keep--bridge-script)) + ((or (not cj/keep-email) (not token)) + (cj/keep--warn "no-token")) + (t + (let* ((out (generate-new-buffer " *keep-bridge-out*")) + (err (generate-new-buffer " *keep-bridge-err*")) + (process-environment + (append (list (concat "KEEP_EMAIL=" cj/keep-email) + (concat "KEEP_MASTER_TOKEN=" token)) + process-environment))) + (message "Keep: fetching...") + (make-process + :name "keep-bridge" + :buffer out + :stderr err + :command (list cj/keep-python cj/keep--bridge-script) + :sentinel + (lambda (proc _event) + (when (memq (process-status proc) '(exit signal)) + (unwind-protect + (if (and (eq (process-status proc) 'exit) + (= (process-exit-status proc) 0)) + (let ((n (cj/keep--write-notes + (with-current-buffer out (buffer-string))))) + (message "Keep: wrote %d notes to %s" n keep-file)) + (cj/keep--warn + (string-trim (if (buffer-live-p err) + (with-current-buffer err (buffer-string)) + "")))) + (when (buffer-live-p out) (kill-buffer out)) + (when (buffer-live-p err) (kill-buffer err))))))))))) + +;;;###autoload +(defun cj/keep-open () + "Open the generated Keep org file, offering to refresh when it's absent." + (interactive) + (if (file-exists-p keep-file) + (find-file keep-file) + (if (y-or-n-p "Keep file doesn't exist yet. Refresh now? ") + (cj/keep-refresh) + (message "Run M-x cj/keep-refresh to generate it")))) + +;; --------------------------------- Glue / keys ------------------------------- + +(defvar cj/keep-prefix-map + (let ((map (make-sparse-keymap))) + (define-key map "r" #'cj/keep-refresh) + (define-key map "o" #'cj/keep-open) + map) + "Prefix keymap for Google Keep commands (bound to \\=`C-c k').") + +(keymap-global-set "C-c k" cj/keep-prefix-map) + +;; Warn at load if the interpreter is missing; gkeepapi/token failures surface +;; at refresh time via the bridge's stderr reason token. +(cj/executable-find-or-warn cj/keep-python "Google Keep bridge" 'google-keep-config) + +(provide 'google-keep-config) +;;; google-keep-config.el ends here diff --git a/modules/help-config.el b/modules/help-config.el index ce9fd8614..f8431aef2 100644 --- a/modules/help-config.el +++ b/modules/help-config.el @@ -50,24 +50,34 @@ ;; ------------------------------------ Info ----------------------------------- - (defun cj/open-with-info-mode () - "Open the current buffer's file in Info mode if it's a valid info file. +(defun cj/--info-open-plan (modified-p save-confirmed-p) + "Decide how to open a buffer in Info given its MODIFIED-P state. +SAVE-CONFIRMED-P is the answer to the save prompt, meaningful only when +MODIFIED-P. Returns `open', `save-then-open', or `cancel'." + (cond ((not modified-p) 'open) + (save-confirmed-p 'save-then-open) + (t 'cancel))) + +(defun cj/open-with-info-mode () + "Open the current buffer's file in Info mode if it's a valid info file. Preserves any unsaved changes and checks if the file exists." - (interactive) - (let ((file-name (buffer-file-name))) - (when file-name - (if (and (file-exists-p file-name) - (string-match-p "\\.info\\'" file-name)) - (progn - (when (buffer-modified-p) - (if (y-or-n-p "Buffer has unsaved changes. Save before opening in Info? ") - (save-buffer) - (message "Operation canceled") - (cl-return-from cj/open-with-info-mode))) - (kill-buffer (current-buffer)) - (info file-name)) - (message "Not a valid info file: %s" file-name))))) + (interactive) + (let ((file-name (buffer-file-name))) + (when file-name + (if (and (file-exists-p file-name) + (string-match-p "\\.info\\'" file-name)) + (let ((modified (buffer-modified-p))) + (pcase (cj/--info-open-plan + modified + (and modified + (y-or-n-p "Buffer has unsaved changes. Save before opening in Info? "))) + ('cancel (message "Operation canceled")) + (plan + (when (eq plan 'save-then-open) (save-buffer)) + (kill-buffer (current-buffer)) + (info file-name)))) + (message "Not a valid info file: %s" file-name))))) (defun cj/browse-info-files () "Browse and open .info or .info.gz files from user-emacs-directory." @@ -95,20 +105,7 @@ Preserves any unsaved changes and checks if the file exists." :bind (:map Info-mode-map ("m" . bookmark-set) ;; Rebind 'm' from Info-menu to bookmark-set - ("M" . Info-menu)) ;; Move Info-menu to 'M' instead - :preface - :init - ;; Add personal info files BEFORE Info mode initializes - ;; (let ((personal-info-dir (expand-file-name "assets/info" user-emacs-directory))) - ;; (when (file-directory-p personal-info-dir) - ;; (setq Info-directory-list (list personal-info-dir)))) - ;; the above makes the directory the info list. the below adds it to the default list - ;; (add-to-list 'Info-default-directory-list personal-info-dir))) - :hook - (info-mode . info-persist-history-mode) - :config - ;; Make .info files open with our custom function - (add-to-list 'auto-mode-alist '("\\.info\\'" . cj/open-with-info-mode))) + ("M" . Info-menu))) ;; Move Info-menu to 'M' instead (provide 'help-config) ;;; help-config.el ends here. diff --git a/modules/help-utils.el b/modules/help-utils.el index f9f5d1427..3e31efffe 100644 --- a/modules/help-utils.el +++ b/modules/help-utils.el @@ -32,6 +32,10 @@ ;; ;;; Code: +;; Lazily-loaded functions referenced below. +(declare-function devdocs-go-back "devdocs") +(declare-function devdocs-go-forward "devdocs") + ;; ---------------------------------- Devdocs ---------------------------------- (use-package devdocs diff --git a/modules/httpd-config.el b/modules/httpd-config.el index c90399425..60baf7e82 100644 --- a/modules/httpd-config.el +++ b/modules/httpd-config.el @@ -19,13 +19,13 @@ (use-package simple-httpd :defer 1 :preface - (defconst wwwdir (concat user-emacs-directory "www")) - (defun check-or-create-wwwdir () - (unless (file-exists-p wwwdir) - (make-directory wwwdir))) - :init (check-or-create-wwwdir) + (defconst cj/httpd-wwwdir (concat user-emacs-directory "www")) + (defun cj/httpd-check-or-create-wwwdir () + (unless (file-exists-p cj/httpd-wwwdir) + (make-directory cj/httpd-wwwdir))) + :init (cj/httpd-check-or-create-wwwdir) :config - (setq httpd-root wwwdir) + (setq httpd-root cj/httpd-wwwdir) (setq httpd-show-backtrace-when-error t) (setq httpd-serve-files t)) diff --git a/modules/jumper.el b/modules/jumper.el index 8941d5087..1fbd1293b 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -11,72 +11,17 @@ ;; Layer: 4 (Optional). ;; Category: O/L. ;; Load shape: eager. -;; Eager reason: none; navigation helper, a command-loaded deferral candidate. -;; Top-level side effects: defines a jumper keymap. +;; Eager reason: none; jump commands can autoload. +;; Top-level side effects: defines jumper keymap. ;; Runtime requires: cl-lib. ;; Direct test load: yes. ;; -;; Jumper provides a simple way to store and jump between locations -;; in your codebase without needing to remember register assignments. +;; Small register-backed jump list. Locations are stored in numbered registers, +;; shown through completion with file/line context, and removed explicitly when +;; no longer useful. ;; -;; PURPOSE: -;; -;; When working on large codebases, you often need to jump between -;; multiple related locations: a function definition, its tests, its -;; callers, configuration files, etc. Emacs registers are perfect for -;; this, but require you to remember which register you assigned to -;; which location. Jumper automates register management, letting you -;; focus on your work instead of bookkeeping. -;; -;; WORKFLOW: -;; -;; 1. Navigate to an important location in your code -;; 2. Press M-SPC SPC to store it (automatically assigned to register 0) -;; 3. Continue working, storing more locations as needed (registers 1-9) -;; 4. Press M-SPC j to jump back to any stored location -;; 5. Select from the list using completion (shows file, line, context) -;; 6. Press M-SPC d to remove locations you no longer need -;; -;; RECOMMENDED USAGE: -;; -;; Store locations temporarily while working on a feature: -;; - Store the main function you're implementing -;; - Store the test file where you're writing tests -;; - Store the caller that needs updating -;; - Store the documentation that needs changes -;; - Jump between them freely as you work -;; - Clear them when done with the feature -;; -;; SPECIAL BEHAVIORS: -;; -;; - Duplicate prevention: Storing the same location twice shows a message -;; instead of wasting a register slot. -;; -;; - Single location toggle: When only one location is stored, M-SPC j -;; toggles between that location and your current position. Perfect for -;; rapid back-and-forth between two related files. -;; -;; - Last location tracking: The last position before each jump is saved -;; in register 'z', allowing quick "undo" of navigation. -;; -;; - Smart selection: With multiple locations, completing-read shows -;; helpful context: "[0] filename.el:42 - function definition..." -;; -;; KEYBINDINGS: -;; -;; M-SPC SPC Store current location in next available register -;; M-SPC j Jump to a stored location (with completion) -;; M-SPC d Delete a stored location from the list -;; -;; CONFIGURATION: -;; -;; You can customize the prefix key and maximum locations: -;; -;; (setq jumper-prefix-key "C-c j") ; Change prefix key -;; (setq jumper-max-locations 20) ; Store up to 20 locations -;; -;; Note: Changing jumper-max-locations requires restarting Emacs or -;; manually reinitializing jumper--registers. +;; A single stored location toggles with the current point; each jump records the +;; previous point in register z for a quick return path. ;;; Code: @@ -106,20 +51,28 @@ Note that using M-SPC will override the default binding to just-one-space.") (line-number-at-pos) (current-column))) +(defun jumper--with-marker-at (index fn) + "Call FN with point at the marker stored for register INDEX. +Resolve register INDEX's marker; when it is a live marker, run FN in that +marker's buffer with point at the marker (within `save-current-buffer' and +`save-excursion') and return FN's value. Return nil when INDEX has no valid +marker." + (let* ((reg (aref jumper--registers index)) + (marker (get-register reg))) + (when (and marker (markerp marker) + (buffer-live-p (marker-buffer marker))) + (save-current-buffer + (set-buffer (marker-buffer marker)) + (save-excursion + (goto-char marker) + (funcall fn)))))) + (defun jumper--location-exists-p () "Check if current location is already stored." - (let ((key (jumper--location-key)) - (found nil)) - (dotimes (i jumper--next-index found) - (let* ((reg (aref jumper--registers i)) - (marker (get-register reg))) - (when (and marker (markerp marker)) - (save-current-buffer - (set-buffer (marker-buffer marker)) - (save-excursion - (goto-char marker) - (when (string= key (jumper--location-key)) - (setq found t))))))))) + (let ((key (jumper--location-key))) + (cl-loop for i from 0 below jumper--next-index + thereis (jumper--with-marker-at + i (lambda () (string= key (jumper--location-key))))))) (defun jumper--register-available-p () "Check if there are registers available." @@ -127,21 +80,39 @@ Note that using M-SPC will override the default binding to just-one-space.") (defun jumper--format-location (index) "Format location at INDEX for display." - (let* ((reg (aref jumper--registers index)) - (marker (get-register reg))) - (when (and marker (markerp marker)) - (save-current-buffer - (set-buffer (marker-buffer marker)) - (save-excursion - (goto-char marker) - (format "[%d] %s:%d - %s" - index - (buffer-name) - (line-number-at-pos) - (buffer-substring-no-properties - (line-beginning-position) - (min (+ (line-beginning-position) 40) - (line-end-position))))))))) + (jumper--with-marker-at + index + (lambda () + (format "[%d] %s:%d - %s" + index + (buffer-name) + (line-number-at-pos) + (buffer-substring-no-properties + (line-beginning-position) + (min (+ (line-beginning-position) 40) + (line-end-position))))))) + +(defun jumper--location-candidates () + "Return an alist of (DISPLAY . INDEX) for all stored locations. +Indices whose marker is no longer valid are skipped (their +`jumper--format-location' returns nil)." + (cl-loop for i from 0 below jumper--next-index + for fmt = (jumper--format-location i) + when fmt collect (cons fmt i))) + +(defun jumper--first-free-register () + "Return the lowest register char in 0..N-1 not held by a live slot. +N is `jumper-max-locations'. Only the live slice (indices 0 through +`jumper--next-index' minus 1) is consulted, so a char freed by a removal is +reused on the next store instead of colliding with a surviving slot's +register and silently overwriting its marker." + (let ((used (make-hash-table :test 'eql))) + (dotimes (i jumper--next-index) + (let ((r (aref jumper--registers i))) + (when r (puthash r t used)))) + (cl-loop for c from ?0 below (+ ?0 jumper-max-locations) + unless (gethash c used) + return c))) (defun jumper--do-store-location () "Store current location in the next free register. @@ -152,7 +123,7 @@ Returns: \\='already-exists if location is already stored, ((jumper--location-exists-p) 'already-exists) ((not (jumper--register-available-p)) 'no-space) (t - (let ((reg (+ ?0 jumper--next-index))) + (let ((reg (jumper--first-free-register))) (point-to-register reg) (aset jumper--registers jumper--next-index reg) (setq jumper--next-index (1+ jumper--next-index)) @@ -177,7 +148,13 @@ Returns: \\='no-locations if no locations stored, ;; Toggle behavior when target-idx is nil and only 1 location ((and (null target-idx) (= jumper--next-index 1)) (if (jumper--location-exists-p) - 'already-there + ;; Already at the only location: toggle back to where we came from + ;; when a last-location is recorded, otherwise report no movement. + (if (get-register jumper--last-location-register) + (progn + (jump-to-register jumper--last-location-register) + 'jumped-back) + 'already-there) (let ((reg (aref jumper--registers 0))) (point-to-register jumper--last-location-register) (jump-to-register reg) @@ -204,13 +181,12 @@ Returns: \\='no-locations if no locations stored, ((= jumper--next-index 1) (pcase (jumper--do-jump-to-location nil) ('already-there (message "You're already at the stored location")) + ('jumped-back (message "Jumped back to previous location")) ('jumped (message "Jumped to location")))) ;; Multiple locations - prompt user (t (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) + (jumper--location-candidates)) ;; Add last location if available (last-pos (get-register jumper--last-location-register)) (locations (if last-pos @@ -222,13 +198,16 @@ Returns: \\='no-locations if no locations stored, (message "Jumped to location"))))) (defun jumper--reorder-registers (removed-idx) - "Reorder registers after removing the one at REMOVED-IDX." - (when (< removed-idx (1- jumper--next-index)) - ;; Shift all higher registers down - (cl-loop for i from removed-idx below (1- jumper--next-index) - do (let ((next-reg (aref jumper--registers (1+ i)))) - (aset jumper--registers i next-reg)))) - (setq jumper--next-index (1- jumper--next-index))) + "Reorder registers after removing the one at REMOVED-IDX. +Shift the higher registers down and clear the freed register so its marker +no longer pins its buffer." + (let ((freed (aref jumper--registers removed-idx))) + (when (< removed-idx (1- jumper--next-index)) + ;; Shift all higher registers down + (cl-loop for i from removed-idx below (1- jumper--next-index) + do (aset jumper--registers i (aref jumper--registers (1+ i))))) + (setq jumper--next-index (1- jumper--next-index)) + (when freed (set-register freed nil)))) (defun jumper--do-remove-location (index) "Remove location at INDEX. @@ -248,9 +227,7 @@ Returns: \\='no-locations if no locations stored, (if (= jumper--next-index 0) (message "No locations stored") (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) + (jumper--location-candidates)) (locations (cons (cons "Cancel" -1) locations)) (choice (completing-read "Remove location: " locations nil t)) (idx (cdr (assoc choice locations)))) @@ -269,16 +246,12 @@ Returns: \\='no-locations if no locations stored, (interactive) (keymap-global-set jumper-prefix-key jumper-map)) -;; Call jumper-setup-keys when the package is loaded -(jumper-setup-keys) - -;; which-key integration -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "M-SPC" "jumper menu" - "M-SPC SPC" "store location" - "M-SPC j" "jump to location" - "M-SPC d" "remove location")) +;; Jumper's M-SPC prefix was removed 2026-06-23 so M-SPC could go to +;; `cj/ai-term-next'. A cleverer home for jumper (numbers or F-keys) is +;; pending review; until then its commands are reachable via M-x +;; (jumper-store-location / jumper-jump-to-location / jumper-remove-location). +;; To re-home: set `jumper-prefix-key' to the new prefix and call +;; `jumper-setup-keys' (and restore the which-key labels for that prefix). (provide 'jumper) ;;; jumper.el ends here. diff --git a/modules/keybindings.el b/modules/keybindings.el index db4800876..b61c3f2b3 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -35,6 +35,10 @@ (defvar-keymap cj/custom-keymap :doc "User custom prefix keymap base for nested keymaps.") (keymap-global-set "C-;" cj/custom-keymap) +;; C-; is GUI-only; terminals can't encode Control-semicolon. Mirror the same +;; keymap under C-c ; (the standard user prefix, always TTY-encodable) so the +;; whole command family works in a terminal frame with no leaf-key relearning. +(keymap-global-set "C-c ;" cj/custom-keymap) ;; ------------------------ Custom Keymap Registration ------------------------- diff --git a/modules/keyboard-compat.el b/modules/keyboard-compat.el index 914a343a6..172f96c7b 100644 --- a/modules/keyboard-compat.el +++ b/modules/keyboard-compat.el @@ -6,90 +6,18 @@ ;; Layer: 1 (Foundation). ;; Category: F/S. ;; Load shape: eager. -;; Eager reason: normalizes terminal/GUI key input so the first session's -;; keybindings resolve consistently. -;; Top-level side effects: adds `cj/keyboard-compat-terminal-setup' to -;; `emacs-startup-hook'. +;; Eager reason: normalizes terminal/GUI key input before custom bindings matter. +;; Top-level side effects: adds cj/keyboard-compat-terminal-setup to startup. ;; Runtime requires: host-environment. -;; Direct test load: yes (registers a startup hook; batch-safe). +;; Direct test load: yes. ;; -;; This module fixes keyboard input differences between terminal and GUI Emacs. +;; Normalizes Meta+Shift bindings across GUI and terminal frames. GUI frames +;; translate M-uppercase events to explicit M-S-lowercase keys; terminal frames +;; decode arrow escape sequences before key lookup so ESC O prefixes do not trip +;; M-S bindings. ;; -;; THE PROBLEM: Meta+Shift keybindings behave differently in terminal vs GUI -;; ========================================================================= -;; -;; In Emacs, there are two ways to express "Meta + Shift + o": -;; -;; 1. M-O (Meta + uppercase O) - key code 134217807 -;; 2. M-S-o (Meta + explicit Shift modifier + lowercase o) - key code 167772271 -;; -;; These are NOT the same key in Emacs! -;; -;; GUI Emacs behavior: -;; When you press Meta+Shift+o on your keyboard, GUI Emacs receives M-O -;; (uppercase O). It does NOT receive M-S-o. This is because the keyboard -;; sends Shift+o as uppercase 'O', not as a Shift modifier plus lowercase 'o'. -;; -;; Terminal Emacs behavior: -;; Terminals send escape sequences for special keys. Arrow keys send: -;; - Up: ESC O A -;; - Down: ESC O B -;; - Right: ESC O C -;; - Left: ESC O D -;; -;; The problem: ESC O is interpreted as M-O by Emacs! So if you bind M-O -;; to a function, pressing the up arrow sends "ESC O A", Emacs sees "M-O" -;; and triggers your function instead of moving up. Arrow keys break. -;; -;; THE SOLUTION: Different handling for each display type -;; ====================================================== -;; -;; For terminal mode (handled by cj/keyboard-compat-terminal-setup): -;; - Use input-decode-map to translate arrow escape sequences BEFORE -;; any keybinding lookup. ESC O A becomes [up], not M-O followed by A. -;; - Keybindings use M-S-o syntax (some terminals support explicit Shift) -;; - Disable graphical icons that show as unicode artifacts -;; -;; For GUI mode (handled by cj/keyboard-compat-gui-setup): -;; - Use key-translation-map to translate M-O to M-S-o BEFORE lookup -;; - This way, pressing Meta+Shift+o (which sends M-O) gets translated -;; to M-S-o, matching the keybinding definitions -;; - All 18 Meta+Shift keybindings work correctly -;; -;; WHY NOT JUST USE M-O FOR KEYBINDINGS? -;; ===================================== -;; -;; We could bind to M-O directly, but: -;; 1. Terminal arrow keys would break (ESC O prefix conflict) -;; 2. We'd need to maintain two sets of bindings (M-O for GUI, something -;; else for terminal) -;; -;; By using M-S-o syntax everywhere and translating M-O -> M-S-o in GUI mode, -;; we have one consistent set of keybindings that work everywhere. -;; -;; KEYBINDINGS AFFECTED: -;; ==================== -;; -;; The following M-S- keybindings are translated from M-uppercase in GUI: -;; -;; M-O -> M-S-o cj/kill-other-window (undead-buffers.el) -;; M-M -> M-S-m cj/kill-all-other-buffers-and-windows (undead-buffers.el) -;; M-Y -> M-S-y yank-media (keybindings.el) -;; M-F -> M-S-f fontaine-set-preset (font-config.el) -;; M-W -> M-S-w wttrin (weather-config.el) -;; M-E -> M-S-e eww (eww-config.el) -;; M-L -> M-S-l cj/switch-themes (ui-theme.el) -;; M-R -> M-S-r cj/elfeed-open (elfeed-config.el) -;; M-V -> M-S-v cj/split-and-follow-right (ui-navigation.el) -;; M-H -> M-S-h cj/split-and-follow-below (ui-navigation.el) -;; M-T -> M-S-t toggle-window-split (ui-navigation.el) -;; M-Z -> M-S-z cj/undo-kill-buffer (ui-navigation.el) -;; M-U -> M-S-u winner-undo (ui-navigation.el) -;; M-D -> M-S-d dwim-shell-commands-menu (dwim-shell-config.el) -;; M-I -> M-S-i edit-indirect-region (text-config.el) -;; M-C -> M-S-c time-zones (chrono-tools.el) -;; M-B -> M-S-b calibredb (calibredb-epub-config.el) -;; M-K -> M-S-k show-kill-ring (show-kill-ring.el) +;; Also provides terminal-specific display fallbacks, such as hiding icon glyphs +;; that render poorly outside GUI frames. ;;; Code: diff --git a/modules/latex-config.el b/modules/latex-config.el index 0db21f2f2..f2a586704 100644 --- a/modules/latex-config.el +++ b/modules/latex-config.el @@ -63,7 +63,10 @@ single entry." :ensure auctex :defer t :hook - (TeX-mode-hook . (lambda () (setq TeX-command-default "latexmk"))) ; use latexmk by default + ;; Name the mode, not the hook: use-package appends "-hook" to any symbol not + ;; ending in "-mode", so `TeX-mode' becomes `TeX-mode-hook' while the literal + ;; `TeX-mode-hook' would expand to the unbound `TeX-mode-hook-hook'. + (TeX-mode . (lambda () (setq TeX-command-default "latexmk"))) ; use latexmk by default (LaTeX-mode . (lambda () (TeX-fold-mode 1))) ; automatically activate TeX-fold-mode. (LaTeX-mode . flyspell-mode) ; turn on flyspell-mode by default (LaTeX-mode . TeX-PDF-mode) @@ -78,7 +81,9 @@ single entry." (setq-default TeX-master t)) ; Assume the file is the master file itself (use-package auctex-latexmk - :defer t + ;; Load with AUCTeX, not deferred: `:defer t' has no autoload trigger here, so + ;; `auctex-latexmk-setup' never runs and "latexmk" never joins TeX-command-list. + :after tex :config (auctex-latexmk-setup) (setq auctex-latexmk-inherit-TeX-PDF-mode t)) diff --git a/modules/ledger-config.el b/modules/ledger-config.el index c268fa368..018601043 100644 --- a/modules/ledger-config.el +++ b/modules/ledger-config.el @@ -2,6 +2,24 @@ ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: +;; Editing support for ledger-format plain-text accounting files: ledger-mode, +;; flycheck linting, company completion, clean-on-save, and a small report set. +;; The reports and reconcile shell out to the `ledger' CLI; a load-time check +;; warns when it is missing rather than letting a report fail cryptically. + +;;; Code: + +;; ------------------------------- Declarations -------------------------------- + +(declare-function ledger-mode-clean-buffer "ledger-mode") +(declare-function cj/executable-find-or-warn "system-lib") +(defvar ledger-mode-map) +(defvar company-backends) + +(defcustom cj/ledger-clean-on-save t + "When non-nil, tidy a ledger buffer with `ledger-mode-clean-buffer' before save." + :type 'boolean + :group 'ledger) ;; -------------------------------- Ledger Mode -------------------------------- ;; edit files in ledger format @@ -11,35 +29,38 @@ "\\.ledger\\'" "\\.journal\\'") :preface - (defun cj/ledger-save () - "Automatically clean the ledger buffer at each save." - (interactive) - (save-excursion - (when (buffer-modified-p) - (with-demoted-errors (ledger-mode-clean-buffer)) - (save-buffer)))) - :bind - (:map ledger-mode-map - ("C-x C-s" . cj/ledger-save)) + (defun cj/ledger--clean-before-save () + "Tidy the ledger buffer before save when `cj/ledger-clean-on-save' is set. +Errors are demoted so a malformed buffer still saves." + (when cj/ledger-clean-on-save + (with-demoted-errors "Error cleaning ledger buffer: %S" + (ledger-mode-clean-buffer)))) + (defun cj/ledger--enable-clean-on-save () + "Install the clean-on-save hook buffer-locally so it fires on every save path." + (add-hook 'before-save-hook #'cj/ledger--clean-before-save nil t)) + :hook (ledger-mode . cj/ledger--enable-clean-on-save) :custom (ledger-clear-whole-transactions t) (ledger-reconcile-default-commodity "$") (ledger-report-use-header-line nil) + (ledger-highlight-xact-under-point t) (ledger-reports '(("bal" "%(binary) --strict -f %(ledger-file) bal") ("bal this month" "%(binary) --strict -f %(ledger-file) bal -p %(month) -S amount") ("bal this year" "%(binary) --strict -f %(ledger-file) bal -p 'this year'") ("net worth" "%(binary) --strict -f %(ledger-file) bal Assets Liabilities") - ("account" "%(binary) --strict -f %(ledger-file) reg %(account)")))) + ("account" "%(binary) --strict -f %(ledger-file) reg %(account)"))) + :config + (cj/executable-find-or-warn "ledger" 'ledger-mode)) ;; ------------------------------ Flycheck Ledger ------------------------------ -;; syntax and unbalanced transaction linting +;; syntax and unbalanced-transaction linting (use-package flycheck-ledger :after ledger-mode) ;; ------------------------------- Company Ledger ------------------------------ -;; autocompletion for ledger +;; account/payee autocompletion for ledger (use-package company-ledger :after (company ledger-mode) diff --git a/modules/linear-config.el b/modules/linear-config.el deleted file mode 100644 index 8fbae30c7..000000000 --- a/modules/linear-config.el +++ /dev/null @@ -1,58 +0,0 @@ -;;; linear-config.el --- Linear.app integration -*- lexical-binding: t; -*- -;; author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; -;; Layer: 3 (Domain Workflow). -;; Category: D/P. -;; Load shape: deferred (command-loaded). -;; Top-level side effects: package configuration via use-package. -;; Runtime requires: none. -;; Direct test load: no. -;; -;; Near-vanilla pearl setup: close to what pearl's README documents for a -;; first-time install (local checkout instead of a package archive), with two -;; deliberate tweaks layered on after dogfooding the out-of-box experience — a -;; global C-; L prefix (see below) and the shorter assignee @-tag. -;; -;; pearl owns its own keymap. `pearl-mode' turns on automatically in any buffer -;; pearl renders (it carries a `#+LINEAR-SOURCE' header) and binds the whole -;; command surface under `pearl-keymap-prefix' (default "C-; L"). This config -;; also binds that same `pearl-prefix-map' globally under C-; L (`:bind-keymap'), -;; so the full command surface is reachable from any buffer; the first press -;; autoloads pearl. `M-x pearl-menu' / `M-x pearl-list-issues' still work too. -;; -;; Authentication: the Linear personal API key is read from authinfo.gpg. Add: -;; machine api.linear.app login apikey password lin_api_YOURKEYHERE -;; Generate it in Linear: Settings -> Security & access -> Personal API keys. - -;;; Code: - -(use-package pearl - :ensure nil ;; local checkout, not from an archive - :load-path "~/code/pearl" - :commands (pearl-menu pearl-list-issues pearl-create-issue pearl-run-linear-view) - ;; Bind pearl's command map globally under C-; L, so the full surface is - ;; reachable from any buffer (not only inside a pearl-rendered one). The - ;; first press autoloads pearl; it's the same `pearl-prefix-map' that - ;; `pearl-mode' binds in-buffer, so behavior is identical everywhere. - :bind-keymap ("C-; L" . pearl-prefix-map) - :custom - (pearl-org-file-path (expand-file-name "gtd/linear.org" org-directory)) - ;; Shorten the assignee @-tag to the first name only (e.g. @first instead of - ;; @first_last), trading disambiguation for a tighter tag line. - (pearl-assignee-tag-short t) - ;; Optional defaults — uncomment and fill in to skip the prompts. Set them - ;; HERE, at init level, not via M-x pearl-set-default-view / - ;; pearl-set-default-team: those persist through `customize-save-variable', - ;; and this config redirects `custom-file' to a throwaway temp file - ;; (system-defaults.el), so a setter's value is discarded on the next - ;; restart. These :custom lines re-apply on every startup instead. - ;; (pearl-default-view "My active work") ;; the local view `C-; L l' opens - ;; (pearl-default-team-id "9fca2cf6-390c-4102-a9ff-f94a4ed823c5") ;; DeepSat SE; skips the team prompt on create / by-project - :config - (setq pearl-api-key - (auth-source-pick-first-password :host "api.linear.app"))) - -(provide 'linear-config) -;;; linear-config.el ends here diff --git a/modules/local-repository.el b/modules/local-repository.el index b97b74f41..a9df09d38 100644 --- a/modules/local-repository.el +++ b/modules/local-repository.el @@ -1,4 +1,4 @@ -;;; local-repository.el --- local repository functionality -*- lexical-binding: t; coding: utf-8; -*- +;;; local-repository.el --- Local package archive helpers -*- lexical-binding: t; coding: utf-8; -*- ;; author Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -6,16 +6,21 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; local package-mirror workflow, a command-loaded deferral -;; candidate. +;; Eager reason: none; local package mirror commands can autoload. ;; Top-level side effects: none. -;; Runtime requires: elpa-mirror. +;; Runtime requires: elpa-mirror when updating the mirror. ;; Direct test load: yes. ;; +;; Adds the checked-in local package archive to package-archives with high +;; priority, and provides a command to refresh that archive from installed +;; packages via elpa-mirror. + ;;; Code: (require 'elpa-mirror nil t) ;; optional; cj/update-localrepo-repository fails at call-time if absent +(declare-function elpamr-create-mirror-for-installed "elpa-mirror") + ;; ------------------------------ Utility Function ----------------------------- @@ -25,23 +30,33 @@ ;; ------------------------------- Customizations ------------------------------ +(defgroup localrepo nil + "Local last-known-good package repository." + :group 'package) + (defcustom localrepo-repository-id "localrepo" "The name used to identify the local repository internally. -Used for the package-archive and package-archive-priorities lists.") +Used for the package-archive and package-archive-priorities lists." + :type 'string + :group 'localrepo) (defcustom localrepo-repository-priority 100 "The value for the local repository in the package-archive-priority list. A higher value means higher priority. If you want your local packages to be -preferred, this must be a higher number than any other repositories.") +preferred, this must be a higher number than any other repositories." + :type 'integer + :group 'localrepo) (defcustom localrepo-repository-location (concat user-emacs-directory "/.localrepo") "The location of the local repository. It's a good idea to keep this with the rest of your configuration files and -keep them in source control.") +keep them in source control." + :type 'directory + :group 'localrepo) (defun cj/update-localrepo-repository () "Update the local repository with currently installed packages." diff --git a/modules/mail-config.el b/modules/mail-config.el index f71d6eeb5..1d8a98c97 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -48,6 +48,56 @@ (defvar message-send-mail-function nil) (defvar message-sendmail-envelope-from nil) +(declare-function mu4e-message-field "mu4e-message") + +;; ----------------------------- Declarations ---------------------------------- +;; mu4e/org-msg load lazily, so the byte-compiler can't see these package +;; functions and variables when this module is compiled standalone. Declare +;; them to silence free-variable / undefined-function warnings without forcing +;; an eager require (which would defeat lazy loading). The cj/... entries are +;; forward references: defined later in this file's `:config' block, or in +;; mu4e-org-contacts-integration (required at load time inside that block). + +(declare-function mu4e-headers-mark-for-each-if "mu4e-mark") +(declare-function mu4e-search "mu4e-search") +(declare-function mu4e-view-refresh "mu4e-view") +(declare-function message-add-header "message") +(declare-function org-msg-edit-mode "org-msg") +(declare-function no-auto-fill "mail-config") +(declare-function cj/disable-company-in-mu4e-compose "mail-config") +(declare-function cj/disable-ispell-in-email-headers "mail-config") +(declare-function cj/activate-mu4e-org-contacts-integration + "mu4e-org-contacts-integration") + +;; Package variables assigned in the lazy `:config' blocks below. +(defvar mu4e-compose-keep-self-cc) +(defvar mu4e-root-maildir) +(defvar mu4e-show-images) +(defvar org-msg-extra-css) + +;; Refile (archive) target dispatch. A per-context `mu4e-refile-folder' string +;; is unsafe: mu4e context :vars are sticky, so a value set when one context is +;; active leaks into a later context that doesn't set its own -- archiving one +;; account's mail into another's folder. A single function evaluated per +;; message at refile time avoids that. Only cmail has a real synced Archive +;; folder; the Gmail-backed accounts (gmail, dmail) sync no archive maildir, so +;; refiling them would move mail into an unsynced, server-invisible folder +;; (silent loss) -- signal instead. +(defun cj/mu4e--refile-folder-for-maildir (maildir) + "Return the refile (archive) folder for MAILDIR, or signal when none exists. +MAILDIR is a mu4e :maildir string such as \"/cmail/INBOX\"." + (cond + ((not (stringp maildir)) + (user-error "Cannot refile: message has no maildir")) + ((string-prefix-p "/cmail" maildir) "/cmail/Archive") + (t + (user-error "No archive folder syncs for this account; refile disabled to avoid moving mail into an unsynced folder")))) + +(defun cj/mu4e--refile-folder (msg) + "Refile-folder function for `mu4e-refile-folder'. +Dispatch on MSG's maildir via `cj/mu4e--refile-folder-for-maildir'." + (cj/mu4e--refile-folder-for-maildir (and msg (mu4e-message-field msg :maildir)))) + (defcustom cj/smtpmail-debug-enabled nil "Non-nil means enable verbose SMTP transport debug logging. @@ -136,6 +186,12 @@ Prompts user for the action when executing." (display-buffer-reuse-window display-buffer-same-window) (inhibit-same-window . nil))) +;; Keep global font-lock out of the mu4e buffers. mu4e paints header lines, the +;; main menu, and view headers with manual `face' text properties; global +;; font-lock strips them (the same failure the dashboard hit), leaving the +;; buffers unthemed. Excluding these modes keeps mu4e's faces. +(cj/exclude-from-global-font-lock 'mu4e-headers-mode 'mu4e-main-mode 'mu4e-view-mode) + (use-package mu4e :ensure nil ;; mu4e gets installed by installing 'mu' via the system package manager :load-path "/usr/share/emacs/site-lisp/mu4e/" @@ -166,12 +222,16 @@ Prompts user for the action when executing." ;; (setq mu4e-compose-format-flowed t) ;; plain text mails must flow correctly for recipients (setq mu4e-compose-keep-self-cc t) ;; keep me in the cc list - (setq mu4e-compose-signature-auto-include nil) ;; don't include signature by default + (with-suppressed-warnings ((obsolete mu4e-compose-signature-auto-include) + (free-vars mu4e-compose-signature-auto-include)) + (setq mu4e-compose-signature-auto-include nil)) ;; don't include signature by default (setq mu4e-confirm-quit nil) ;; don't ask when quitting (setq mu4e-context-policy 'pick-first) ;; start with the first (default) context (setq mu4e-headers-auto-update nil) ;; updating headers buffer on email is too jarring (setq mu4e-root-maildir mail-dir) ;; root directory for all email accounts - (setq mu4e-maildir mail-dir) ;; same as above (for newer mu4e) + (with-suppressed-warnings ((obsolete mu4e-maildir) + (free-vars mu4e-maildir)) + (setq mu4e-maildir mail-dir)) ;; same as above (for newer mu4e) (setq mu4e-sent-messages-behavior 'delete) ;; don't save to "Sent", IMAP does this already (setq mu4e-show-images t) ;; show embedded images ;; (setq mu4e-update-interval 600) ;; check for new mail every 10 minutes (600 seconds) @@ -183,12 +243,16 @@ Prompts user for the action when executing." ;; This will be automatically disabled when org-msg is active (setq mu4e-compose-format-flowed t) - (setq mu4e-html2text-command 'mu4e-shr2text) ;; email conversion to html via shr2text + (with-suppressed-warnings ((obsolete mu4e-html2text-command) + (free-vars mu4e-html2text-command)) + (setq mu4e-html2text-command 'mu4e-shr2text)) ;; email conversion to html via shr2text (setq mu4e-mu-binary (executable-find "mu")) (setq mu4e-get-mail-command (cj/mail--mbsync-command)) ;; command to sync mail - (setq mu4e-user-mail-address-list '("c@cjennings.net" - "craigmartinjennings@gmail.com" - "craig.jennings@deepsat.com")) + (with-suppressed-warnings ((obsolete mu4e-user-mail-address-list) + (free-vars mu4e-user-mail-address-list)) + (setq mu4e-user-mail-address-list '("c@cjennings.net" + "craigmartinjennings@gmail.com" + "craig.jennings@deepsat.com"))) (setq mu4e-index-update-error-warning nil) ;; don't warn me about spurious sync issues ;; ------------------------------ Mu4e Contexts ------------------------------ @@ -217,7 +281,8 @@ Prompts user for the action when executing." :vars '((user-mail-address . "c@cjennings.net") (user-full-name . "Craig Jennings") (mu4e-drafts-folder . "/cmail/Drafts") - (mu4e-sent-folder . "/cmail/Sent"))) + (mu4e-sent-folder . "/cmail/Sent") + (mu4e-trash-folder . "/cmail/Trash"))) (make-mu4e-context :name "deepsat.com" @@ -232,6 +297,12 @@ Prompts user for the action when executing." (mu4e-starred-folder . "/dmail/Starred") (mu4e-trash-folder . "/dmail/Trash"))))) + ;; Refile target is computed per message (see `cj/mu4e--refile-folder'), not + ;; set per context, because mu4e context :vars are sticky and would leak one + ;; account's archive folder into another. cmail archives to /cmail/Archive; + ;; gmail/dmail signal rather than move mail into an unsynced folder. + (setq mu4e-refile-folder #'cj/mu4e--refile-folder) + (setq mu4e-maildir-shortcuts '(("/cmail/Inbox" . ?i) ("/cmail/Sent" . ?s) @@ -257,7 +328,7 @@ Prompts user for the action when executing." :key ?d))) (defun no-auto-fill () - "Turn off \'auto-fill-mode\'." + "Turn off `auto-fill-mode'." (auto-fill-mode -1)) (add-hook 'mu4e-compose-mode-hook #'no-auto-fill) @@ -279,19 +350,23 @@ Prompts user for the action when executing." ;; also see org-msg below ;; Prefer HTML over plain text when both are available - (setq mu4e-view-prefer-html t) + (with-suppressed-warnings ((obsolete mu4e-view-prefer-html) + (free-vars mu4e-view-prefer-html)) + (setq mu4e-view-prefer-html t)) ;; Use a better HTML renderer with more control - (setq mu4e-html2text-command - (cond - ;; Best option: pandoc (if available) - ((executable-find "pandoc") - "pandoc -f html -t plain --reference-links") - ;; Good option: w3m (better tables/formatting) - ((executable-find "w3m") - "w3m -dump -T text/html -cols 72 -o display_link_number=true") - ;; Fallback: built-in shr - (t 'mu4e-shr2text))) + (with-suppressed-warnings ((obsolete mu4e-html2text-command) + (free-vars mu4e-html2text-command)) + (setq mu4e-html2text-command + (cond + ;; Best option: pandoc (if available) + ((executable-find "pandoc") + "pandoc -f html -t plain --reference-links") + ;; Good option: w3m (better tables/formatting) + ((executable-find "w3m") + "w3m -dump -T text/html -cols 72 -o display_link_number=true") + ;; Fallback: built-in shr + (t 'mu4e-shr2text)))) ;; Configure shr (built-in HTML renderer) for better display (setq shr-use-colors nil) ; Don't use colors in terminal @@ -301,8 +376,10 @@ Prompts user for the action when executing." (setq shr-bullet "• ") ; Nice bullet points ;; Block remote images by default (privacy/security) - (setq mu4e-view-show-images t) - (setq mu4e-view-image-max-width 800) + (with-suppressed-warnings ((obsolete mu4e-view-show-images mu4e-view-image-max-width) + (free-vars mu4e-view-show-images mu4e-view-image-max-width)) + (setq mu4e-view-show-images t) + (setq mu4e-view-image-max-width 800)) ;; ------------------------------- View Actions ------------------------------ ;; define view and article menus @@ -379,6 +456,34 @@ Prompts user for the action when executing." (cj/activate-mu4e-org-contacts-integration)) ;; end use-package mu4e +;; ----------------------- Account Navigation Keymaps -------------------------- +;; The C-; e c/d/g submaps jump to each account's inbox views. Built from one +;; template so the maildir prefix is the only per-account difference. + +;; eval-and-compile so the builder is defined when org-msg's :preface (below) +;; calls it during byte-compilation, not only at load. +(eval-and-compile + (defun cj/--mail-account-search-queries (account) + "Return an alist of (KEY . QUERY) mu4e searches for ACCOUNT's inbox. +ACCOUNT is the maildir account name (\"cmail\", \"dmail\", \"gmail\"). The four +entries scope inbox / unread / flagged / large searches to that account's +INBOX maildir." + (let ((base (format "maildir:/%s/INBOX" account))) + (list (cons "i" base) + (cons "u" (concat base " AND flag:unread AND NOT flag:trashed")) + (cons "s" (concat base " AND flag:flagged")) + (cons "l" (concat base " AND size:5M..999M"))))) + + (defun cj/--mail-make-account-map (account) + "Build a mu4e navigation keymap for ACCOUNT (a maildir account name). +Keys i/u/s/l run the inbox/unread/flagged/large searches from +`cj/--mail-account-search-queries', each scoped to ACCOUNT." + (let ((map (make-sparse-keymap))) + (dolist (entry (cj/--mail-account-search-queries account) map) + (let ((query (cdr entry))) + (keymap-set map (car entry) + (lambda () (interactive) (mu4e-search query)))))))) + ;; ---------------------------------- Org-Msg ---------------------------------- ;; user composes org mode; recipient receives html @@ -387,24 +492,12 @@ Prompts user for the action when executing." :defer 1 :after (org mu4e) :preface - (defvar-keymap cj/mail-cmail-map - :doc "cmail account navigation" - "i" (lambda () (interactive) (mu4e-search "maildir:/cmail/INBOX")) - "u" (lambda () (interactive) (mu4e-search "maildir:/cmail/INBOX AND flag:unread AND NOT flag:trashed")) - "s" (lambda () (interactive) (mu4e-search "maildir:/cmail/INBOX AND flag:flagged")) - "l" (lambda () (interactive) (mu4e-search "maildir:/cmail/INBOX AND size:5M..999M"))) - (defvar-keymap cj/mail-dmail-map - :doc "deepsat account navigation" - "i" (lambda () (interactive) (mu4e-search "maildir:/dmail/INBOX")) - "u" (lambda () (interactive) (mu4e-search "maildir:/dmail/INBOX AND flag:unread AND NOT flag:trashed")) - "s" (lambda () (interactive) (mu4e-search "maildir:/dmail/INBOX AND flag:flagged")) - "l" (lambda () (interactive) (mu4e-search "maildir:/dmail/INBOX AND size:5M..999M"))) - (defvar-keymap cj/mail-gmail-map - :doc "gmail account navigation" - "i" (lambda () (interactive) (mu4e-search "maildir:/gmail/INBOX")) - "u" (lambda () (interactive) (mu4e-search "maildir:/gmail/INBOX AND flag:unread AND NOT flag:trashed")) - "s" (lambda () (interactive) (mu4e-search "maildir:/gmail/INBOX AND flag:flagged")) - "l" (lambda () (interactive) (mu4e-search "maildir:/gmail/INBOX AND size:5M..999M"))) + (defvar cj/mail-cmail-map (cj/--mail-make-account-map "cmail") + "cmail account navigation.") + (defvar cj/mail-dmail-map (cj/--mail-make-account-map "dmail") + "deepsat account navigation.") + (defvar cj/mail-gmail-map (cj/--mail-make-account-map "gmail") + "gmail account navigation.") (defvar-keymap cj/email-map :doc "Email operations and account navigation" "A" #'org-msg-attach-attach diff --git a/modules/markdown-config.el b/modules/markdown-config.el index 4faa4474e..424c09cc8 100644 --- a/modules/markdown-config.el +++ b/modules/markdown-config.el @@ -20,14 +20,13 @@ :mode (("README\\.md\\'" . gfm-mode) ("\\.md\\'" . markdown-mode) ("\\.markdown\\'" . markdown-mode)) - :bind (:map markdown-mode-map - ("<f2>" . markdown-preview)) ;; use same key as compile for consistency :init (setq markdown-command "multimarkdown")) ;; Register markdown as a known org-src-block language so `org-lint' ;; stops warning on `#+begin_src markdown ... #+end_src' and `C-c '' ;; inside such a block opens it in `markdown-mode' instead of falling ;; back to fundamental-mode. +(defvar org-src-lang-modes) (with-eval-after-load 'org (add-to-list 'org-src-lang-modes '("markdown" . markdown))) @@ -36,12 +35,12 @@ ;; allows for live previews of your html ;; see: https://github.com/skeeto/impatient-mode (use-package impatient-mode - :defer t - :config - (setq imp-set-user-filter 'markdown-html)) + :defer t) ;;;; --------------------- WIP: Markdown-Preview --------------------- +(declare-function imp--notify-clients "impatient-mode") + (defun cj/markdown-preview-server-start () "Start the simple-httpd listener that serves the live markdown preview. Idempotent: re-running while the server is already up is a no-op." @@ -51,14 +50,14 @@ Idempotent: re-running while the server is already up is a no-op." (message "markdown preview server running on http://localhost:8080/imp")) ;; the filter to apply to markdown before impatient-mode pushes it to the server -(defun markdown-preview () +(defun cj/markdown-preview () "Open the current buffer as a live HTML preview at http://localhost:8080/imp. The simple-httpd listener must already be running -- see `cj/markdown-preview-server-start'. Starting a network listener as a side effect of opening a preview is surprising, so the server start lives in a separate command." (interactive) - (unless (and (boundp 'httpd-process) httpd-process) + (unless (httpd-running-p) (user-error "markdown preview server not running; run `M-x cj/markdown-preview-server-start' first")) (impatient-mode 1) (setq imp-user-filter #'cj/markdown-html) @@ -77,5 +76,12 @@ lives in a separate command." (buffer-substring-no-properties (point-min) (point-max)))) (current-buffer))) +;; Bind the preview key after the defun so use-package's `:bind' autoload +;; stub doesn't collide with this file's own definition of the command +;; (that collision is the "defined multiple times" byte-compile warning). +;; Same key as compile, for consistency. +(with-eval-after-load 'markdown-mode + (keymap-set markdown-mode-map "<f2>" #'cj/markdown-preview)) + (provide 'markdown-config) ;;; markdown-config.el ends here diff --git a/modules/media-utils.el b/modules/media-utils.el index 685530d89..1abbc1b2b 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -86,9 +86,11 @@ strings." :value-type sexp)) :group 'media) -(defcustom cj/default-media-player 'vlc +(defcustom cj/default-media-player 'mpv "The default media player to use for videos. -Should be a key from `cj/media-players'." +Should be a key from `cj/media-players'. mpv is the default because it +resolves streaming-site URLs itself via yt-dlp, so it needs no pre-extracted +stream URL (see the :needs-stream-url flag in `cj/media-players')." :type 'symbol :group 'media) diff --git a/modules/modeline-config.el b/modules/modeline-config.el index 0e6e5d0fb..61dcb69c6 100644 --- a/modules/modeline-config.el +++ b/modules/modeline-config.el @@ -15,7 +15,6 @@ ;; No external packages = no buffer issues, no native-comp errors. ;; Features: -;; - Buffer status (modified, read-only) ;; - Buffer name ;; - Major mode ;; - Version control status @@ -72,30 +71,29 @@ Example: `my-very-long-name.el' → `my-ver...me.el'" (concat (substring str 0 half) "..." (substring str (- half)))) str)) +(defun cj/--modeline-click-map (mouse-1 &optional mouse-3) + "Return a mode-line `local-map' binding mouse clicks to commands. +\[mode-line mouse-1] runs MOUSE-1; when MOUSE-3 is non-nil, [mode-line mouse-3] +runs it too. Shared builder for the clickable modeline segments." + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] mouse-1) + (when mouse-3 + (define-key map [mode-line mouse-3] mouse-3)) + map)) + ;; -------------------------- Modeline Segments -------------------------------- (defvar-local cj/modeline-buffer-name - '(:eval (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - (color (alist-get state cj/buffer-status-colors)) - (name (buffer-name)) + '(:eval (let* ((name (buffer-name)) (truncated-name (cj/modeline-string-cut-middle name))) (propertize truncated-name - 'face `(:foreground ,color) 'mouse-face 'mode-line-highlight 'help-echo (concat name "\n" (or (buffer-file-name) (format "No file. Directory: %s" default-directory))) - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] 'previous-buffer) - (define-key map [mode-line mouse-3] 'next-buffer) - map)))) - "Buffer name colored by modification and read-only status. -White = unmodified, Green = modified, Red = read-only, Gold = overwrite. + 'local-map (cj/--modeline-click-map 'previous-buffer 'next-buffer)))) + "Buffer name in the mode line. Truncates in narrow windows. Click to switch buffers.") (defvar-local cj/modeline-position @@ -137,12 +135,12 @@ Uses built-in cached values for performance.") cj/modeline-vc-cache-set-p nil)) (defun cj/modeline-vc-cache-key (file) - "Return the cache key for FILE. -Includes the resolved `file-truename' so that if FILE is a symlink whose -target moves to a different VC tree, the key changes and the cache is not -served a stale backend. The extra `file-truename' is one stat per refresh, -cheap next to the VC calls the cache avoids." - (list file (file-truename file) cj/modeline-vc-show-remote)) + "Return the cache key for FILE: the file path and `cj/modeline-vc-show-remote'. +`file-truename' is deliberately omitted -- the mode-line rebuilds this key on +every render to check cache validity, so a stat here would run per redisplay. +A symlink whose target moves to a different VC tree is picked up at the next +TTL refresh, when `vc-backend' resolves the link fresh." + (list file cj/modeline-vc-show-remote)) (defun cj/modeline-vc-cache-valid-p (key now) "Return non-nil when cached VC data is valid for KEY at NOW." @@ -157,18 +155,25 @@ Return a plist with `:branch' and `:state', or nil when FILE has no VC data. Uses `vc-git--symbolic-ref' for branch names when available (it returns the symbolic ref like \"main\" instead of a SHA when HEAD is on a branch), but falls back to `vc-working-revision' if the internal accessor is missing -- -the symbol is internal and can be renamed or removed between Emacs versions." - (unless (and (file-remote-p file) (not cj/modeline-vc-show-remote)) - (when-let* ((backend (vc-backend file)) - (branch (vc-working-revision file backend))) - (when (eq backend 'Git) - (unless (fboundp 'vc-git--symbolic-ref) - (require 'vc-git nil 'noerror)) - (when (fboundp 'vc-git--symbolic-ref) - (when-let* ((symbolic (ignore-errors (vc-git--symbolic-ref file)))) - (setq branch symbolic)))) - (list :branch branch - :state (vc-state file backend))))) +the symbol is internal and can be renamed or removed between Emacs versions. + +The whole VC probe is wrapped in `condition-case' returning nil. These are +synchronous git calls that, on TTL expiry, run while the mode-line is built; +on a slow or unmounted filesystem a signal here would land in redisplay and +break it. Caching nil degrades to \"no VC info\" instead." + (condition-case nil + (unless (and (file-remote-p file) (not cj/modeline-vc-show-remote)) + (when-let* ((backend (vc-backend file)) + (branch (vc-working-revision file backend))) + (when (eq backend 'Git) + (unless (fboundp 'vc-git--symbolic-ref) + (require 'vc-git nil 'noerror)) + (when (fboundp 'vc-git--symbolic-ref) + (when-let* ((symbolic (ignore-errors (vc-git--symbolic-ref file)))) + (setq branch symbolic)))) + (list :branch branch + :state (vc-state file backend)))) + (error nil))) (defun cj/modeline-vc-info () "Return cached modeline VC data for the current buffer." @@ -197,10 +202,7 @@ the symbol is internal and can be renamed or removed between Emacs versions." 'face face 'mouse-face 'mode-line-highlight 'help-echo (format "Branch: %s\nState: %s\nmouse-1: vc-diff\nmouse-3: vc-root-diff" branch state) - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] 'vc-diff) - (define-key map [mode-line mouse-3] 'vc-root-diff) - map)))))) + 'local-map (cj/--modeline-click-map 'vc-diff 'vc-root-diff)))))) (defvar-local cj/modeline-vc-branch '(:eval (when (mode-line-window-selected-p) ; Only show in active window @@ -217,9 +219,7 @@ Click to show diffs with `vc-diff' or `vc-root-diff'.") 'help-echo (if-let* ((parent (get mode-sym 'derived-mode-parent))) (format "Major mode: %s\nDerived from: %s\nmouse-1: describe-mode" mode-sym parent) (format "Major mode: %s\nmouse-1: describe-mode" mode-sym)) - 'local-map (let ((map (make-sparse-keymap))) - (define-key map [mode-line mouse-1] 'describe-mode) - map)))) + 'local-map (cj/--modeline-click-map 'describe-mode)))) "Major mode name only (no minor modes). Click to show help with `describe-mode'.") diff --git a/modules/mousetrap-mode.el b/modules/mousetrap-mode.el index 4444716ce..656d49e2f 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -1,4 +1,4 @@ -;;; mousetrap-mode.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; mousetrap-mode.el --- Profile-based mouse event blocking -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; @@ -11,25 +11,12 @@ ;; Runtime requires: cl-lib. ;; Direct test load: yes. ;; -;; Mouse Trap Mode is a minor mode for Emacs that disables most mouse and -;; trackpad events to prevent accidental text modifications. Hitting the -;; trackpad and finding my text is being inserted in an unintended place is -;; quite annoying, especially when you're overcaffeinated. +;; Global minor mode that blocks accidental mouse edits while preserving allowed +;; interaction categories per major-mode profile: scroll, click, drag, and +;; multi-click. ;; -;; The mode uses a profile-based architecture to selectively enable/disable -;; mouse events based on the current major mode. Profiles define which -;; event categories are allowed (scrolling, clicks, drags, etc.), and modes -;; are mapped to profiles. -;; -;; The keymap is built dynamically when the mode is toggled, so you can -;; change profiles or mode mappings and re-enable the mode without reloading -;; your Emacs configuration. -;; -;; Keymaps are buffer-local via `emulation-mode-map-alists', so each buffer -;; gets the correct profile for its major mode independently. -;; -;; Inspired by this blog post from Malabarba -;; https://endlessparentheses.com/disable-mouse-only-inside-emacs.html +;; The mode builds buffer-local emulation keymaps from profiles, so changing a +;; profile or mode mapping takes effect after toggling the mode. ;; ;;; Code: @@ -67,7 +54,8 @@ Categories can be combined in profiles to allow specific interaction patterns.") "Mouse interaction profiles for different use cases. Each profile specifies which event categories are allowed. -Available categories: primary-click, secondary-click, drags, multi-clicks, scroll. +Available categories: primary-click, secondary-click, drags, +multi-clicks, scroll. Profiles: - disabled: Block all mouse events @@ -88,7 +76,7 @@ Modes not listed here will use `mouse-trap-default-profile'. When checking, the mode hierarchy is respected via `derived-mode-p'.") (defvar mouse-trap-default-profile 'disabled - "Default profile to use when current major mode is not in `mouse-trap-mode-profiles'.") + "Default profile when the major mode is not in `mouse-trap-mode-profiles'.") ;;; Keymap Builder @@ -144,30 +132,34 @@ the mode is toggled, allowing dynamic behavior without reloading config." (push (cons cache-key map) mouse-trap--keymap-cache) map)))) +(defun mouse-trap--bind-events-to-ignore (spec prefixes map) + "Bind every event in SPEC, across every PREFIXES variant, to `ignore' in MAP. +SPEC is one category's event description: wheel events under \\='wheel, or +click/drag events as \\='types x \\='buttons. Used to disable a category that +the active profile disallows." + (cond + ;; Scroll events (wheel) + ((alist-get 'wheel spec) + (dolist (evt (alist-get 'wheel spec)) + (dolist (pref prefixes) + (define-key map (kbd (format "<%s%s>" pref evt)) #'ignore)))) + + ;; Click/drag events (types + buttons) + ((and (alist-get 'types spec) (alist-get 'buttons spec)) + (dolist (type (alist-get 'types spec)) + (dolist (button (alist-get 'buttons spec)) + (dolist (pref prefixes) + (define-key map (kbd (format "<%s%s-%d>" pref type button)) #'ignore))))))) + (defun mouse-trap--build-keymap-1 (allowed-categories) "Build a fresh keymap binding events not in ALLOWED-CATEGORIES to `ignore'." (let ((prefixes '("" "C-" "M-" "S-" "C-M-" "C-S-" "M-S-" "C-M-S-")) (map (make-sparse-keymap))) - - ;; For each event category, disable it if not in allowed list (dolist (category-entry mouse-trap--event-categories) (let ((category (car category-entry)) (spec (cdr category-entry))) (unless (memq category allowed-categories) - ;; This category is NOT allowed - bind its events to ignore - (cond - ;; Scroll events (wheel) - ((alist-get 'wheel spec) - (dolist (evt (alist-get 'wheel spec)) - (dolist (pref prefixes) - (define-key map (kbd (format "<%s%s>" pref evt)) #'ignore)))) - - ;; Click/drag events (types + buttons) - ((and (alist-get 'types spec) (alist-get 'buttons spec)) - (dolist (type (alist-get 'types spec)) - (dolist (button (alist-get 'buttons spec)) - (dolist (pref prefixes) - (define-key map (kbd (format "<%s%s-%d>" pref type button)) #'ignore))))))))) + (mouse-trap--bind-events-to-ignore spec prefixes map)))) map)) ;;; Buffer-local keymap via emulation-mode-map-alists @@ -183,6 +175,11 @@ Used via `emulation-mode-map-alists' so each buffer gets its own keymap.") ;;; Minor Mode Definition +;; Forward declaration: the minor-mode variable is defined by the +;; `define-minor-mode' form below, but referenced earlier in the lighter +;; keymap and lighter-string helpers. +(defvar mouse-trap-mode) + (defvar mouse-trap--lighter-keymap (let ((map (make-sparse-keymap))) (define-key map [mode-line mouse-1] diff --git a/modules/mu4e-org-contacts-integration.el b/modules/mu4e-org-contacts-integration.el index 6aed3d4cf..6062b8cf5 100644 --- a/modules/mu4e-org-contacts-integration.el +++ b/modules/mu4e-org-contacts-integration.el @@ -2,8 +2,13 @@ ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; This module provides seamless integration between org-contacts and mu4e's -;; email composition, enabling automatic contact completion in email fields. +;; +;; Completion-at-point integration between org-contacts and mu4e/org-msg compose +;; buffers. Header fields complete against org contact email strings; message +;; bodies keep their normal TAB behavior. +;; +;; Dependencies are optional at file load. Activation is a no-op when mu4e or +;; org-contacts is unavailable so the wider config can still load. ;;; Code: @@ -32,7 +37,6 @@ This function is designed to work with mu4e's compose buffers." (re-search-backward "\\(\\`\\|[\n:,]\\)[ \t]*" nil t) (goto-char (match-end 0)) (point))) - (initial (buffer-substring-no-properties start end)) (contacts (cj/get-all-contact-emails))) (when contacts (list start end diff --git a/modules/mu4e-org-contacts-setup.el b/modules/mu4e-org-contacts-setup.el index 034e74574..bfb9b1f24 100644 --- a/modules/mu4e-org-contacts-setup.el +++ b/modules/mu4e-org-contacts-setup.el @@ -2,11 +2,17 @@ ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; Simple setup file to enable org-contacts integration with mu4e. -;; Add this to your mail-config.el or load it after both mu4e and org-contacts. +;; +;; Thin activation wrapper for mu4e-org-contacts-integration. If mu4e is loaded, +;; enable org-contacts completion and disable mu4e's internal contact collector +;; so completion has one source of truth. ;;; Code: +(defvar mu4e-compose-complete-only-personal) +(defvar mu4e-compose-complete-only-after) +(declare-function cj/activate-mu4e-org-contacts-integration "mu4e-org-contacts-integration") + ;; Load the integration module. Activation only runs when the module loaded ;; cleanly AND mu4e is present; otherwise this file is a no-op so the rest ;; of the config can load without mu4e installed. diff --git a/modules/music-config.el b/modules/music-config.el index fd619d8cd..86f6eb130 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -5,96 +5,61 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P/S. ;; Load shape: eager. -;; Eager reason: none; optional music workflow that registers a music keymap, a -;; command-loaded deferral candidate. EMMS hooks should run only after EMMS. -;; Top-level side effects: defines a music keymap under cj/custom-keymap, one -;; global key, package config. +;; Eager reason: none; optional music workflow that registers a music keymap. +;; Top-level side effects: defines C-; m map, one global key, package config. ;; Runtime requires: subr-x, user-constants, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; Music management in Emacs via EMMS with MPV backend. -;; Focus: simple, modular helpers; consistent error handling; streamlined UX. -;; -;; Highlights: -;; - Fuzzy add: select files/dirs; dirs have trailing /; case-insensitive; stable order -;; - Recursive directory add -;; - Dired/Dirvish integration (add selection) -;; - M3U playlist save/load/edit/reload -;; - Radio station M3U creation (streaming URLs supported) -;; - Playlist window toggling -;; - Consume mode (remove tracks after playback) -;; - MPV as player (no daemon required) -;; -;; Keybindings (playlist-mode-map): -;; -;; Aligned with ncmpcpp defaults where possible (83% match). -;; Additional EMMS-specific bindings for features ncmpcpp lacks. -;; -;; Key Action ncmpcpp default Match -;; ─── ────── ─────────────── ───── -;; Playback -;; SPC pause add_item * -;; s stop stop ✓ -;; > / n next track next ✓ -;; < / P previous track previous ✓ -;; p play selected (enter) ✓ -;; f seek forward seek_forward ✓ -;; b seek backward seek_backward ✓ -;; -;; Toggles -;; r repeat playlist toggle_repeat ✓ -;; t repeat track (none) + -;; z random toggle_random ✓ -;; x consume toggle_crossfade * -;; Z shuffle shuffle ✓ -;; -;; Volume -;; + / = volume up volume_up ✓ -;; - volume down volume_down ✓ -;; -;; Info -;; i song info show_song_info ✓ -;; o jump to playing jump_to_playing ✓ -;; -;; Playlist management -;; a add music (fuzzy) add_selected ✓ -;; c / C clear playlist clear_playlist ✓ -;; S save playlist (none) + -;; L load playlist (none) + -;; E edit playlist M3U (none) + -;; g reload playlist (none) + -;; A append track to M3U (none) + -;; q quit/bury quit ✓ -;; -;; Track reordering -;; S-up move track up (shift-up) ✓ -;; S-down move track down (shift-down) ✓ -;; C-up move track up (alias) (none) + -;; C-down move track down (alias) (none) + -;; -;; Other -;; R create radio station (none) + -;; -;; Legend: ✓ = matches ncmpcpp default -;; * = intentional divergence (see below) -;; + = EMMS-only feature -;; -;; Intentional divergences from ncmpcpp defaults: -;; -;; SPC/p swap: ncmpcpp defaults p=pause, SPC=add_item_to_playlist. -;; This config uses SPC=pause (more natural in Emacs) and p=play -;; selected track. Pause via SPC is a common media player convention. -;; -;; x=consume vs crossfade: ncmpcpp's crossfade is an mpd daemon -;; feature. EMMS uses mpv directly, so consume mode (remove tracks -;; after playback) is more useful here. +;; EMMS setup using an mpv subprocess player, M3U playlist helpers, fuzzy +;; file/directory adds, Dired/Dirvish integration, radio-station creation, and +;; playlist window toggling. ;; +;; The playlist keymap intentionally follows ncmpcpp where it maps cleanly, with +;; EMMS-specific additions for M3U editing and consume mode. + ;;; Code: (require 'subr-x) (require 'user-constants) (require 'keybindings) ;; provides cj/custom-keymap +(require 'cj-window-geometry-lib) ;; cj/preferred-dock-direction (F10 dock side) (require 'cj-window-toggle-lib) ;; side-window size memory (F10 toggle) +(require 'system-lib) ;; cj/confirm-strong (overwrite confirms) + +;; Declare these foreign package vars special so `let'-binding them below +;; compiles as a dynamic bind, not a dead lexical local -- otherwise emms / +;; orderless never see the binding (the lexical-binding foreign-special-var trap). +(defvar orderless-smart-case) +(defvar emms-source-playlist-ask-before-overwrite) +(defvar emms-playlist-buffer-p) +(defvar emms-playlist-buffer) +(defvar emms-random-playlist) +(defvar emms-playlist-selected-marker) +(defvar emms-source-file-default-directory) +(defvar emms-player-playing-p) +(defvar emms-player-paused-p) +(defvar emms-playlist-mode-map) +(defvar dirvish-mode-map) + +;; Foreign functions used lazily after their packages load. +(declare-function emms-playlist-mode "emms-playlist-mode") +(declare-function emms-playlist-track-at "emms-playlist-mode") +(declare-function emms-playlist-mode-kill-track "emms-playlist-mode") +(declare-function emms-track-name "emms") +(declare-function emms-track-type "emms") +(declare-function emms-track-get "emms") +(declare-function emms-track-simple-description "emms") +(declare-function emms-playlist-current-selected-track "emms") +(declare-function emms-playlist-select "emms") +(declare-function emms-playlist-clear "emms") +(declare-function emms-playlist-save "emms-source-playlist") +(declare-function emms-start "emms") +(declare-function emms-random "emms") +(declare-function emms-next "emms") +(declare-function emms-previous "emms") +(declare-function dired-get-marked-files "dired") +(declare-function dired-get-file-for-visit "dired") +(declare-function face-remap-remove-relative "face-remap") ;;; Settings (no Customize) @@ -107,9 +72,98 @@ (defvar cj/music-file-extensions '("aac" "flac" "m4a" "mp3" "ogg" "opus" "wav") "List of valid music file extensions.") +(defvar cj/music-seek-seconds 5 + "Seconds to move when seeking forward or backward in the current track.") + (defvar cj/music-playlist-buffer-name "*EMMS-Playlist*" "Name of the EMMS playlist buffer used by this configuration.") +;;; Subprocess mpv player (reliable playback) + +;; The IPC player (emms-player-mpv) drives mpv over a socket -- start mpv idle, +;; connect, send loadfile. That handshake was leaving mpv loaded but never +;; streaming, so playback silently failed. Driving mpv with the track as a +;; direct argument -- the invocation that plays every time -- is the reliable +;; path. --no-config isolates this mpv from the interactive/video mpv setup so +;; the two cannot interfere. Pause is in place via process signals; in-track +;; seek is not available with a subprocess player (the trade for reliability). + +(declare-function emms-player "emms") +(declare-function emms-player-set "emms") +(declare-function emms-player-simple-start "emms-player-simple") +(declare-function emms-player-simple-stop "emms-player-simple") +(defvar emms-player-simple-process-name) +(defvar emms-player-cj/music-mpv) + +(defvar cj/music--mpv-regex + (concat "\\(?:\\." (regexp-opt cj/music-file-extensions) "\\'\\)" + "\\|\\`\\(?:https?\\|mms\\)://") + "Track names the subprocess mpv player handles: music files or stream URLs.") + +(defvar cj/music--mpv-socket + (expand-file-name "emms/mpv-control.sock" user-emacs-directory) + "IPC control socket for the subprocess mpv player. +mpv opens it per playback via --input-ipc-server. It does NOT affect startup: +mpv still plays the track passed as a direct argument, so the reliable start is +unchanged. The socket only carries control commands (seek) to the already +playing process, which is where the old idle + loadfile handshake failed.") + +(defun cj/music--mpv-start (track) + "Play TRACK by running mpv with the track name as a direct argument." + (emms-player-simple-start (emms-track-name track) + 'emms-player-cj/music-mpv + "mpv" + (list "--no-video" "--no-config" "--really-quiet" + (concat "--input-ipc-server=" cj/music--mpv-socket)))) + +(defun cj/music--mpv-stop () + "Stop the mpv subprocess." + (emms-player-simple-stop)) + +(defun cj/music--mpv-playable-p (track) + "Return non-nil if the subprocess mpv player can play TRACK." + (and (executable-find "mpv") + (memq (emms-track-type track) '(file url)) + (string-match cj/music--mpv-regex (emms-track-name track)))) + +(defun cj/music--mpv-pause () + "Pause the mpv subprocess in place by stopping it (SIGSTOP)." + (let ((proc (get-process emms-player-simple-process-name))) + (when (and proc (process-live-p proc)) + (signal-process proc 'SIGSTOP)))) + +(defun cj/music--mpv-resume () + "Resume the paused mpv subprocess (SIGCONT)." + (let ((proc (get-process emms-player-simple-process-name))) + (when (and proc (process-live-p proc)) + (signal-process proc 'SIGCONT)))) + +(defun cj/music--mpv-command (json) + "Send JSON (a one-line mpv IPC command) to the control socket. +A no-op when nothing is playing or the socket is gone, so it never errors." + (when (file-exists-p cj/music--mpv-socket) + (ignore-errors + (let ((proc (make-network-process :name "cj-music-mpv-cmd" + :family 'local + :service cj/music--mpv-socket + :noquery t))) + (unwind-protect + (progn (process-send-string proc (concat json "\n")) + (accept-process-output proc 0.1)) + (delete-process proc)))))) + +(defun cj/music-seek-forward () + "Seek `cj/music-seek-seconds' seconds forward in the current track." + (interactive) + (cj/music--mpv-command + (format "{\"command\": [\"seek\", %d, \"relative\"]}" cj/music-seek-seconds))) + +(defun cj/music-seek-backward () + "Seek `cj/music-seek-seconds' seconds backward in the current track." + (interactive) + (cj/music--mpv-command + (format "{\"command\": [\"seek\", %d, \"relative\"]}" (- cj/music-seek-seconds)))) + ;;; Buffer-local state (defvar-local cj/music-playlist-file nil @@ -371,7 +425,7 @@ Offers completion over existing names but allows new names." (filename (if (string-suffix-p ".m3u" chosen) chosen (concat chosen ".m3u"))) (full (expand-file-name filename cj/music-m3u-root))) (when (and (file-exists-p full) - (not (yes-or-no-p (format "Overwrite %s? " filename)))) + (not (cj/confirm-strong (format "Overwrite %s? " filename)))) (user-error "Aborted saving playlist")) (with-current-buffer (cj/music--ensure-playlist-buffer) (let ((emms-source-playlist-ask-before-overwrite nil)) @@ -516,14 +570,38 @@ Intended for use on `emms-player-finished-hook'." (defvar cj/music-playlist-window-height 0.3 "Default fraction of frame height for the F10 music playlist side window. -Used until the playlist is resized and toggled off this session; after that, -the toggled-off height is remembered in `cj/--music-playlist-height'.") +Used when the playlist docks at the bottom and hasn't been resized and +toggled off this session; after that, the toggled-off height is remembered +in `cj/--music-playlist-height'.") + +(defvar cj/music-playlist-window-width 0.4 + "Default fraction of frame width for the F10 music playlist side window. +Used when the playlist docks as a right-side column (see +`cj/--music-playlist-side') and hasn't been resized this session; after +that the toggled-off width is remembered in `cj/--music-playlist-width'.") (defvar cj/--music-playlist-height nil - "Last height fraction the playlist side window was toggled off at. + "Last height fraction the playlist was toggled off at while docked bottom. nil means fall back to `cj/music-playlist-window-height'. In-memory only -- resets each Emacs session.") +(defvar cj/--music-playlist-width nil + "Last width fraction the playlist was toggled off at while docked right. +nil means fall back to `cj/music-playlist-window-width'. In-memory only -- +resets each Emacs session.") + +(defun cj/--music-playlist-side () + "Return the side the F10 playlist should dock on: `right' or `bottom'. +Docks as a right-side column only when a side-by-side split would leave +both panes at least `cj/window-dock-min-columns' wide (the playlist's +share is `cj/music-playlist-window-width'); otherwise docks at the bottom. +See `cj/preferred-dock-direction'." + (if (eq (cj/preferred-dock-direction (frame-width) + cj/music-playlist-window-width) + 'right) + 'right + 'bottom)) + (defun cj/music-playlist-toggle () "Toggle the EMMS playlist buffer in a bottom side window. The window opens at `cj/music-playlist-window-height'; if it has been @@ -534,15 +612,28 @@ resized and toggled off this session, it reopens at that remembered height." (win (and buffer (get-buffer-window buffer)))) (if win (progn - (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height) + ;; Capture the resized size into the var matching the window's + ;; actual side, so width and height memories stay independent. + ;; Guard the parameter lookup: a dead or non-window WIN (the + ;; capture helpers tolerate one) must not error here. + (let ((side (if (window-live-p win) + (or (window-parameter win 'window-side) 'bottom) + 'bottom))) + (if (memq side '(left right)) + (cj/side-window-capture-size win side 'cj/--music-playlist-width) + (cj/side-window-capture-size win 'bottom 'cj/--music-playlist-height))) (delete-window win) (message "Playlist window closed")) (progn (cj/emms--setup) (setq buffer (cj/music--ensure-playlist-buffer)) - (setq win (cj/side-window-display - buffer 'bottom 'cj/--music-playlist-height - cj/music-playlist-window-height)) + (let* ((side (cj/--music-playlist-side)) + (right (eq side 'right))) + (setq win (cj/side-window-display + buffer side + (if right 'cj/--music-playlist-width 'cj/--music-playlist-height) + (if right cj/music-playlist-window-width + cj/music-playlist-window-height)))) (select-window win) (with-current-buffer buffer (if (and (fboundp 'emms-playlist-current-selected-track) @@ -574,26 +665,26 @@ Initializes EMMS if needed." ;;; Dired/Dirvish integration -(with-eval-after-load 'dirvish - (defun cj/music-add-dired-selection () - "Add selected files/dirs in Dired/Dirvish to the EMMS playlist. +(defun cj/music-add-dired-selection () + "Add selected files/dirs in Dired/Dirvish to the EMMS playlist. Dirs added recursively." - (interactive) - (unless (derived-mode-p 'dired-mode) - (user-error "This command must be run in a Dired buffer")) - (cj/music--ensure-playlist-buffer) - (let ((files (if (use-region-p) - (dired-get-marked-files) - (list (dired-get-file-for-visit))))) - (when (null files) - (user-error "No files selected")) - (dolist (file files) - (cond - ((file-directory-p file) (cj/music-add-directory-recursive file)) - ((cj/music--valid-file-p file) (emms-add-file file)) - (t (message "Skipping non-music file: %s" file)))) - (message "Added %d item(s) to playlist" (length files)))) + (interactive) + (unless (derived-mode-p 'dired-mode) + (user-error "This command must be run in a Dired buffer")) + (cj/music--ensure-playlist-buffer) + (let ((files (if (use-region-p) + (dired-get-marked-files) + (list (dired-get-file-for-visit))))) + (when (null files) + (user-error "No files selected")) + (dolist (file files) + (cond + ((file-directory-p file) (cj/music-add-directory-recursive file)) + ((cj/music--valid-file-p file) (emms-add-file file)) + (t (message "Skipping non-music file: %s" file)))) + (message "Added %d item(s) to playlist" (length files)))) +(with-eval-after-load 'dirvish (keymap-set dirvish-mode-map "+" #'cj/music-add-dired-selection)) ;;; EMMS setup and keybindings @@ -635,6 +726,130 @@ Dirs added recursively." "C-; m z" "random" "C-; m x" "consume")) +;;; Playlist display helpers +;; +;; Defined at top level (not inside the `emms' use-package `:config') so the +;; byte-compiler sees them; they touch EMMS only at call time, after load. + +(defun cj/music--after-playlist-clear (&rest _) + "Forget the associated M3U file after the playlist is cleared." + (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) + (with-current-buffer buf + (setq cj/music-playlist-file nil)))) + +(defun cj/music--format-duration (seconds) + "Convert SECONDS to a \"M:SS\" string." + (when (and seconds (numberp seconds) (> seconds 0)) + (format "%d:%02d" (/ seconds 60) (mod seconds 60)))) + +(defun cj/music--track-description (track) + "Return a human-readable description of TRACK. +For tagged tracks: \"Artist - Title [M:SS]\". +For file tracks without tags: filename without path or extension. +For URL tracks: decoded URL." + (let ((type (emms-track-type track)) + (title (emms-track-get track 'info-title)) + (artist (emms-track-get track 'info-artist)) + (duration (emms-track-get track 'info-playing-time)) + (name (emms-track-name track))) + (cond + ;; Tagged track with title + (title + (let ((dur-str (cj/music--format-duration duration)) + (parts '())) + (when artist (push artist parts)) + (push title parts) + (let ((desc (string-join (nreverse parts) " - "))) + (if dur-str (format "%s [%s]" desc dur-str) desc)))) + ;; File without tags — show clean filename + ((eq type 'file) + (file-name-sans-extension (file-name-nondirectory name))) + ;; URL — decode percent-encoded characters + ((eq type 'url) + (decode-coding-string (url-unhex-string name) 'utf-8)) + ;; Fallback + (t (emms-track-simple-description track))))) + +;; Multi-line header overlay +(defvar-local cj/music--header-overlay nil + "Overlay displaying the playlist header.") + +(defun cj/music--header-text () + "Build a multi-line header string for the playlist buffer overlay." + (let* ((pl-name (if cj/music-playlist-file + (file-name-sans-extension + (file-name-nondirectory cj/music-playlist-file)) + "Untitled")) + (track-count (count-lines (point-min) (point-max))) + (now-playing (cond + ((not emms-player-playing-p) "Stopped") + (emms-player-paused-p "Paused") + (t (let ((track (emms-playlist-current-selected-track))) + (if track + (cj/music--track-description track) + "Playing"))))) + (mode-indicator + (lambda (key label active) + (let ((face (if active 'cj/music-mode-on-face 'cj/music-mode-off-face))) + (propertize (format "[%s] %s" key label) 'face face))))) + (concat + (propertize "Playlist" 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize (format "%s (%d)" pl-name track-count) 'face 'cj/music-header-value-face) + "\n" + (propertize "Current " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize now-playing 'face 'cj/music-header-value-face) + "\n" + (propertize "Mode " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) + " " + (funcall mode-indicator "t" "single" (bound-and-true-p emms-repeat-track)) + " " + (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) + " " + (funcall mode-indicator "x" "consume" cj/music-consume-mode) + "\n" + (propertize "Keys " 'face 'cj/music-header-face) + (propertize " : " 'face 'cj/music-header-face) + (propertize "a:add c:clear L:load S:save SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" + 'face 'cj/music-keyhint-face) + "\n\n"))) + +(defun cj/music--update-header () + "Insert or update the multi-line header overlay in the playlist buffer." + (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) + (with-current-buffer buf + (unless cj/music--header-overlay + (setq cj/music--header-overlay (make-overlay (point-min) (point-min))) + (overlay-put cj/music--header-overlay 'priority 100)) + (move-overlay cj/music--header-overlay (point-min) (point-min)) + (overlay-put cj/music--header-overlay 'before-string + (cj/music--header-text))))) + +(defvar-local cj/music--bg-remap-cookie nil + "Cookie for the active-window background face remapping.") + +(defun cj/music--update-active-bg (&rest _) + "Toggle playlist buffer background based on whether its window is selected." + (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) + (with-current-buffer buf + (let ((active (eq buf (window-buffer (selected-window))))) + (cond + ((and active (not cj/music--bg-remap-cookie)) + (setq cj/music--bg-remap-cookie + (face-remap-add-relative 'default))) + ((and (not active) cj/music--bg-remap-cookie) + (face-remap-remove-relative cj/music--bg-remap-cookie) + (setq cj/music--bg-remap-cookie nil))))))) + +(defun cj/music--setup-playlist-display () + "Set up header overlay and focus tracking in the playlist buffer." + (setq header-line-format nil) + (cj/music--update-header) + (add-hook 'window-selection-change-functions #'cj/music--update-active-bg nil t)) + (use-package emms :defer t :init @@ -643,7 +858,7 @@ Dirs added recursively." :commands (emms-mode-line-mode) :config (require 'emms-setup) - (require 'emms-player-mpv) + (require 'emms-player-simple) (require 'emms-playlist-mode) (require 'emms-source-file) (require 'emms-source-playlist) @@ -652,203 +867,31 @@ Dirs added recursively." (setq emms-source-file-default-directory cj/music-root) (setq emms-playlist-default-major-mode 'emms-playlist-mode) - ;; Use MPV as player - MUST be set before emms-all - (setq emms-player-list '(emms-player-mpv)) + ;; Use the reliable subprocess mpv player (built above) - MUST be set before emms-all + (setq emms-player-cj/music-mpv + (emms-player #'cj/music--mpv-start #'cj/music--mpv-stop + #'cj/music--mpv-playable-p)) + (emms-player-set emms-player-cj/music-mpv 'pause #'cj/music--mpv-pause) + (emms-player-set emms-player-cj/music-mpv 'resume #'cj/music--mpv-resume) + (setq emms-player-list '(emms-player-cj/music-mpv)) ;; Now initialize EMMS (emms-all) ;; Disable modeline display (keep modeline clean) - (emms-playing-time-disable-display) + (emms-playing-time-display-mode -1) (emms-mode-line-mode -1) - ;; MPV configuration - ;; MPV supports both local files and stream URLs - (setq emms-player-mpv-parameters - '("--quiet" "--no-video" "--audio-display=no")) - - ;; Update supported file types for mpv player - (setq emms-player-mpv-regexp - (concat "\\(?:\\`\\(?:https?\\|mms\\)://\\)\\|\\(?:\\." - (regexp-opt cj/music-file-extensions) - "\\'\\)")) - - ;; Keep cj/music-playlist-file in sync if playlist is cleared - (defun cj/music--after-playlist-clear (&rest _) - (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) - (with-current-buffer buf - (setq cj/music-playlist-file nil)))) - - ;; Ensure we don't stack duplicate advice on reload + ;; Keep cj/music-playlist-file in sync if playlist is cleared. + ;; Ensure we don't stack duplicate advice on reload. (advice-remove 'emms-playlist-clear #'cj/music--after-playlist-clear) (advice-add 'emms-playlist-clear :after #'cj/music--after-playlist-clear) ;;; Playlist display ;; Track description: show "Artist - Title [M:SS]" instead of file paths - (defun cj/music--format-duration (seconds) - "Convert SECONDS to a \"M:SS\" string." - (when (and seconds (numberp seconds) (> seconds 0)) - (format "%d:%02d" (/ seconds 60) (mod seconds 60)))) - - (defun cj/music--track-description (track) - "Return a human-readable description of TRACK. -For tagged tracks: \"Artist - Title [M:SS]\". -For file tracks without tags: filename without path or extension. -For URL tracks: decoded URL." - (let ((type (emms-track-type track)) - (title (emms-track-get track 'info-title)) - (artist (emms-track-get track 'info-artist)) - (duration (emms-track-get track 'info-playing-time)) - (name (emms-track-name track))) - (cond - ;; Tagged track with title - (title - (let ((dur-str (cj/music--format-duration duration)) - (parts '())) - (when artist (push artist parts)) - (push title parts) - (let ((desc (string-join (nreverse parts) " - "))) - (if dur-str (format "%s [%s]" desc dur-str) desc)))) - ;; File without tags — show clean filename - ((eq type 'file) - (file-name-sans-extension (file-name-nondirectory name))) - ;; URL — decode percent-encoded characters - ((eq type 'url) - (decode-coding-string (url-unhex-string name) 'utf-8)) - ;; Fallback - (t (emms-track-simple-description track))))) - (setq emms-track-description-function #'cj/music--track-description) - ;; Playlist faces - (defface cj/music-header-face - '((((class color) (background dark)) - (:foreground "#969385")) - (((class color) (background light)) - (:foreground "gray50"))) - "Face for playlist header labels.") - - (defface cj/music-header-value-face - '((((class color) (background dark)) - (:foreground "#d0cbc0")) - (((class color) (background light)) - (:foreground "gray30"))) - "Face for playlist header values.") - - (defface cj/music-mode-on-face - '((((class color) (background dark)) - (:foreground "#d7af5f")) - (((class color) (background light)) - (:foreground "DarkGoldenrod"))) - "Face for active mode indicators in the playlist header.") - - (defface cj/music-mode-off-face - '((((class color) (background dark)) - (:foreground "#58574e")) - (((class color) (background light)) - (:foreground "gray70"))) - "Face for inactive mode indicators in the playlist header.") - - (defface cj/music-keyhint-face - '((((class color) (background dark)) - (:foreground "#8a9496")) - (((class color) (background light)) - (:foreground "gray50"))) - "Face for keybinding hints in the playlist header.") - - (custom-set-faces - '(emms-playlist-track-face - ((((class color) (background dark)) - (:foreground "#8a9496")) - (((class color) (background light)) - (:foreground "gray50")))) - '(emms-playlist-selected-face - ((((class color) (background dark)) - (:foreground "#d7af5f" :weight bold)) - (((class color) (background light)) - (:foreground "DarkGoldenrod" :weight bold))))) - - ;; Multi-line header overlay - (defvar-local cj/music--header-overlay nil - "Overlay displaying the playlist header.") - - (defun cj/music--header-text () - "Build a multi-line header string for the playlist buffer overlay." - (let* ((pl-name (if cj/music-playlist-file - (file-name-sans-extension - (file-name-nondirectory cj/music-playlist-file)) - "Untitled")) - (track-count (count-lines (point-min) (point-max))) - (now-playing (cond - ((not emms-player-playing-p) "Stopped") - (emms-player-paused-p "Paused") - (t (let ((track (emms-playlist-current-selected-track))) - (if track - (cj/music--track-description track) - "Playing"))))) - (mode-indicator - (lambda (key label active) - (let ((face (if active 'cj/music-mode-on-face 'cj/music-mode-off-face))) - (propertize (format "[%s] %s" key label) 'face face))))) - (concat - (propertize "Playlist" 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize (format "%s (%d)" pl-name track-count) 'face 'cj/music-header-value-face) - "\n" - (propertize "Current " 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize now-playing 'face 'cj/music-header-value-face) - "\n" - (propertize "Mode " 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) - " " - (funcall mode-indicator "t" "single" (bound-and-true-p emms-repeat-track)) - " " - (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) - " " - (funcall mode-indicator "x" "consume" cj/music-consume-mode) - "\n" - (propertize "Keys " 'face 'cj/music-header-face) - (propertize " : " 'face 'cj/music-header-face) - (propertize "a:add c:clear L:load S:save SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" - 'face 'cj/music-keyhint-face) - "\n\n"))) - - (defun cj/music--update-header () - "Insert or update the multi-line header overlay in the playlist buffer." - (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) - (with-current-buffer buf - (unless cj/music--header-overlay - (setq cj/music--header-overlay (make-overlay (point-min) (point-min))) - (overlay-put cj/music--header-overlay 'priority 100)) - (move-overlay cj/music--header-overlay (point-min) (point-min)) - (overlay-put cj/music--header-overlay 'before-string - (cj/music--header-text))))) - - (defvar-local cj/music--bg-remap-cookie nil - "Cookie for the active-window background face remapping.") - - (defun cj/music--update-active-bg (&rest _) - "Toggle playlist buffer background based on whether its window is selected." - (when-let ((buf (get-buffer cj/music-playlist-buffer-name))) - (with-current-buffer buf - (let ((active (eq buf (window-buffer (selected-window))))) - (cond - ((and active (not cj/music--bg-remap-cookie)) - (setq cj/music--bg-remap-cookie - (face-remap-add-relative 'default :background "#1d1b19"))) - ((and (not active) cj/music--bg-remap-cookie) - (face-remap-remove-relative cj/music--bg-remap-cookie) - (setq cj/music--bg-remap-cookie nil))))))) - - (defun cj/music--setup-playlist-display () - "Set up header overlay and focus tracking in the playlist buffer." - (setq header-line-format nil) - (cj/music--update-header) - (add-hook 'window-selection-change-functions #'cj/music--update-active-bg nil t)) - (add-hook 'emms-playlist-mode-hook #'cj/music--setup-playlist-display) (add-hook 'emms-player-started-hook #'cj/music--record-random-history) (add-hook 'emms-player-started-hook #'cj/music--update-header) @@ -874,8 +917,8 @@ For URL tracks: decoded URL." (">" . cj/music-next) ("P" . cj/music-previous) ("<" . cj/music-previous) - ("f" . emms-seek-forward) - ("b" . emms-seek-backward) + ("f" . cj/music-seek-forward) + ("b" . cj/music-seek-backward) ("q" . emms-playlist-mode-bury-buffer) ("a" . cj/music-fuzzy-select-and-add) ;; Toggles (aligned with ncmpcpp) @@ -900,8 +943,6 @@ For URL tracks: decoded URL." ("S-<down>" . emms-playlist-mode-shift-track-down) ("C-<up>" . emms-playlist-mode-shift-track-up) ("C-<down>" . emms-playlist-mode-shift-track-down) - ;; Radio - ("R" . cj/music-create-radio-station) ;; Volume ("+" . emms-volume-raise) ("=" . emms-volume-raise) @@ -924,11 +965,16 @@ For URL tracks: decoded URL." (file (expand-file-name (concat safe "_Radio.m3u") cj/music-m3u-root)) (content (format "#EXTM3U\n#EXTINF:-1,%s\n%s\n" name url))) (when (and (file-exists-p file) - (not (yes-or-no-p (format "Overwrite %s? " (file-name-nondirectory file))))) + (not (cj/confirm-strong (format "Overwrite %s? " (file-name-nondirectory file))))) (user-error "Aborted creating radio station")) (with-temp-file file (insert content)) (message "Created radio station: %s" (file-name-nondirectory file)))) +;; Bound here rather than in the emms `:bind' so use-package does not emit a +;; redundant autoload that collides with this same-file definition. +(with-eval-after-load 'emms + (keymap-set emms-playlist-mode-map "R" #'cj/music-create-radio-station)) + (provide 'music-config) ;;; music-config.el ends here diff --git a/modules/nerd-icons-config.el b/modules/nerd-icons-config.el index d3d55b864..e38db7d80 100644 --- a/modules/nerd-icons-config.el +++ b/modules/nerd-icons-config.el @@ -1,4 +1,4 @@ -;;; nerd-icons-config.el --- Nerd-icons setup, integrations, and tinting -*- lexical-binding: t; -*- +;;; nerd-icons-config.el --- Nerd-icons setup and integrations -*- lexical-binding: t; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: @@ -16,51 +16,21 @@ ;; - the package itself ;; - completion integration (`nerd-icons-completion') ;; - ibuffer integration (`nerd-icons-ibuffer') -;; - bulk color tinting of every `nerd-icons-*' color face ;; - dir-icon color advice (so directory glyphs carry a color face like ;; file glyphs do, instead of falling through to the buffer default ;; face) ;; +;; Icon colors are theme-driven: nerd-icons' 34 `nerd-icons-*' color faces are +;; owned by the theme (themeable in theme-studio), not overwritten at load time. +;; ;; Per-feature USE of nerd-icons stays in the feature module that consumes ;; it: `dashboard-icon-type', `dirvish-attributes', and the keyboard-compat ;; terminal-frame icon-blanking advice are not centralized here. ;;; Code: -;; ----------------------------- Customization --------------------------------- - -(defcustom cj/nerd-icons-tint-color "darkgoldenrod" - "Single foreground color applied to every `nerd-icons-*' color face. -Set via Customize or by `setq' before this module loads, then call -`cj/nerd-icons-apply-tint' to re-apply on demand." - :type 'string - :group 'cj) - -(defconst cj/--nerd-icons-color-faces - '(nerd-icons-red nerd-icons-lred nerd-icons-dred nerd-icons-red-alt - nerd-icons-green nerd-icons-lgreen nerd-icons-dgreen - nerd-icons-yellow nerd-icons-lyellow nerd-icons-dyellow - nerd-icons-orange nerd-icons-lorange nerd-icons-dorange - nerd-icons-blue nerd-icons-blue-alt nerd-icons-lblue nerd-icons-dblue - nerd-icons-cyan nerd-icons-cyan-alt nerd-icons-lcyan nerd-icons-dcyan - nerd-icons-purple nerd-icons-purple-alt nerd-icons-lpurple nerd-icons-dpurple - nerd-icons-pink nerd-icons-lpink nerd-icons-dpink - nerd-icons-maroon nerd-icons-lmaroon nerd-icons-dmaroon - nerd-icons-silver nerd-icons-lsilver nerd-icons-dsilver) - "Every color face nerd-icons attaches to glyphs via `:inherit'.") - ;; ------------------------------- Helpers ------------------------------------- -(defun cj/nerd-icons-apply-tint (&optional color) - "Set every face in `cj/--nerd-icons-color-faces' to foreground COLOR. -COLOR defaults to `cj/nerd-icons-tint-color'. Faces that are not yet -defined (nerd-icons not loaded) are silently skipped." - (interactive) - (let ((c (or color cj/nerd-icons-tint-color))) - (dolist (f cj/--nerd-icons-color-faces) - (when (facep f) - (set-face-foreground f c))))) - (defun cj/--nerd-icons-color-dir (icon) "Layer `nerd-icons-yellow' onto ICON's face stack and return ICON. ICON is the propertized string returned by `nerd-icons-icon-for-dir'. @@ -87,24 +57,35 @@ every call. The `memq' check skips when the face is already present." (use-package nerd-icons :demand t :config - (advice-add 'nerd-icons-icon-for-dir :filter-return #'cj/--nerd-icons-color-dir) - (cj/nerd-icons-apply-tint)) + (advice-add 'nerd-icons-icon-for-dir :filter-return #'cj/--nerd-icons-color-dir)) ;; Safety net: if this module is re-evaluated in a running Emacs where ;; nerd-icons is already loaded, `:config' above won't fire again -- -;; ensure the advice and tint still apply. +;; ensure the dir advice still applies. (with-eval-after-load 'nerd-icons (unless (advice-member-p #'cj/--nerd-icons-color-dir 'nerd-icons-icon-for-dir) (advice-add 'nerd-icons-icon-for-dir - :filter-return #'cj/--nerd-icons-color-dir)) - (cj/nerd-icons-apply-tint)) + :filter-return #'cj/--nerd-icons-color-dir))) (use-package nerd-icons-completion :demand t :after (nerd-icons marginalia) :hook (marginalia-mode . nerd-icons-completion-marginalia-setup) :config - (nerd-icons-completion-mode)) + (nerd-icons-completion-mode) + ;; The `cj/--nerd-icons-color-dir' advice forces `nerd-icons-yellow' onto every + ;; dir icon, so the package's inherit-behind `nerd-icons-completion-dir-face' + ;; can never win. Redefine the file-category icon so completing-read folders + ;; carry the dir face: copy the icon first (the memoized original stays + ;; untouched, so dired/dirvish folders are unaffected) and prepend the dir face + ;; so it takes the foreground. Files keep their own type face. + (cl-defmethod nerd-icons-completion-get-icon (cand (_cat (eql file))) + (if (string-suffix-p "/" cand) + (let ((icon (copy-sequence + (nerd-icons-icon-for-dir cand :height nerd-icons-completion-icon-size)))) + (add-face-text-property 0 (length icon) 'nerd-icons-completion-dir-face nil icon) + (concat icon " ")) + (concat (nerd-icons-icon-for-file cand :height nerd-icons-completion-icon-size) " ")))) (use-package nerd-icons-ibuffer :after nerd-icons diff --git a/modules/org-agenda-config-debug.el b/modules/org-agenda-config-debug.el index a9c713a13..4c1b1dd84 100644 --- a/modules/org-agenda-config-debug.el +++ b/modules/org-agenda-config-debug.el @@ -18,6 +18,9 @@ (require 'user-constants) (require 'system-lib) +(defvar org-agenda-files) +(declare-function cj/build-org-agenda-list "org-agenda-config") + ;; ---------------------------- Debug Functions -------------------------------- ;;;###autoload diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index e2b431f9a..9ccd21d7b 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -6,50 +6,18 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D/S. ;; Load shape: eager. -;; Eager reason: daily agenda workflow; the user expects agenda available at the -;; first session. -;; Top-level side effects: one add-hook and an idle timer that builds the agenda -;; file cache 10s after startup (guarded; spec tracks the cache lifecycle). +;; Eager reason: agenda should be available in the first session. +;; Top-level side effects: agenda hooks plus guarded idle cache build. ;; Runtime requires: user-constants, system-lib, cj-cache-lib. ;; Direct test load: yes. ;; -;; Performance: -;; - Caches agenda file list to avoid scanning projects directory on every view -;; - Cache builds asynchronously 10 seconds after Emacs startup (non-blocking) -;; - First agenda view uses cache if ready, otherwise builds synchronously -;; - Subsequent views are instant (cached) -;; - Cache auto-refreshes after 1 hour -;; - Manual refresh: M-x cj/org-agenda-refresh-files (e.g., after adding projects) +;; Org agenda configuration for global, project-scoped, and buffer-scoped task +;; views. F8 opens the main agenda; modified F8 bindings narrow by project, +;; current buffer, or task list. ;; -;; Agenda views are tied to the F8 (fate) key. -;; -;; "We are what we repeatedly do. -;; Excellence, then, is not an act, but a habit" -;; -- Aristotle -;; -;; "...watch your actions, they become habits; -;; watch your habits, they become character; -;; watch your character, for it becomes your destiny." -;; -- Lao Tzu -;; -;; -;; f8 - MAIN AGENDA which organizes all tasks and events into: -;; - all unfinished priority A tasks -;; - the weekly schedule, including the habit consistency graph -;; - all priority B tasks -;; -;; C-f8 - PROJECT AGENDA showing the main agenda filtered to a single project. -;; Prompts for project selection, then shows overdue/hi-pri/schedule/B tasks -;; scoped to that project's todo.org plus all calendars and inbox. -;; -;; s-f8 - TASK LIST containing all tasks from all agenda targets. -;; -;; M-f8 - TASK LIST containing all tasks from just the current org-mode buffer. -;; -;; NOTE: -;; Files that contain information relevant to the agenda will be found in the -;; following places: the schedule-file, org-roam notes tagged as 'Projects' and -;; project todo.org files found in project-dir and code-dir. +;; Agenda files come from inbox, schedule files, synced calendars, and immediate +;; project todo.org files. The file list is cached and rebuilt asynchronously to +;; keep normal agenda opens fast. ;;; Code: (require 'user-constants) @@ -58,7 +26,8 @@ (defcustom cj/org-agenda-window-height 0.75 "Fraction of the selected frame used for the org agenda window." - :type 'number) + :type 'number + :group 'org-agenda) (defun cj/--org-agenda-display-rule () "Return the display-buffer rule for the org agenda buffer." @@ -89,6 +58,12 @@ (setq org-agenda-skip-scheduled-if-done nil) (setq org-agenda-remove-tags t) (setq org-agenda-compact-blocks t) + ;; Backstop against a non-existent agenda file (e.g. a calendar not yet synced + ;; on a fresh machine): skip it silently instead of prompting to create it -- + ;; the interactive-prompt class that once hung the chime daemon. + ;; `cj/--org-agenda-base-files' already filters the list; this catches any path + ;; that reaches `org-agenda-files' another way. + (setq org-agenda-skip-unavailable-files t) ;; display the agenda from the bottom (add-to-list 'display-buffer-alist @@ -177,13 +152,24 @@ Only checks DIRECTORY/*/todo.org — does not recurse deeper." ;; ---------------------------- Rebuild Org Agenda --------------------------- ;; builds the org agenda list from all agenda targets with caching. -;; agenda targets is the schedule, contacts, project todos, -;; inbox, and org roam projects. +;; agenda targets are the inbox, the schedule, the synced calendars, +;; and the per-project todo.org files under projects-dir. +(defun cj/--org-agenda-base-files () + "Return the existing base files for the agenda: inbox, schedule, and calendars. +The single source of the base list shared by the agenda builders and the chime +initializer, so adding a calendar source is a one-place change. Per-project +todo.org files are layered on separately. Files that do not exist are dropped +\(a fresh machine may lack the synced calendars or the inbox) so org-agenda +never prompts to create them -- the interactive-prompt class that once hung the +chime daemon; `org-agenda-skip-unavailable-files' is the backstop." + (seq-filter #'file-exists-p + (list inbox-file schedule-file gcal-file pcal-file dcal-file))) + (defun cj/--org-agenda-scan-files () "Scan disk for the agenda files list. Pure-ish: no caching, no logging. Returns the list to assign to `org-agenda-files'. Slow -- walks `projects-dir' for per-project todo.org files." - (let ((files (list inbox-file schedule-file gcal-file pcal-file dcal-file))) + (let ((files (cj/--org-agenda-base-files))) ;; cj/add-files-to-org-agenda-files-list mutates org-agenda-files; let-bind ;; it for the duration of the helper, then return whatever it produced. (let ((org-agenda-files files)) @@ -236,8 +222,8 @@ Bypasses cache and scans directories from scratch." (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. -The contents of the agenda will be built from org-project-files and org-roam -files that have project in their filetag." +The contents of the agenda are built from the base files (inbox, schedule, and +the synced calendars) plus the per-project todo.org files under projects-dir." (interactive) (cj/build-org-agenda-list) (org-agenda "a" "t")) @@ -262,9 +248,7 @@ scoped to that project's todo.org plus calendars, schedule, and inbox." (chosen (completing-read "Show agenda for project: " project-names nil t)) (todo-file (expand-file-name "todo.org" (expand-file-name chosen projects-dir))) - (org-agenda-files (list todo-file - inbox-file schedule-file - gcal-file pcal-file dcal-file))) + (org-agenda-files (cons todo-file (cj/--org-agenda-base-files)))) (org-agenda "a" "d"))) (global-set-key (kbd "C-<f8>") #'cj/todo-list-single-project) @@ -289,9 +273,6 @@ If the current buffer isn't an org buffer, inform the user." (defvar cj/main-agenda-hipri-title "HIGH PRIORITY UNRESOLVED TASKS" "String to announce the high priority section of the main agenda.") -(defvar cj/main-agenda-overdue-title "OVERDUE" - "String to announce the overdue section of the main agenda.") - (defvar cj/main-agenda-schedule-title "SCHEDULE" "String to announce the schedule section of the main agenda.") @@ -322,28 +303,6 @@ lands in one place.") subtree-end nil))) -(defun cj/org-agenda-skip-subtree-if-not-overdue () - "Skip an agenda subtree if it is not an overdue deadline or scheduled task. -An entry is considered overdue if it has a scheduled or deadline date strictly -before today, is not marked as done, and is not a habit." - (let* ((subtree-end (save-excursion (org-end-of-subtree t))) - (todo-state (org-get-todo-state)) - (style (org-entry-get nil "STYLE")) - (deadline (org-entry-get nil "DEADLINE")) - (scheduled (org-entry-get nil "SCHEDULED")) - (today (org-time-string-to-absolute (format-time-string "%Y-%m-%d"))) - (deadline-day (and deadline (org-time-string-to-absolute deadline))) - (scheduled-day (and scheduled (org-time-string-to-absolute scheduled)))) - (if (or (not todo-state) ; no todo keyword - (member todo-state org-done-keywords) ; done/completed tasks - (string= style "habit")) - subtree-end ; skip if done or habit - (let ((overdue (or (and deadline-day (< deadline-day today)) - (and scheduled-day (< scheduled-day today))))) - (if overdue - nil ; do not skip, keep this entry - subtree-end))))) ; skip if not overdue - (defun cj/org-skip-subtree-if-priority (priority) "Skip an agenda subtree if it has a priority of PRIORITY. PRIORITY may be one of the characters ?A, ?B, or ?C." @@ -364,19 +323,7 @@ KEYWORDS must be a list of strings." (setq org-agenda-custom-commands '(("d" "Daily Agenda with Tasks" - ((alltodo "" - ((org-agenda-skip-function #'cj/org-agenda-skip-subtree-if-not-overdue) - (org-agenda-overriding-header cj/main-agenda-overdue-title) - (org-agenda-prefix-format cj/--main-agenda-prefix-format))) - (tags "PRIORITY=\"A\"" - ((org-agenda-skip-function '(org-agenda-skip-entry-if 'todo 'done)) - (org-agenda-overriding-header cj/main-agenda-hipri-title) - (org-agenda-prefix-format cj/--main-agenda-prefix-format))) - (todo "VERIFY" - ((org-agenda-skip-function 'cj/org-skip-subtree-if-habit) - (org-agenda-overriding-header cj/main-agenda-verify-title) - (org-agenda-prefix-format cj/--main-agenda-prefix-format))) - (agenda "" + ((agenda "" ((org-agenda-start-day "0d") (org-agenda-span 8) (org-agenda-start-on-weekday nil) @@ -386,6 +333,14 @@ KEYWORDS must be a list of strings." '(org-agenda-skip-entry-if 'todo '("CANCELLED"))) (org-agenda-overriding-header cj/main-agenda-schedule-title) (org-agenda-prefix-format cj/--main-agenda-prefix-format))) + (tags "PRIORITY=\"A\"" + ((org-agenda-skip-function '(org-agenda-skip-entry-if 'todo 'done)) + (org-agenda-overriding-header cj/main-agenda-hipri-title) + (org-agenda-prefix-format cj/--main-agenda-prefix-format))) + (todo "VERIFY" + ((org-agenda-skip-function 'cj/org-skip-subtree-if-habit) + (org-agenda-overriding-header cj/main-agenda-verify-title) + (org-agenda-prefix-format cj/--main-agenda-prefix-format))) (todo "DOING" ((org-agenda-skip-function 'cj/org-skip-subtree-if-habit) (org-agenda-overriding-header cj/main-agenda-doing-title) @@ -409,8 +364,7 @@ This uses all org-agenda targets and presents three sections: - Today's schedule, including habits with consistency graphs - All priority B and C unscheduled/undeadlined tasks The agenda is rebuilt from all sources before display, including: -- inbox-file and schedule-file -- Org-roam nodes tagged as \"Project\" +- inbox-file, schedule-file, and the synced calendars - All todo.org files in immediate subdirectories of projects-dir" (interactive) (cj/build-org-agenda-list) @@ -453,7 +407,7 @@ This allows a line to show in an agenda without being scheduled or a deadline." :init ;; Initialize org-agenda-files with base files before chime loads ;; The full list will be built asynchronously later - (setq org-agenda-files (list inbox-file schedule-file gcal-file pcal-file dcal-file)) + (setq org-agenda-files (cj/--org-agenda-base-files)) ;; Debug mode (keep set to nil, but available for troubleshooting) (setq chime-debug nil) diff --git a/modules/org-babel-config.el b/modules/org-babel-config.el index 821403a0d..bc7ccb806 100644 --- a/modules/org-babel-config.el +++ b/modules/org-babel-config.el @@ -29,6 +29,12 @@ (setq org-src-fontify-natively t) ;; fontify the code in blocks (setq org-src-tab-acts-natively t) ;; tabs act like in language major mode buffer (setq org-src-window-setup 'current-window) ;; don't split window when source editing wih C-c ' + ;; Treat cj comment blocks (#+begin_src cj: comment ...) as org for editing + ;; and fontification: the "cj:" language token maps to org-mode, so C-c ' + ;; opens an org buffer and the block's prose gets org font-lock in place. + ;; The block stays a src block (the cj: grep marker is unchanged); org markup + ;; is highlighted and editable, though links are followed from the C-c ' buffer. + (add-to-list 'org-src-lang-modes '("cj:" . org)) (setq org-confirm-babel-evaluate t) ;; confirm before running babel; toggle with C-; k (setq org-babel-default-header-args (cons '(:tangle . "yes") diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index 43b42b5e7..9f5bfbe7f 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -30,6 +30,7 @@ (defvar org-complex-heading-regexp-format) (declare-function cj/--drill-pick-file "org-drill-config") +(declare-function cj/org-capture--date-prefix "org-capture-config") (declare-function org-at-encrypted-entry-p "org-crypt") (declare-function org-at-heading-p "org") (declare-function org-back-to-heading "org") @@ -42,6 +43,8 @@ (declare-function org-get-heading "org") (declare-function org-parse-time-string "org") (declare-function pdf-view-active-region-text "pdf-view") +(declare-function projectile-project-root "projectile" (&optional dir)) +(defvar inbox-file) (defvar cj/org-capture--file-headline-target-cache (make-hash-table :test #'equal) "Cache Org capture file+headline target markers by expanded file and headline.") @@ -74,6 +77,21 @@ "Return the cache key for PATH and HEADLINE." (list (org-capture-expand-file path) headline)) +(defun cj/--org-find-or-create-top-heading (search-regexp heading-line) + "Move point to the top-level heading matched by SEARCH-REGEXP in this buffer. +Search from the start of the buffer; on a match leave point at the start of +that heading line. With no match, append HEADING-LINE (a full \"* ...\" line, +without a trailing newline) at the end of the buffer and leave point on it. +Returns point." + (goto-char (point-min)) + (if (re-search-forward search-regexp nil t) + (forward-line 0) + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert heading-line "\n") + (forward-line -1)) + (point)) + (defun cj/org-capture--goto-file-headline (path headline) "Move to capture target PATH and HEADLINE, using a cached marker when valid. This implements Org's `file+headline' target positioning behavior, but avoids @@ -92,15 +110,9 @@ re-scanning large target files after the first successful lookup." (marker (gethash key cj/org-capture--file-headline-target-cache))) (if (cj/org-capture--headline-marker-valid-p marker headline) (goto-char marker) - (goto-char (point-min)) - (if (re-search-forward (format org-complex-heading-regexp-format - (regexp-quote headline)) - nil t) - (forward-line 0) - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - (insert "* " headline "\n") - (forward-line -1)) + (cj/--org-find-or-create-top-heading + (format org-complex-heading-regexp-format (regexp-quote headline)) + (concat "* " headline)) (puthash key (copy-marker (point)) cj/org-capture--file-headline-target-cache)))) @@ -132,6 +144,78 @@ re-scanning large target files after the first successful lookup." (advice-add 'org-capture-set-target-location :around #'cj/org-capture--set-target-location-advice)) +;; ----------------------- Project-Aware Capture Target ------------------------ +;; C-c c t (Task) and C-c c b (Bug) file into the current projectile project's +;; todo.org under its "... Open Work" heading. Outside a project they fall back +;; to the global inbox; in a project with no todo.org they fall back to the +;; inbox with a warning (they never create a project's todo.org). + +(defconst cj/--org-open-work-heading-regexp + "^\\*[ \t]+.*Open Work\\(?:[ \t]+:[^\n]*:\\)?[ \t]*$" + "Regexp matching a top-level \"... Open Work\" Org heading line.") + +(defun cj/--org-capture-project-name (root) + "Return a display project name for ROOT directory, or nil. +The basename of ROOT with a single leading dot stripped and the first +letter upcased: \"~/.emacs.d/\" -> \"Emacs.d\", \"~/code/duet/\" -> \"Duet\"." + (when (and (stringp root) (not (string-empty-p root))) + (let* ((base (file-name-nondirectory (directory-file-name root))) + (clean (if (and (> (length base) 1) (eq ?. (aref base 0))) + (substring base 1) + base))) + (and (not (string-empty-p clean)) + (concat (upcase (substring clean 0 1)) (substring clean 1)))))) + +(defun cj/--org-capture-project-target (root inbox) + "Pure capture-target decision for project-aware capture. +ROOT is the projectile project root (or nil); INBOX is the global inbox +file path. Return a plist (:file F :open-work BOOL :project NAME :warn MSG): +- ROOT with a todo.org -> F is that todo.org, :open-work t. +- ROOT without a todo.org -> F is INBOX, :open-work nil, :warn names project. +- ROOT nil -> F is INBOX, :open-work nil, :warn nil." + (if (and (stringp root) (not (string-empty-p root))) + (let ((todo (expand-file-name "todo.org" root)) + (name (cj/--org-capture-project-name root))) + (if (file-exists-p todo) + (list :file todo :open-work t :project name :warn nil) + (list :file inbox :open-work nil :project name + :warn (format "No todo.org in project \"%s\"; captured to the inbox instead" + name)))) + (list :file inbox :open-work nil :project nil :warn nil))) + +(defun cj/--org-capture-goto-open-work (project-name) + "Move point to a top-level \"... Open Work\" heading in the current buffer. +Create \"* PROJECT-NAME Open Work\" at end of buffer when none exists. +Leave point at the start of the heading line." + (cj/--org-find-or-create-top-heading + cj/--org-open-work-heading-regexp + (format "* %s Open Work" project-name))) + +(defun cj/--org-capture-goto-exact-headline (headline) + "Move point to the top-level HEADLINE in the current buffer. +Create \"* HEADLINE\" at end of buffer when absent. Leave point at the +start of the heading line." + (cj/--org-find-or-create-top-heading + (format org-complex-heading-regexp-format (regexp-quote headline)) + (concat "* " headline))) + +(defun cj/--org-capture-project-location () + "Org-capture `function' target for project-aware Task/Bug capture. +File into the current projectile project's todo.org under its \"... Open +Work\" heading, else the global inbox (`inbox-file') under \"Inbox\"." + (let* ((root (and (fboundp 'projectile-project-root) + (ignore-errors (projectile-project-root)))) + (plan (cj/--org-capture-project-target root inbox-file))) + (when (plist-get plan :warn) + (message "%s" (plist-get plan :warn))) + (set-buffer (org-capture-target-buffer (plist-get plan :file))) + (unless (derived-mode-p 'org-mode) (org-mode)) + (org-capture-put-target-region-and-position) + (widen) + (if (plist-get plan :open-work) + (cj/--org-capture-goto-open-work (plist-get plan :project)) + (cj/--org-capture-goto-exact-headline "Inbox")))) + ;; --------------------------- Org-Capture Templates --------------------------- ;; you can bring up the org capture menu with C-c c @@ -201,9 +285,12 @@ Intended to be called within an org capture template." ;; ORG-CAPTURE TEMPLATES (setq org-protocol-default-template-key "L") (setq org-capture-templates - '(("t" "Task" entry (file+headline inbox-file "Inbox") + '(("t" "Task" entry (function cj/--org-capture-project-location) "* TODO %?" :prepend t) + ("b" "Bug" entry (function cj/--org-capture-project-location) + "* TODO [#C] %?" :prepend t) + ("e" "Event" entry (file+headline schedule-file "Scheduled Events") "* %?%:description SCHEDULED: %^t%(cj/org-capture-event-content) @@ -257,5 +344,104 @@ Captured On: %U" :prepend t) )) ;; end setq ) ;; end use-package org-protocol +;; ---------------------- Popup Capture Frame Auto-Close ---------------------- +;; The quick-capture script (Hyprland Super+Shift+N) opens an emacsclient +;; frame named "org-capture"; Hyprland window rules float and center it by +;; that name. These hooks close the frame when the capture finalizes or +;; aborts, so the popup never lingers. Frames not named "org-capture" are +;; untouched — normal in-Emacs captures keep their windows. + +(defun cj/org-capture--popup-frame-p () + "Return non-nil when the selected frame is the quick-capture popup." + (equal (frame-parameter nil 'name) "org-capture")) + +(defun cj/org-capture--delete-popup-frame () + "Delete the current frame when it is the quick-capture popup." + (when (cj/org-capture--popup-frame-p) + (delete-frame))) + +(add-hook 'org-capture-after-finalize-hook #'cj/org-capture--delete-popup-frame) + +;; The popup opens a fresh emacsclient frame still showing the daemon's last +;; buffer. `org-mks' shows the *Org Select* menu via +;; `switch-to-buffer-other-window', and `org-capture-place-template' shows the +;; CAPTURE-* buffer via `pop-to-buffer' with a split action — both split the +;; small floating frame, so two reverse-video modelines read like tmux bars and +;; the working buffer leaks into a popup that should only show capture UI. A +;; frame-scoped `display-buffer-alist' entry forces both into the frame's sole +;; window. Gated on the "org-capture" frame name, so normal in-Emacs captures +;; keep their windows. + +(defun cj/org-capture--popup-sole-window-p (frame-name buffer-name) + "Return non-nil when BUFFER-NAME in a frame named FRAME-NAME is capture popup UI. +Capture popup UI is the *Org Select* template menu or a CAPTURE-* buffer +shown in the quick-capture frame (FRAME-NAME equal to \"org-capture\")." + (and (equal frame-name "org-capture") + (stringp buffer-name) + (or (equal buffer-name "*Org Select*") + (string-prefix-p "CAPTURE-" buffer-name)))) + +(defun cj/org-capture--popup-display-condition (buffer-name &optional _action) + "`display-buffer' CONDITION matching capture UI in the quick-capture popup. +BUFFER-NAME is the buffer's name; the selected frame supplies the frame name." + (cj/org-capture--popup-sole-window-p (frame-parameter nil 'name) buffer-name)) + +(defun cj/org-capture--display-sole-window (buffer _alist) + "`display-buffer' ACTION showing BUFFER as the only window of the frame. +Used for the quick-capture popup so the template menu and capture buffer +never split the small floating frame." + (let ((window (frame-root-window))) + (delete-other-windows window) + (set-window-buffer window buffer) + window)) + +(add-to-list 'display-buffer-alist + '(cj/org-capture--popup-display-condition + cj/org-capture--display-sole-window)) + +;; The desktop quick-capture popup is launched globally (no browser selection, +;; no mu4e message, no pdf/epub buffer), so the context-dependent templates make +;; no sense there. `cj/quick-capture' captures a single Task straight into the +;; global inbox -- no template menu -- under its "Inbox" headline, since a +;; desktop capture has no meaningful project context. It closes the popup frame +;; on every exit path (abort, error, finalize): `org-capture' runs +;; `org-capture-after-finalize-hook' only on a completed capture, so a C-g or an +;; erroring template would otherwise orphan the frame. The Hyprland script +;; calls this instead of `org-capture'. + +(defun cj/--quick-capture-template (inbox) + "Return the desktop quick-capture template: a single Task into INBOX's Inbox. +INBOX is the inbox file path; the Task files under its \"Inbox\" headline." + (list (list "t" "Task" 'entry + (list 'file+headline inbox "Inbox") + "* TODO %?" :prepend t))) + +(defun cj/org-capture--popup-frame () + "Return a live frame named \"org-capture\" (the quick-capture popup), or nil." + (seq-find (lambda (f) + (and (frame-live-p f) + (equal (frame-parameter f 'name) "org-capture"))) + (frame-list))) + +(defun cj/quick-capture () + "Org-capture entry point for the Hyprland desktop popup (frame \"org-capture\"). +Captures a single Task into the global inbox, with no template menu. +Closes the popup frame on abort or error so a stray launch never orphans it. + +Selects the \"org-capture\" frame by name before capturing rather than trusting +the ambient selected frame: the launching =emacsclient -c -e= runs before +Hyprland settles focus on the new float, so =(selected-frame)= is still the +daemon's main frame and the capture would otherwise land there." + (interactive) + (let ((frame (cj/org-capture--popup-frame))) + (condition-case err + (progn + (when frame (select-frame-set-input-focus frame)) + (let ((org-capture-templates (cj/--quick-capture-template inbox-file))) + (org-capture nil "t"))) + (quit (cj/org-capture--delete-popup-frame)) + (error (message "Quick-capture: %s" (error-message-string err)) + (cj/org-capture--delete-popup-frame))))) + (provide 'org-capture-config) ;;; org-capture-config.el ends here. diff --git a/modules/org-config.el b/modules/org-config.el index d2a0be34f..f316ee0df 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -17,6 +17,72 @@ (require 'keybindings) ;; provides cj/custom-keymap (used in :init below) +;; Declare org variables and functions used before org is loaded so this module +;; byte-compiles standalone. Plain `defvar' (no value) marks the symbol special +;; without assigning anything, so org's own defaults still apply at runtime. +(defvar org-dir) +(defvar org-mode-map) +(defvar org-mouse-map) +(defvar org-modules) +(defvar org-startup-folded) +(defvar org-cycle-open-archived-trees) +(defvar org-cycle-hide-drawers) +(defvar org-id-locations-file) +(defvar org-return-follows-link) +(defvar org-list-allow-alphabetical) +(defvar org-startup-indented) +(defvar org-adapt-indentation) +(defvar org-startup-with-inline-images) +(defvar org-image-actual-width) +(defvar org-yank-image-save-method) +(defvar org-bookmark-names-plist) +(defvar org-file-apps) +(defvar org-ellipsis) +(defvar org-hide-emphasis-markers) +(defvar org-hide-leading-stars) +(defvar org-pretty-entities) +(defvar org-pretty-entities-include-sub-superscripts) +(defvar org-fontify-emphasized-text) +(defvar org-fontify-whole-heading-line) +(defvar org-tags-column) +(defvar org-agenda-tags-column) +(defvar org-todo-keywords) +(defvar org-highest-priority) +(defvar org-lowest-priority) +(defvar org-default-priority) +(defvar org-enforce-todo-dependencies) +(defvar org-enforce-todo-checkbox-dependencies) +(defvar org-deadline-warning-days) +(defvar org-treat-insert-todo-heading-as-state-change) +(defvar org-log-into-drawer) +(defvar org-log-done) +(defvar org-use-property-inheritance) + +(declare-function org-current-level "org") +(declare-function org-add-planning-info "org") +(declare-function org-get-heading "org") +(declare-function org-edit-headline "org") +(declare-function org-priority "org") +(declare-function org-heading-components "org") +(declare-function org-todo "org") +(declare-function org-get-todo-state "org") +(declare-function org-back-to-heading "org") +(declare-function org-sort-entries "org") +(declare-function org-eval-in-calendar "org") +(declare-function org-open-at-point "org") +(declare-function org-backward-heading-same-level "org") +(declare-function org-forward-heading-same-level "org") +(declare-function org-reveal "org") +(declare-function org-show-todo-tree "org") +(declare-function org-fold-show-all "org-fold") +(declare-function outline-next-heading "outline") +(declare-function org-element-cache-reset "org-element") +(declare-function org-element-context "org-element") +(declare-function org-element-type "org-element-ast") +(declare-function org-superstar-configure-like-org-bullets "org-superstar") +(declare-function cj/--org-follow-link-same-window "org-config") +(declare-function cj/org-follow-link-at-mouse-same-window "org-config") + ;; ---------------------------- Org General Settings --------------------------- (defun cj/org-general-settings () @@ -44,9 +110,6 @@ (setq org-startup-indented t) ;; load org files indented (setq org-adapt-indentation t) ;; adapt indentation to outline node level - ;; TASK: this variable doesn't exist. Remove - ;; (setq org-indent-indentation-per-level 2) ;; indent two character-widths per level - ;; IMAGES / MEDIA (setq org-startup-with-inline-images t) ;; preview images by default (setq org-image-actual-width '(500)) ;; keep image sizes in check @@ -63,23 +126,8 @@ ;; -------------------------- Org Appearance Settings -------------------------- (defun cj/org-appearance-settings() - "Set foreground, background, and font styles for org mode." + "Set org-mode appearance options (org faces are left to the theme)." (interactive) - ;; org-hide should use fix-pitch to align indents for proportional fonts - (set-face-attribute 'org-hide nil :inherit 'fixed-pitch) - (set-face-attribute 'org-meta-line nil :inherit 'shadow) - - ;; Remove foreground and background from block faces - (set-face-attribute 'org-block nil :foreground 'unspecified :background 'unspecified) - (set-face-attribute 'org-block-begin-line nil :foreground 'unspecified :background 'unspecified) - (set-face-attribute 'org-block-end-line nil :foreground 'unspecified :background 'unspecified) - - ;; Get rid of the background on column views - (set-face-attribute 'org-column nil :background 'unspecified) - (set-face-attribute 'org-column-title nil :background 'unspecified) - - ;; make sure org-links are underlined - (set-face-attribute 'org-link nil :underline t) (setq org-ellipsis " ▾") ;; change ellipses to down arrow (setq org-hide-emphasis-markers t) ;; hide emphasis markers (org-appear shows them when editing) @@ -147,6 +195,72 @@ edge, less the tag width.") (add-hook 'org-mode-hook #'cj/org--manage-tag-display-prop) (font-lock-add-keywords 'org-mode cj/org-right-align-tags-keyword t) +;; ------------------------ Org Table Header Highlighting -------------------- +;; Org faces the whole table -- header rows included -- with `org-table'; it has +;; no in-buffer header-row face. `org-table-header' is used only by the sticky +;; header line of `org-table-header-line-mode'. This font-lock keyword prepends +;; `org-table-header' onto a table's header rows (the non-hline rows above its +;; first hline), so the themed header style lands in place in the buffer. + +(declare-function org-at-table-p "org") +(declare-function org-at-table-hline-p "org") +(declare-function org-table-begin "org-table") +(declare-function org-table-end "org-table") + +(defcustom cj/org-fontify-table-headers t + "When non-nil, highlight org table header rows with the `org-table-header' face. +A header row is a non-hline table row above its table's first hline. Org has no +in-buffer header-row face of its own, so this supplies one, deferring its whole +appearance to the themed `org-table-header' face." + :type 'boolean + :group 'org) + +(defun cj/--org-table-first-hline-position () + "Return the start position of the first hline in the table at point, or nil. +Point must be inside an org table." + (save-excursion + (let ((end (org-table-end)) + (found nil)) + (goto-char (org-table-begin)) + (while (and (not found) (< (point) end)) + (when (org-at-table-hline-p) + (setq found (line-beginning-position))) + (forward-line 1)) + found))) + +(defun cj/--org-table-header-row-p () + "Return non-nil if the line at point is a header row of its org table. +A header row is a non-hline table row positioned above the table's first hline. +A table with no hline has no header rows." + (and (org-at-table-p) + (not (org-at-table-hline-p)) + (let ((hline (cj/--org-table-first-hline-position))) + (and hline (< (line-beginning-position) hline))))) + +(defun cj/--org-fontify-table-header-matcher (limit) + "Font-lock matcher for the next org table header row before LIMIT. +Returns non-nil when a header row is found, with match group 0 spanning the +whole row line." + (let (beg end found) + (while (and (not found) + (re-search-forward "^[ \t]*|.*$" limit t)) + (setq beg (match-beginning 0) + end (match-end 0)) + (save-excursion + (goto-char beg) + (when (cj/--org-table-header-row-p) + (setq found t)))) + (when found + (set-match-data (list beg end)) + t))) + +(defconst cj/org-table-header-keyword + '((cj/--org-fontify-table-header-matcher (0 'org-table-header prepend))) + "Font-lock keyword prepending `org-table-header' onto org table header rows.") + +(when cj/org-fontify-table-headers + (font-lock-add-keywords 'org-mode cj/org-table-header-keyword t)) + ;; ----------------------------- Org TODO Settings --------------------------- (defun cj/org-todo-settings () @@ -158,29 +272,12 @@ edge, less the tag width.") "DELEGATED(x)" "|" "FAILED(f!)" "DONE(d!)" "CANCELLED(c!)"))) - ;; Keyword and priority colors come from the active theme's dupre-org-* - ;; faces (themes/dupre-faces.el) rather than hard-coded color names, so they - ;; match the palette and dim with the rest of an unfocused window - ;; (auto-dim-config.el remaps each to its -dim variant). - (setq org-todo-keyword-faces - '(("TODO" . dupre-org-todo) - ("PROJECT" . dupre-org-project) - ("DOING" . dupre-org-doing) - ("WAITING" . dupre-org-waiting) - ("VERIFY" . dupre-org-verify) - ("STALLED" . dupre-org-stalled) - ("DELEGATED" . dupre-org-todo) - ("FAILED" . dupre-org-failed) - ("DONE" . dupre-org-done) - ("CANCELLED" . dupre-org-done))) - + ;; Keyword and priority faces are defined and wired in org-faces-config.el + ;; (loaded just after this module): each keyword and priority maps to its own + ;; org-faces-* face, which the active theme recolors. (setq org-highest-priority ?A) (setq org-lowest-priority ?D) (setq org-default-priority ?D) - (setq org-priority-faces '((?A . dupre-org-priority-a) - (?B . dupre-org-priority-b) - (?C . dupre-org-priority-c) - (?D . dupre-org-priority-d))) (setq org-enforce-todo-dependencies t) (setq org-enforce-todo-checkbox-dependencies t) @@ -219,14 +316,14 @@ edge, less the tag width.") (keymap-set cj/org-map "<" #'cj/org-narrow-backwards) ;; Sparse trees: lowercase creates, capital of the same letter cancels. - ;; Both `S' and `T' resolve to `org-show-all' -- same cancel command, + ;; Both `S' and `T' resolve to `org-fold-show-all' -- same cancel command, ;; paired with each lowercase create so the mental model is "capital ;; cancels the lowercase command I just ran" without having to recall ;; which letter the cancel actually lives on. (keymap-set cj/org-map "s" #'org-match-sparse-tree) - (keymap-set cj/org-map "S" #'org-show-all) + (keymap-set cj/org-map "S" #'org-fold-show-all) (keymap-set cj/org-map "t" #'org-show-todo-tree) - (keymap-set cj/org-map "T" #'org-show-all) + (keymap-set cj/org-map "T" #'org-fold-show-all) (keymap-set cj/org-map "R" #'org-reveal) :bind ("C-c c" . org-capture) @@ -242,8 +339,7 @@ edge, less the tag width.") ("C-c N" . org-narrow-to-subtree) ("C-c >" . cj/org-narrow-forward) ("C-c <" . cj/org-narrow-backwards) - ("C-c <ESC>" . widen) - ("C-c C-a" . cj/org-appear-toggle)) + ("C-c <ESC>" . widen)) (:map cj/org-map ("r i" . org-table-insert-row) ("r d" . org-table-kill-row) @@ -370,6 +466,11 @@ especially in tables with long URLs)." (org-appear-mode 1) (message "org-appear enabled (links/emphasis show when editing)"))) +;; Bound here (after the defun) rather than in the org use-package `:bind' so +;; the command isn't autoloaded into a stub that shadows this definition. +(with-eval-after-load 'org + (keymap-set org-mode-map "C-c C-a" #'cj/org-appear-toggle)) + ;; --------------------------------- Org-Tidy ---------------------------------- ;; Hide :PROPERTIES: drawers behind a small inline marker so headings stay @@ -413,7 +514,7 @@ with a file, the function will throw an error." "Clear the org-element cache for the current buffer or all buffers. By default, clear cache for all org buffers. With prefix argument, clear only the current buffer's cache. Useful when encountering parsing errors like -'wrong-type-argument stringp nil' during agenda generation." +\"wrong-type-argument stringp nil\" during agenda generation." (interactive) (if current-prefix-arg (if (derived-mode-p 'org-mode) diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index d558245b6..944d75c10 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -22,6 +22,36 @@ (require 'user-constants) +;; Function declarations -- these live in lazily-loaded packages, so the +;; byte-compiler can't see their definitions when this module compiles +;; standalone. +(declare-function org-contacts-db "org-contacts") +(declare-function org-contacts-anniversaries "org-contacts") +(declare-function org-contacts-files "org-contacts") +(declare-function org-columns "org-colview") +(declare-function org-reveal "org") +(declare-function org-fold-show-entry "org-fold") +(declare-function org-heading-components "org") +(declare-function org-map-entries "org") +(declare-function org-entry-get "org") +(declare-function outline-next-heading "outline") +(declare-function calendar-current-date "calendar") +(declare-function mu4e-message-at-point "mu4e-message") +(declare-function mu4e-message-field "mu4e-message") +(declare-function which-key-add-key-based-replacements "which-key") + +;; External package variables referenced below; declared so the compiler +;; treats them as special rather than free. +(defvar org-capture-plist) +(defvar org-capture-templates) +(defvar mu4e~view-message) +(defvar org-agenda-include-diary) +(defvar org-agenda-custom-commands) +(defvar mu4e-org-contacts-file) +(defvar mu4e-headers-actions) +(defvar mu4e-view-actions) +(defvar mu4e-compose-complete-addresses) + ;; Set `org-contacts-files' eagerly at require time. Setting it in the ;; `use-package' form below would only apply when org-contacts loads, which is ;; deferred behind `:after (org mu4e)' -- later than the first @@ -42,10 +72,13 @@ (defun cj/org-contacts-anniversaries-safe () "Safely call org-contacts-anniversaries with required bindings." (require 'diary-lib) - ;; These need to be dynamically bound for diary functions - (defvar date) - (defvar entry) - (defvar original-date) + ;; `date', `entry', and `original-date' are diary special vars that the + ;; diary functions read dynamically. Declare them special locally; the + ;; suppressed warning is the unprefixed-name lint on these calendar names. + (with-suppressed-warnings ((lexical date entry original-date)) + (defvar date) + (defvar entry) + (defvar original-date)) (let ((date (calendar-current-date)) (entry "") (original-date (calendar-current-date))) @@ -115,14 +148,6 @@ Added: %U" :prepare-finalize cj/org-contacts-finalize-birthday-timestamp))) -;; TASK: What purpose did this serve? -;; duplicate?!? -;; (with-eval-after-load 'org-capture -;; (add-to-list 'org-capture-templates -;; '("C" "Contact" entry (file+headline contacts-file "Contacts") -;; "* %(cj/org-contacts-template-name) -;; Added: %U"))) - (defun cj/org-contacts-template-name () "Get name for contact template from context." (or (when (eq major-mode 'mu4e-headers-mode) @@ -143,15 +168,29 @@ Added: %U" ;;; ------------------------- Quick Contact Functions --------------------------- +(require 'system-lib) + (defun cj/org-contacts-find () "Find and open a contact." (interactive) (find-file contacts-file) (goto-char (point-min)) - (let ((contact (completing-read "Find contact: " - (org-map-entries - (lambda () (nth 4 (org-heading-components))) - nil (list contacts-file))))) + (let* ((alist (org-map-entries + (lambda () + (cons (nth 4 (org-heading-components)) + (or (org-entry-get nil "EMAIL") + (org-entry-get nil "PHONE")))) + nil (list contacts-file))) + (contact (completing-read + "Find contact: " + (cj/completion-table-annotated + 'contact + (lambda (cand) + (let ((info (cdr (assoc cand alist)))) + (when (and info (> (length info) 0)) + (concat " " (propertize info 'face + 'completions-annotations))))) + alist)))) (goto-char (point-min)) (search-forward contact) (org-fold-show-entry) @@ -194,9 +233,10 @@ Added: %U" (defun cj/--parse-email-string (name email-string) "Parse EMAIL-STRING and return formatted entries for NAME. -EMAIL-STRING may contain multiple emails separated by commas, semicolons, or spaces. -Returns a list of strings formatted as 'Name <email>'. -Returns nil if EMAIL-STRING is nil or contains only whitespace." +EMAIL-STRING may contain multiple emails separated by commas, +semicolons, or spaces. Returns a list of strings formatted as +\"Name <email>\". Returns nil if EMAIL-STRING is nil or contains only +whitespace." (when (and email-string (string-match-p "[^[:space:]]" email-string)) (let ((emails (split-string email-string "[,;[:space:]]+" t))) (mapcar (lambda (email) diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index 296b0550a..2c6e400e0 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -95,9 +95,12 @@ With a prefix arg OTHER-DIR, prompt for the directory instead of `drill-dir'." (defun cj/drill-refile () "Refile to a drill file." (interactive) - (setq org-refile-targets '((nil :maxlevel . 1) - (drill-dir :maxlevel . 1))) - (call-interactively 'org-refile)) + (let ((org-refile-targets + `((nil :maxlevel . 1) + (,(mapcar (lambda (f) (expand-file-name f drill-dir)) + (cj/--drill-files-or-error drill-dir)) + :maxlevel . 1)))) + (call-interactively 'org-refile))) ;; ------------------------------- Drill Keymap -------------------------------- diff --git a/modules/org-faces-config.el b/modules/org-faces-config.el new file mode 100644 index 000000000..dfbfe9d0d --- /dev/null +++ b/modules/org-faces-config.el @@ -0,0 +1,129 @@ +;;; org-faces-config.el --- Custom faces for the org agenda header row -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 2 (Core UX). +;; Category: C/S. +;; Load shape: eager. +;; Eager reason: the faces must exist before org renders the agenda. +;; Top-level side effects: defines the org-faces-* faces; sets +;; org-todo-keyword-faces and org-priority-faces once org loads. +;; Runtime requires: none (org wiring is deferred via with-eval-after-load). +;; +;; Custom faces for the agenda "header row" -- the TODO keyword and the +;; priority cookie -- so each keyword and each priority is its own themeable +;; element rather than sharing org's built-in org-todo / org-done / org-priority. +;; They are named org-faces-* (not org-*) so it's obvious they are this config's +;; layer, not built-in org. Each carries a real default color so the agenda is +;; legible on any theme; a theme (e.g. one generated by theme-studio's +;; "org-faces" app) overrides them. The -dim variants are the dimmed colors +;; auto-dim-config.el remaps these to in non-selected windows, so keywords stay +;; recognizable when a window recedes. +;; +;; Note: this file is org-faces-CONFIG, not org-faces -- org ships its own +;; `org-faces' feature (lisp/org/org-faces.el), so reusing that name would +;; shadow org's face definitions on the load path. + +;;; Code: + +(eval-when-compile (require 'org)) + +(defgroup org-faces-config nil + "Custom faces for the org agenda header row (keywords and priorities)." + :group 'org) + +;; --------------------------- Keyword faces (focused) ------------------------- + +(defface org-faces-todo '((t (:weight bold))) + "Face for the TODO keyword." :group 'org-faces-config) +(defface org-faces-project '((t (:weight bold))) + "Face for the PROJECT keyword." :group 'org-faces-config) +(defface org-faces-doing '((t (:weight bold))) + "Face for the DOING keyword." :group 'org-faces-config) +(defface org-faces-waiting '((t (:weight bold))) + "Face for the WAITING keyword." :group 'org-faces-config) +(defface org-faces-verify '((t (:weight bold))) + "Face for the VERIFY keyword." :group 'org-faces-config) +(defface org-faces-stalled '((t (:weight bold))) + "Face for the STALLED keyword." :group 'org-faces-config) +(defface org-faces-delegated '((t (:weight bold))) + "Face for the DELEGATED keyword." :group 'org-faces-config) +(defface org-faces-failed '((t (:weight bold))) + "Face for the FAILED keyword." :group 'org-faces-config) +(defface org-faces-done '((t (:weight bold))) + "Face for the DONE keyword." :group 'org-faces-config) +(defface org-faces-cancelled '((t (:weight bold :strike-through t))) + "Face for the CANCELLED keyword." :group 'org-faces-config) + +;; -------------------------- Priority faces (focused) ------------------------- + +(defface org-faces-priority-a '((t (:weight bold))) + "Face for the [#A] priority cookie." :group 'org-faces-config) +(defface org-faces-priority-b '((t ())) + "Face for the [#B] priority cookie." :group 'org-faces-config) +(defface org-faces-priority-c '((t ())) + "Face for the [#C] priority cookie." :group 'org-faces-config) +(defface org-faces-priority-d '((t ())) + "Face for the [#D] priority cookie." :group 'org-faces-config) + +;; ----------------------------- Keyword faces (dim) --------------------------- +;; auto-dim-config.el remaps the focused faces above to these in non-selected +;; windows; a darker shade of the same hue keeps the keyword recognizable. + +(defface org-faces-todo-dim '((t (:weight bold))) + "Dimmed TODO keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-project-dim '((t (:weight bold))) + "Dimmed PROJECT keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-doing-dim '((t (:weight bold))) + "Dimmed DOING keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-waiting-dim '((t (:weight bold))) + "Dimmed WAITING keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-verify-dim '((t (:weight bold))) + "Dimmed VERIFY keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-stalled-dim '((t (:weight bold))) + "Dimmed STALLED keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-delegated-dim '((t (:weight bold))) + "Dimmed DELEGATED keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-failed-dim '((t (:weight bold))) + "Dimmed FAILED keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-done-dim '((t (:weight bold))) + "Dimmed DONE keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-cancelled-dim '((t (:weight bold :strike-through t))) + "Dimmed CANCELLED keyword for non-selected windows." :group 'org-faces-config) + +;; ---------------------------- Priority faces (dim) --------------------------- + +(defface org-faces-priority-a-dim '((t (:weight bold))) + "Dimmed [#A] priority cookie for non-selected windows." :group 'org-faces-config) +(defface org-faces-priority-b-dim '((t ())) + "Dimmed [#B] priority cookie for non-selected windows." :group 'org-faces-config) +(defface org-faces-priority-c-dim '((t ())) + "Dimmed [#C] priority cookie for non-selected windows." :group 'org-faces-config) +(defface org-faces-priority-d-dim '((t ())) + "Dimmed [#D] priority cookie for non-selected windows." :group 'org-faces-config) + +;; ---------------------------------- Wiring ----------------------------------- +;; Map each keyword string and priority char to its face once org is loaded, so +;; the values stick regardless of when org initializes. + +(with-eval-after-load 'org + (setq org-todo-keyword-faces + '(("TODO" . org-faces-todo) + ("PROJECT" . org-faces-project) + ("DOING" . org-faces-doing) + ("WAITING" . org-faces-waiting) + ("VERIFY" . org-faces-verify) + ("STALLED" . org-faces-stalled) + ("DELEGATED" . org-faces-delegated) + ("FAILED" . org-faces-failed) + ("DONE" . org-faces-done) + ("CANCELLED" . org-faces-cancelled))) + (setq org-priority-faces + '((?A . org-faces-priority-a) + (?B . org-faces-priority-b) + (?C . org-faces-priority-c) + (?D . org-faces-priority-d)))) + +(provide 'org-faces-config) +;;; org-faces-config.el ends here diff --git a/modules/org-noter-config.el b/modules/org-noter-config.el index 4e5bd1778..f28f61bb7 100644 --- a/modules/org-noter-config.el +++ b/modules/org-noter-config.el @@ -39,9 +39,32 @@ ;; Forward declarations (declare-function org-id-uuid "org-id") +(declare-function org-entry-get "org") (declare-function nov-mode "ext:nov") (declare-function pdf-view-mode "ext:pdf-view") +;; pdf-tools fit commands (lazily loaded with pdf-tools) +(declare-function pdf-view-fit-width-to-window "pdf-view") +(declare-function pdf-view-fit-height-to-window "pdf-view") +(declare-function pdf-view-fit-page-to-window "pdf-view") +;; face-remap is built in but loaded lazily +(declare-function face-remap-remove-relative "face-remap") +;; org-noter session/sync/skeleton commands (lazily loaded with org-noter) +(declare-function org-noter--get-notes-window "org-noter") +(declare-function org-noter--get-doc-window "org-noter") +(declare-function org-noter-insert-note "org-noter") +(declare-function org-noter-enable-org-roam-integration "org-noter") +(declare-function org-noter-sync-next-note "org-noter") +(declare-function org-noter-sync-prev-note "org-noter") +(declare-function org-noter-sync-current-note "org-noter") +(declare-function org-noter-create-skeleton "org-noter") +(declare-function org-noter-kill-session "org-noter") +(declare-function org-noter-toggle-notes-window-location "org-noter") (defvar nov-file-name) +;; org-noter package variables assigned at session start / config time +(defvar org-noter-notes-window-location) +(defvar org-noter-use-pdftools-link-location) +(defvar org-noter-use-org-id) +(defvar org-noter-use-unique-org-id) ;;; Configuration Variables (defvar cj/org-noter-notes-directory roam-dir @@ -284,7 +307,7 @@ From a PDF/EPUB: starts org-noter session if inactive, then inserts note." (cond ((and active (not cj/org-noter--bg-remap-cookie)) (setq cj/org-noter--bg-remap-cookie - (face-remap-add-relative 'default :background "#1d1b19"))) + (face-remap-add-relative 'default))) ((and (not active) cj/org-noter--bg-remap-cookie) (face-remap-remove-relative cj/org-noter--bg-remap-cookie) (setq cj/org-noter--bg-remap-cookie nil)))))))) diff --git a/modules/org-refile-config.el b/modules/org-refile-config.el index a6b7ac3a4..5f826cacf 100644 --- a/modules/org-refile-config.el +++ b/modules/org-refile-config.el @@ -36,7 +36,8 @@ ;; ----------------------------- Org Refile Targets ---------------------------- ;; sets refile targets -;; - adds project files in org-roam to the refile targets +;; - adds org-roam notes tagged "Topic" to the refile targets +;; (roam "Project" notes were dropped as refile targets 2026-06-24) ;; - adds todo.org files in subdirectories of the code and project directories (defvar cj/--org-refile-targets-cache (cj/cache-make :ttl 3600) @@ -100,11 +101,9 @@ Returns the list to assign to `org-refile-targets'. Slow -- walks (cons schedule-file '(:maxlevel . 1))))) (when (and (fboundp 'cj/org-roam-list-notes-by-tag) (fboundp 'org-roam-node-list)) - (let* ((project-and-topic-files - (append (cj/org-roam-list-notes-by-tag "Project") - (cj/org-roam-list-notes-by-tag "Topic"))) - (file-rule '(:maxlevel . 1))) - (dolist (file project-and-topic-files) + (let ((topic-files (cj/org-roam-list-notes-by-tag "Topic")) + (file-rule '(:maxlevel . 1))) + (dolist (file topic-files) (unless (assoc file new-files) (push (cons file file-rule) new-files))))) (let ((file-rule '(:maxlevel . 1))) diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index fdd9e1fc5..eca867df8 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -27,8 +27,37 @@ (require 'user-constants) +;; Declared special so the `let'-binding in `cj/org-roam-copy-todo-to-today' +;; compiles as a dynamic bind, not a dead lexical local -- otherwise the custom +;; capture template never reaches org-roam-dailies (the foreign-special-var trap). +(defvar org-roam-dailies-capture-templates) + +;; External variables, declared special so byte-compilation doesn't treat them +;; as free references/assignments. Owned by org and org-roam-dailies. +(defvar org-agenda-timegrid-use-ampm) +(defvar org-roam-dailies-map) +(defvar org-last-state) + +;; External functions, declared so the byte-compiler knows they're defined at +;; runtime by their respective packages. +(declare-function org-roam-node-tags "org-roam") +(declare-function org-roam-node-file "org-roam") +(declare-function org-roam-node-list "org-roam") +(declare-function org-roam-dailies--capture "org-roam-dailies") +(declare-function org-capture-get "org-capture") +(declare-function org-at-heading-p "org") +(declare-function org-heading-components "org") +(declare-function org-copy-subtree "org") +(declare-function org-cut-subtree "org") + ;; ---------------------------------- Org Roam --------------------------------- +(defconst cj/--org-roam-dailies-head + "#+FILETAGS: Journal\n#+TITLE: %<%Y-%m-%d>\n" + "Head inserted into a new org-roam daily file. +FILETAGS and TITLE must sit on separate lines so Org parses the +#+TITLE keyword (see `org-roam-dailies-capture-templates').") + (use-package org-roam :defer 1 :commands (org-roam-node-find org-roam-node-insert org-roam-db-autosync-mode) @@ -37,9 +66,9 @@ (org-roam-dailies-directory journals-dir) (org-roam-completion-everywhere t) (org-roam-dailies-capture-templates - '(("d" "default" entry "* %<%I:%M:%S %p %Z> %?" + `(("d" "default" entry "* %<%I:%M:%S %p %Z> %?" :if-new (file+head "%<%Y-%m-%d>.org" - "#+FILETAGS: Journal #+TITLE: %<%Y-%m-%d>")))) + ,cj/--org-roam-dailies-head)))) (org-roam-capture-templates `(("d" "default" plain "%?" @@ -65,8 +94,6 @@ :bind (("C-c n l" . org-roam-buffer-toggle) ("C-c n f" . org-roam-node-find) ("C-c n p" . cj/org-roam-find-node-project) - ("C-c n r" . cj/org-roam-find-node-recipe) - ("C-c n t" . cj/org-roam-find-node-topic) ("C-c n i" . org-roam-node-insert) ("C-c n w" . cj/org-roam-find-node-webclip) :map org-mode-map @@ -75,8 +102,10 @@ ;; org-log-done is set once in org-config.el (cj/org-todo-settings). (setq org-agenda-timegrid-use-ampm t) - (when (fboundp 'cj/build-org-refile-targets) - (cj/build-org-refile-targets)) + ;; Don't build the org-refile targets cache here. org-refile-config.el + ;; already schedules it on a 5s idle timer; doing it in org-roam's :config + ;; (which fires at the 1s :defer) ran the same multi-file scan synchronously + ;; at first idle and froze Emacs on a cold cache. The 5s timer covers it. ;; remove/disable if performance slows ;; (setq org-element-use-cache nil) ;; disables caching org files @@ -180,6 +209,11 @@ created in that subdirectory of `org-roam-directory'." (interactive) (cj/org-roam-find-node "Recipe" "r" (concat roam-dir "templates/recipe.org") "recipes/")) +;; Bound after their defuns (not in the use-package :bind) so the byte-compiler +;; doesn't see both a :bind autoload and the real defun as two definitions. +(keymap-global-set "C-c n r" #'cj/org-roam-find-node-recipe) +(keymap-global-set "C-c n t" #'cj/org-roam-find-node-topic) + ;; ---------------------- Org Capture After Finalize Hook ---------------------- (defun cj/org-roam-add-node-to-agenda-files-finalize-hook () diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 99e837e63..40ceada76 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -5,53 +5,29 @@ ;; Layer: 4 (Optional). ;; Category: O/D/P. ;; Load shape: eager. -;; Eager reason: none; web clipping runs via org-protocol/command, a Phase 4 -;; protocol/command-loaded deferral candidate. +;; Eager reason: none; protocol and direct clipping can load on command. ;; Top-level side effects: org-protocol handler registration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: none. ;; Direct test load: yes. ;; -;; This package provides a seamless "fire-and-forget" workflow for clipping -;; web pages from the browser directly into an Org file using org-protocol -;; and org-web-tools. +;; Captures web pages into Org from org-protocol, EWW, or W3M. The protocol path +;; records URL/title dynamically around org-capture; the direct path clips the +;; current browser buffer. ;; -;; Features: -;; - Browser bookmarklet integration via org-protocol -;; - Automatic conversion to Org format using eww-readable and Pandoc -;; - One-click capture from any web page -;; - Preserves page structure and formatting -;; - Smart heading adjustment (removes page title, demotes remaining headings) -;; -;; Setup: -;; 1. Ensure this file is loaded in your Emacs configuration -;; 2. Make sure emacsclient is configured for org-protocol -;; 3. Add the following bookmarklet to your browser's bookmarks bar: -;; -;; javascript:location.href='org-protocol://webclip?url='+encodeURIComponent(location.href)+'&title='+encodeURIComponent(document.title);void(0); -;; -;; To add the bookmarklet: -;; a. Create a new bookmark in your browser -;; b. Set the name to: Clip to Org (or your preference) -;; c. Set the URL to the JavaScript code above -;; d. Save it to your bookmarks bar for easy access -;; -;; 4. Click the bookmarklet on any web page to clip its content -;; -;; The clipped content will be added to the file specified by `webclipped-file` -;; under the "Webclipped Inbox" heading with proper formatting and metadata. -;; -;; Architecture: -;; - cj/--process-webclip-content: Pure function for content processing -;; - cj/org-protocol-webclip-handler: Handles URL fetching and capture -;; - cj/org-webclipper-EWW: Direct capture from EWW/W3M buffers -;; -;; Requirements: -;; - org-web-tools package -;; - Pandoc installed on your system -;; - Emacs server running (M-x server-start) +;; Content is converted to readable Org, normalized, and filed under the +;; configured webclip inbox heading. ;;; Code: +(declare-function org-web-tools--url-as-readable-org "org-web-tools") +(declare-function org-w3m-copy-for-org-mode "org-w3m") +(declare-function org-eww-copy-for-org-mode "org-eww") +(declare-function org-capture-get "org-capture") +;; Special vars from org-capture / org-protocol / user-constants, loaded at +;; runtime; declared here so standalone byte-compilation does not warn. +(defvar org-capture-templates) +(defvar org-protocol-protocol-alist) +(defvar webclipped-file) ;; Variables for storing org-protocol data (defvar cj/--webclip-url nil @@ -76,7 +52,6 @@ See `cj/--webclip-url' for the binding contract.") (defun cj/webclipper-ensure-initialized () "Ensure webclipper is initialized when first used." (unless cj/webclipper-initialized - ;; Load required packages now (require 'org-protocol) (require 'org-capture) (require 'org-web-tools) diff --git a/modules/pdf-config.el b/modules/pdf-config.el index ca2312307..56b397df3 100644 --- a/modules/pdf-config.el +++ b/modules/pdf-config.el @@ -14,6 +14,22 @@ ;; ;;; Code: +;; ------------------------------- Declarations -------------------------------- + +(declare-function pdf-tools-install "pdf-tools") +(declare-function pdf-view-midnight-minor-mode "pdf-view") +(declare-function pdf-view-enlarge "pdf-view") +(declare-function pdf-view-shrink "pdf-view") +(declare-function pdf-view-next-page "pdf-view") +(declare-function pdf-view-previous-page "pdf-view") +(declare-function image-next-line "image-mode") +(declare-function image-previous-line "image-mode") +(declare-function image-bob "image-mode") +(declare-function image-eob "image-mode") +(declare-function org-store-link "ol") +(declare-function cj/open-file-with-command "system-utils") +(declare-function cj/org-noter-insert-note-dwim "org-noter-config") + ;; --------------------------------- PDF Tools --------------------------------- (use-package pdf-tools @@ -24,7 +40,6 @@ :custom (pdf-view-display-size 'fit-page) (pdf-view-resize-factor 1.1) - (pdf-view-midnight-colors '("#F1D5AC" . "#0F0E06")) ;; fg . bg ;; Avoid searching for unicodes to speed up pdf-tools. ;; ... and yes, 'ligther' is not a typo (pdf-view-use-unicode-ligther nil) @@ -61,9 +76,9 @@ (define-key pdf-view-mode-map "i" #'cj/org-noter-insert-note-dwim) ;; Page change: C-up/C-down go to top of prev/next page (define-key pdf-view-mode-map (kbd "C-<down>") - (lambda () (interactive) (pdf-view-next-page-command) (image-bob))) + (lambda () (interactive) (pdf-view-next-page) (image-bob))) (define-key pdf-view-mode-map (kbd "C-<up>") - (lambda () (interactive) (pdf-view-previous-page-command) (image-eob)))) + (lambda () (interactive) (pdf-view-previous-page) (image-eob)))) ;; ------------------------------ PDF View Restore ----------------------------- diff --git a/modules/pearl-config.el b/modules/pearl-config.el new file mode 100644 index 000000000..52994219b --- /dev/null +++ b/modules/pearl-config.el @@ -0,0 +1,66 @@ +;;; pearl-config.el --- Linear.app integration via pearl -*- lexical-binding: t; -*- +;; author: Craig Jennings <c@cjennings.net> + +;;; Commentary: +;; +;; Layer: 3 (Domain Workflow). +;; Category: D/P. +;; Load shape: deferred (command-loaded). +;; Top-level side effects: package configuration via use-package. +;; Runtime requires: none. +;; Direct test load: no. +;; +;; Near-vanilla pearl setup (local checkout instead of a package archive), in +;; multi-account mode: two Linear workspaces, deepsat (work) and craigjennings +;; (personal), named by Linear's own urlKey. Each account renders to its own +;; Org file, deepsat.pearl.org / craigjennings.pearl.org, so they never collide. +;; `M-x pearl-switch-account' swaps the active one; the mode line shows it. +;; +;; pearl owns its own keymap. `pearl-mode' turns on automatically in any buffer +;; pearl renders (it carries a `#+LINEAR-SOURCE' header) and binds the whole +;; command surface under `pearl-keymap-prefix' (default "C-; L"). This config +;; also binds that same `pearl-prefix-map' globally under C-; L (`:bind-keymap'), +;; so the full command surface is reachable from any buffer; the first press +;; autoloads pearl. `M-x pearl-menu' / `M-x pearl-list-issues' still work too. +;; +;; Authentication: each account reads its key from authinfo.gpg by a distinct +;; login under the api.linear.app host: +;; machine api.linear.app login apikey password lin_api_<deepsat key> +;; machine api.linear.app login pearl-personal password lin_api_<personal key> +;; Generate keys in Linear: Settings -> Security & access -> Personal API keys. + +;;; Code: + +(use-package pearl + :ensure nil ;; local checkout, not from an archive + :load-path "~/code/pearl" + :commands (pearl-menu pearl-list-issues pearl-create-issue + pearl-run-linear-view pearl-switch-account) + ;; Bind pearl's command map globally under C-; L, so the full surface is + ;; reachable from any buffer (not only inside a pearl-rendered one). The + ;; first press autoloads pearl; it's the same `pearl-prefix-map' that + ;; `pearl-mode' binds in-buffer, so behavior is identical everywhere. + :bind-keymap ("C-; L" . pearl-prefix-map) + :custom + ;; Shorten the assignee @-tag to the first name only (e.g. @first instead of + ;; @first_last), trading disambiguation for a tighter tag line. + (pearl-assignee-tag-short t) + ;; Two workspaces, keyed by Linear's urlKey. Each resolves its API key from + ;; authinfo.gpg by its own login (see Commentary), renders to its own Org + ;; file, and carries a default team so create / by-project skip the prompt. + (pearl-accounts + '(("deepsat" + :api-key-source (:auth-source :host "api.linear.app" :user "apikey") + :org-file "~/org/gtd/deepsat.pearl.org" + :default-team-id "9fca2cf6-390c-4102-a9ff-f94a4ed823c5") ;; DeepSat SE + ("craigjennings" + :api-key-source (:auth-source :host "api.linear.app" :user "pearl-personal") + :org-file "~/org/gtd/craigjennings.pearl.org" + :default-team-id "ee285e6c-fcc9-4dd6-9292-c47f2df75b82"))) ;; Pearl + ;; Which workspace pearl opens into. Work is primary; switch per-session at + ;; runtime with `M-x pearl-switch-account' (e.g. to dogfood the personal + ;; "craigjennings" workspace). + (pearl-default-account "deepsat")) + +(provide 'pearl-config) +;;; pearl-config.el ends here diff --git a/modules/prog-c.el b/modules/prog-c.el index dd5d7ace5..294375cb4 100644 --- a/modules/prog-c.el +++ b/modules/prog-c.el @@ -70,7 +70,7 @@ (setq-local fill-column 80) ;; wrap at 80 columns (setq-local comment-auto-fill-only-comments t) ;; only auto-fill inside comments (auto-fill-mode) ;; auto-fill multiline comments - (electric-pair-mode) ;; automatic parenthesis pairing + (electric-pair-local-mode) ;; automatic parenthesis pairing ;; Enable LSP if available (when (and (fboundp 'lsp-deferred) diff --git a/modules/prog-general.el b/modules/prog-general.el index a4be72050..f22f89923 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -59,25 +59,44 @@ (declare-function treesit-auto-add-to-auto-mode-alist "treesit-auto") (declare-function treesit-auto-recipe-lang "treesit-auto") (declare-function highlight-indent-guides-mode "highlight-indent-guides") +(declare-function electric-pair-default-inhibit "elec-pair") +(declare-function yas-reload-all "yasnippet") +(declare-function yas-activate-extra-mode "yasnippet") ;; Forward declarations for treesit-auto variables (defvar treesit-auto-recipe-list) +(defvar electric-pair-inhibit-predicate) ;; Forward declarations for functions defined later in this file -(declare-function cj/find-project-root-file "prog-general") (declare-function cj/project-switch-actions "prog-general") -(declare-function cj/deadgrep--initial-term "prog-general") + +(defun cj/find-project-root-file (regexp) + "Return first file in the current Projectile project root matching REGEXP. + +Match is done against (downcase file) for case-insensitivity. +REGEXP must be a string or an rx form." + (when-let ((root (projectile-project-root))) + (seq-find (lambda (file) + (string-match-p (if (stringp regexp) + regexp + (rx-to-string regexp)) + (downcase file))) + (directory-files root)))) (declare-function cj/highlight-indent-guides-disable-in-non-prog-modes "prog-general") ;; --------------------- General Programming Mode Settings --------------------- ;; keybindings, minor-modes, and prog-mode settings +;; Set the line-number type and width before any prog buffer enables +;; display-line-numbers-mode. Setting them inside the hook ran after the mode +;; turned on, so the first prog buffer of a session got absolute numbers. +(setq display-line-numbers-type 'relative) ;; numbers relative to point +(setq-default display-line-numbers-width 3) ;; 3 chars reserved for numbers + (defun cj/general-prog-settings () "Keybindings, minor modes, and settings for programming mode." (interactive) (display-line-numbers-mode) ;; show line numbers - (setq display-line-numbers-type 'relative) ;; display numbers relative to 'the point' - (setq-default display-line-numbers-width 3) ;; 3 characters reserved for line numbers (turn-on-visual-line-mode) ;; word-wrapping (auto-fill-mode) ;; auto wrap at the fill column set (local-set-key (kbd "M-;") 'comment-dwim) ;; comment/uncomment region as appropriate @@ -173,19 +192,6 @@ reuses the current window otherwise, matching `cj/open-project-root-todo'." :config (require 'seq) - (defun cj/find-project-root-file (regexp) - "Return first file in the current Projectile project root matching REGEXP. - -Match is done against (downcase file) for case-insensitivity. -REGEXP must be a string or an rx form." - (when-let ((root (projectile-project-root))) - (seq-find (lambda (file) - (string-match-p (if (stringp regexp) - regexp - (rx-to-string regexp)) - (downcase file))) - (directory-files root)))) - (defun cj/open-project-root-todo () "Open todo.org in the current Projectile project root. @@ -229,6 +235,23 @@ If no such file exists there, display a message." ;; ---------------------------------- Ripgrep ---------------------------------- +(declare-function deadgrep "deadgrep") + +(defun cj/deadgrep--initial-term () + "Return the region text or the symbol at point, to seed a Deadgrep search." + (cond + ((use-region-p) + (buffer-substring-no-properties (region-beginning) (region-end))) + (t (thing-at-point 'symbol t)))) + +(defun cj/--deadgrep-run (root &optional term) + "Run Deadgrep for TERM under directory ROOT. +ROOT is normalized to a directory name; TERM defaults to a minibuffer read +seeded by `cj/deadgrep--initial-term'. Shared tail of the deadgrep commands." + (let ((root (file-name-as-directory (expand-file-name root))) + (term (or term (read-from-minibuffer "Search: " (cj/deadgrep--initial-term))))) + (deadgrep term root))) + (use-package deadgrep :after projectile :bind @@ -239,12 +262,6 @@ If no such file exists there, display a message." :config (require 'thingatpt) - (defun cj/deadgrep--initial-term () - (cond - ((use-region-p) - (buffer-substring-no-properties (region-beginning) (region-end))) - (t (thing-at-point 'symbol t)))) - (defun cj/deadgrep-here (&optional term) "Search with Deadgrep in the most relevant directory at point." (interactive) @@ -261,21 +278,28 @@ If no such file exists there, display a message." (buffer-file-name (file-name-directory (file-truename buffer-file-name))) (t default-directory))) - (root (file-name-as-directory (expand-file-name root))) - (term (or term (read-from-minibuffer "Search: " (cj/deadgrep--initial-term))))) - (deadgrep term root))) + ) + (cj/--deadgrep-run root term))) (defun cj/deadgrep-in-dir (&optional dir term) "Prompt for a directory, then search there with Deadgrep." (interactive) - (let* ((dir (or dir (read-directory-name "Search in directory: " default-directory nil t))) - (dir (file-name-as-directory (expand-file-name dir))) - (term (or term (read-from-minibuffer "Search: " (cj/deadgrep--initial-term))))) - (deadgrep term dir)))) + (let ((dir (or dir (read-directory-name "Search in directory: " default-directory nil t)))) + (cj/--deadgrep-run dir term)))) (with-eval-after-load 'dired (keymap-set dired-mode-map "G" #'cj/deadgrep-here)) +;; ------------------------------------ wgrep ---------------------------------- +;; Make a grep buffer editable, then write the edits back across files -- turns +;; a consult-grep / embark-export result into a project-wide find-and-replace. +;; In a grep buffer: C-c C-p to start editing, C-c C-c to apply. + +(use-package wgrep + :custom + (wgrep-auto-save-buffer t) ;; save the touched files when applying + (wgrep-change-readonly-file t)) ;; let edits flow into read-only buffers + ;; ---------------------------------- Snippets --------------------------------- ;; reusable code and text @@ -298,6 +322,22 @@ This is what makes universal snippets like =<cj= work in any buffer." (yas-reload-all) (yas-global-mode 1)) +;; Most of the snippet keys start with "<" (=<cj=, =<for=, =<main=…), mirroring +;; org-tempo. But `electric-pair-mode' pairs "<" into "<>" wherever the mode's +;; syntax table gives "<" paren syntax (org, and the prog modes that enable +;; pairing), so typing "<cj" lands as "<cj>"; expanding the "<cj" key then +;; strands the ">" after the snippet — the cj-comment fence comes out as +;; "#+end_src>", which breaks the cj-scan fence parser. Inhibit pairing for the +;; open angle bracket globally; defer to the default for every other character. +(defun cj/--electric-pair-inhibit-angle (char) + "Return non-nil to stop `electric-pair-mode' from pairing the angle CHAR. +Inhibit the open angle bracket so \"<\"-prefixed yasnippet keys expand cleanly; +defer to `electric-pair-default-inhibit' for any other CHAR." + (or (eq char ?<) + (electric-pair-default-inhibit char))) + +(setq electric-pair-inhibit-predicate #'cj/--electric-pair-inhibit-angle) + ;; --------------------- Display Color On Color Declaration -------------------- ;; display the actual color as highlight to color hex code @@ -320,14 +360,9 @@ This is what makes universal snippets like =<cj= work in any buffer." (use-package highlight-indent-guides :hook (prog-mode . cj/highlight-indent-guides-enable) :config - ;; Disable auto face coloring to use explicit faces for better visibility across themes + ;; Disable auto face coloring; the guide faces are left to the theme (setq highlight-indent-guides-auto-enabled nil) - ;; Set explicit face backgrounds and foreground for the indentation guides - (set-face-background 'highlight-indent-guides-odd-face "darkgray") - (set-face-background 'highlight-indent-guides-even-face "darkgray") - (set-face-foreground 'highlight-indent-guides-character-face "dimgray") - (defun cj/highlight-indent-guides-enable () "Enable highlight-indent-guides with preferred settings for programming modes." (setq-local highlight-indent-guides-method 'bitmap) @@ -349,16 +384,7 @@ This is what makes universal snippets like =<cj= work in any buffer." (use-package hl-todo :defer 1 :hook - (prog-mode . hl-todo-mode) - :config - (setq hl-todo-keyword-faces - '(("FIXME" . "#FF0000") - ("BUG" . "#FF0000") - ("HACK" . "#FF0000") - ("ISSUE" . "#DAA520") - ("TASK" . "#DAA520") - ("NOTE" . "#2C780E") - ("WIP" . "#1E90FF")))) + (prog-mode . hl-todo-mode)) ;; --------------------------- Whitespace Management --------------------------- ;; trims trailing whitespace only from lines you've modified when saving buffer diff --git a/modules/prog-go.el b/modules/prog-go.el index 0edfc2065..4b09f29c3 100644 --- a/modules/prog-go.el +++ b/modules/prog-go.el @@ -61,7 +61,7 @@ Install with: go install github.com/go-delve/delve/cmd/dlv@latest") (setq-local tab-width 4) ;; Go standard tab width (setq-local standard-indent 4) ;; indent 4 spaces per level (setq-local indent-tabs-mode t) ;; use real tabs (Go convention) - (electric-pair-mode t) ;; match delimiters automatically + (electric-pair-local-mode t) ;; match delimiters automatically ;; Enable LSP if available (when (and (fboundp 'lsp-deferred) @@ -108,6 +108,10 @@ Overrides default prog-mode keybindings with Go-specific commands." ;; go-ts-mode configuration (treesit-based Go editing) (use-package go-mode + ;; .go opens the built-in go-ts-mode, so nothing ever triggers the go-mode + ;; package — gofmt was never autoloaded (void-function on C-; f) and :config + ;; never ran. Autoload gofmt so the first format pulls go-mode and its :config. + :commands (gofmt) :hook ((go-ts-mode . cj/go-setup) (go-ts-mode . cj/go-mode-keybindings)) :mode (("\\.go\\'" . go-ts-mode) ;; .go files use go-ts-mode diff --git a/modules/prog-json.el b/modules/prog-json.el index 953b5f79b..e7abd1828 100644 --- a/modules/prog-json.el +++ b/modules/prog-json.el @@ -9,7 +9,7 @@ ;; Eager reason: none necessary; currently eager but should load by JSON major ;; mode (Phase 6 deferral candidate). ;; Top-level side effects: one add-hook, package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: system-lib (cj/format-region-with-program). ;; Direct test load: yes. ;; ;; JSON editing with tree-sitter highlighting, one-key formatting, and @@ -27,6 +27,8 @@ ;;; Code: +(require 'system-lib) + (defvar json-ts-mode-map) ;; -------------------------------- JSON Mode ---------------------------------- @@ -41,38 +43,13 @@ ;; -------------------------------- Formatting --------------------------------- ;; pretty-print with sorted keys, bound to standard format key -(defun cj/--json-format-region (program &rest args) - "Replace the buffer with PROGRAM ARGS run over its contents, via argv. -Runs PROGRAM (with ARGS) on the whole buffer through -`call-process-region' — no shell, so no quoting or word-splitting. -The buffer is replaced only when PROGRAM exits zero; on a non-zero -exit the buffer is left untouched and an error is signalled with -the program's stderr text. Point is preserved as closely as the -reformatted size allows. Returns t on success." - (let* ((point (point)) - (src (current-buffer)) - (out (generate-new-buffer " *json-format-out*")) - (status (apply #'call-process-region - (point-min) (point-max) program - nil out nil args))) - (unwind-protect - (if (and (integerp status) (zerop status)) - (progn - (with-current-buffer src - (replace-buffer-contents out) - (goto-char (min point (point-max)))) - t) - (user-error "%s failed: %s" program - (string-trim (with-current-buffer out (buffer-string))))) - (kill-buffer out)))) - (defun cj/json-format-buffer () "Format the current JSON buffer with sorted keys. Uses jq if available for reliable formatting, otherwise falls back to the built-in `json-pretty-print-buffer-ordered'." (interactive) (if (executable-find "jq") - (cj/--json-format-region "jq" "--sort-keys" ".") + (cj/format-region-with-program "jq" "--sort-keys" ".") (json-pretty-print-buffer-ordered))) (defun cj/json-setup () diff --git a/modules/prog-lisp.el b/modules/prog-lisp.el index a51116698..30c04ad7e 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -131,17 +131,7 @@ (use-package rainbow-delimiters :hook - ((emacs-lisp-mode lisp-mode scheme-mode) . rainbow-delimiters-mode) - :config - (set-face-foreground 'rainbow-delimiters-depth-1-face "#c66") ;; red - (set-face-foreground 'rainbow-delimiters-depth-2-face "#6c6") ;; green - (set-face-foreground 'rainbow-delimiters-depth-3-face "#69f") ;; blue - (set-face-foreground 'rainbow-delimiters-depth-4-face "#cc6") ;; yellow - (set-face-foreground 'rainbow-delimiters-depth-5-face "#6cc") ;; cyan - (set-face-foreground 'rainbow-delimiters-depth-6-face "#c6c") ;; magenta - (set-face-foreground 'rainbow-delimiters-depth-7-face "#ccc") ;; light gray - (set-face-foreground 'rainbow-delimiters-depth-8-face "#999") ;; medium gray - (set-face-foreground 'rainbow-delimiters-depth-9-face "#666")) ;; dark gray + ((emacs-lisp-mode lisp-mode scheme-mode) . rainbow-delimiters-mode)) ;; ----------------------------------- SLIME ----------------------------------- ;; Superior Lisp Interaction Mode for Emacs (Common Lisp REPL/debugger) diff --git a/modules/prog-shell.el b/modules/prog-shell.el index ca990c614..45c0afbca 100644 --- a/modules/prog-shell.el +++ b/modules/prog-shell.el @@ -74,7 +74,7 @@ Install with: sudo pacman -S shellcheck") (setq-local sh-basic-offset 2) ;; 2 spaces (common shell convention) (setq-local tab-width 2) ;; tab displays as 2 spaces (setq-local fill-column 80) ;; wrap at 80 columns - (electric-pair-mode t) ;; automatic quote/bracket pairing + (electric-pair-local-mode t) ;; automatic quote/bracket pairing ;; Enable LSP if available (skip remote files - slow and prompts for project root) (when (and (fboundp 'lsp-deferred) diff --git a/modules/prog-webdev.el b/modules/prog-webdev.el index 8832446ac..b228d0cc8 100644 --- a/modules/prog-webdev.el +++ b/modules/prog-webdev.el @@ -82,37 +82,12 @@ via `call-process-region', so FILE can contain spaces or shell metacharacters without risk." (list "--stdin-filepath" file)) -(defun cj/--webdev-format-region (program &rest args) - "Replace the buffer with PROGRAM ARGS run over its contents, via argv. -Runs PROGRAM (with ARGS) on the whole buffer through -`call-process-region' — no shell, so no quoting or word-splitting. -The buffer is replaced only when PROGRAM exits zero; on a non-zero -exit the buffer is left untouched and an error is signalled with -the program's stderr text. Point is preserved as closely as the -reformatted size allows. Returns t on success." - (let* ((point (point)) - (src (current-buffer)) - (out (generate-new-buffer " *webdev-format-out*")) - (status (apply #'call-process-region - (point-min) (point-max) program - nil out nil args))) - (unwind-protect - (if (and (integerp status) (zerop status)) - (progn - (with-current-buffer src - (replace-buffer-contents out) - (goto-char (min point (point-max)))) - t) - (user-error "%s failed: %s" program - (string-trim (with-current-buffer out (buffer-string))))) - (kill-buffer out)))) - (defun cj/webdev-format-buffer () "Format the current buffer with prettier. Detects the file type automatically from the filename." (interactive) (if (executable-find prettier-path) - (apply #'cj/--webdev-format-region prettier-path + (apply #'cj/format-region-with-program prettier-path (cj/--webdev-format-args (or buffer-file-name "file.ts"))) (user-error "prettier not found; install with: sudo pacman -S prettier"))) diff --git a/modules/prog-yaml.el b/modules/prog-yaml.el index c2bb559b1..e07cf510e 100644 --- a/modules/prog-yaml.el +++ b/modules/prog-yaml.el @@ -9,7 +9,7 @@ ;; Eager reason: none necessary; currently eager but should load by YAML major ;; mode (Phase 6 deferral candidate). ;; Top-level side effects: one add-hook, package configuration via use-package. -;; Runtime requires: none (configures packages via use-package). +;; Runtime requires: system-lib (cj/format-region-with-program). ;; Direct test load: yes. ;; ;; YAML editing with tree-sitter highlighting and one-key formatting. @@ -24,6 +24,8 @@ ;;; Code: +(require 'system-lib) + ;; -------------------------------- YAML Mode ---------------------------------- ;; tree-sitter mode for YAML files (built-in, Emacs 29+) ;; NOTE: No :mode directive — treesit-auto (in prog-general.el) handles @@ -36,37 +38,12 @@ ;; -------------------------------- Formatting --------------------------------- ;; normalize indentation and style, bound to standard format key -(defun cj/--yaml-format-region (program &rest args) - "Replace the buffer with PROGRAM ARGS run over its contents, via argv. -Runs PROGRAM (with ARGS) on the whole buffer through -`call-process-region' — no shell, so no quoting or word-splitting. -The buffer is replaced only when PROGRAM exits zero; on a non-zero -exit the buffer is left untouched and an error is signalled with -the program's stderr text. Point is preserved as closely as the -reformatted size allows. Returns t on success." - (let* ((point (point)) - (src (current-buffer)) - (out (generate-new-buffer " *yaml-format-out*")) - (status (apply #'call-process-region - (point-min) (point-max) program - nil out nil args))) - (unwind-protect - (if (and (integerp status) (zerop status)) - (progn - (with-current-buffer src - (replace-buffer-contents out) - (goto-char (min point (point-max)))) - t) - (user-error "%s failed: %s" program - (string-trim (with-current-buffer out (buffer-string))))) - (kill-buffer out)))) - (defun cj/yaml-format-buffer () "Format the current YAML buffer with prettier. Preserves point position as closely as possible." (interactive) (if (executable-find "prettier") - (cj/--yaml-format-region "prettier" "--parser" "yaml") + (cj/format-region-with-program "prettier" "--parser" "yaml") (user-error "prettier not found; install with: npm install -g prettier"))) (defun cj/yaml-setup () diff --git a/modules/reconcile-open-repos.el b/modules/reconcile-open-repos.el index dd82ef0f3..79a895bf9 100644 --- a/modules/reconcile-open-repos.el +++ b/modules/reconcile-open-repos.el @@ -171,8 +171,11 @@ Prunes generated/heavy directories. Once a repository root is found, do not descend into it unless INCLUDE-NESTED is non-nil." (let (repos) (when (file-directory-p directory) - (dolist (child (directory-files directory t "^[^.]+$" 'nosort)) + (dolist (child (directory-files directory t directory-files-no-dot-files-regexp 'nosort)) (when (and (file-directory-p child) + ;; Skip hidden dirs (.git, .config) but keep dotted repo + ;; names like mcp.el; the old "^[^.]+$" filter dropped both. + (not (string-prefix-p "." (file-name-nondirectory child))) (not (cj/reconcile--pruned-directory-p child))) (if (file-directory-p (expand-file-name ".git" child)) (progn diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 116873374..7f7f9a475 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -26,6 +26,12 @@ ;; ;;; Code: +;; External variables and lazily-loaded functions referenced below. +(defvar xref-show-xrefs-function) +(defvar xref-show-definitions-function) +(declare-function consult-dir-projectile-dirs "consult-dir") +(declare-function prescient-persist-mode "prescient") + ;; ---------------------------------- Vertico ---------------------------------- ;; Vertical completion UI @@ -37,16 +43,25 @@ (vertico-resize nil) ; Don't resize the minibuffer (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical :bind (:map vertico-map - ("C-j" . vertico-next) - ("C-k" . vertico-previous) - ("C-l" . vertico-insert) ; Insert current candidate - ("RET" . vertico-exit) - ("C-RET" . vertico-exit-input) - ("M-RET" . minibuffer-force-complete-and-exit) - ("TAB" . minibuffer-complete)) + ("C-j" . vertico-next) + ("C-k" . vertico-previous) + ("C-l" . vertico-insert) ; Insert current candidate + ("RET" . vertico-exit) + ("C-RET" . vertico-exit-input) + ("M-RET" . minibuffer-force-complete-and-exit) + ("TAB" . minibuffer-complete) + ;; Page-Up/Down scroll the candidate page instead of falling + ;; through to minibuffer history (which selected + dismissed). + ("<next>" . vertico-scroll-up) + ("<prior>" . vertico-scroll-down)) :init (vertico-mode)) +;; Save each completion session so `vertico-repeat' (the second C-s in +;; `cj/consult-line-or-repeat') has a session to resume. `vertico-repeat-save' +;; is autoloaded, so this defers loading vertico-repeat until the first minibuffer. +(add-hook 'minibuffer-setup-hook #'vertico-repeat-save) + (use-package marginalia :demand t :custom @@ -113,7 +128,6 @@ ;; Optionally tweak the register preview window. (advice-add #'register-preview :override #'consult-register-window) - ;; Configure other variables and modes (setq xref-show-xrefs-function #'consult-xref xref-show-definitions-function #'consult-xref) @@ -246,6 +260,11 @@ (use-package vertico-prescient :demand t + :custom + ;; orderless does the matching; prescient only sorts. Without this, + ;; vertico-prescient-mode's default filtering overrides completion-styles to + ;; prescient inside vertico sessions, leaving the orderless config above dead. + (vertico-prescient-enable-filtering nil) :config (vertico-prescient-mode)) diff --git a/modules/signal-config.el b/modules/signal-config.el index 317e35203..edb7d0dc3 100644 --- a/modules/signal-config.el +++ b/modules/signal-config.el @@ -17,6 +17,9 @@ (require 'seq) (require 'keybindings) ;; provides cj/custom-keymap + cj/register-prefix-map +(require 'system-lib) ;; for cj/executable-find-or-warn + +(declare-function notifications-notify "notifications") (defun cj/signal--jstr (value) "Return VALUE if it is a non-blank string, else nil. @@ -102,6 +105,46 @@ window of a focused frame." (buffer-name (window-buffer (selected-window))) (cj/signal--frame-focused-p)))) +;;; Notifications + +(defcustom cj/signel-notify-sound nil + "When non-nil, incoming-message notifications play the notify script's sound. +Nil (the default) passes --silent so the toast is visual only." + :type 'boolean + :group 'signel) + +(defconst cj/signal--notify-body-max 120 + "Maximum character length of a desktop-notification body. +Longer message text truncates to this length ending in an ellipsis; +the full text is always in the chat buffer.") + +(defun cj/signal--format-notify-body (text) + "Collapse whitespace in TEXT and truncate it for a notification body. +Whitespace runs (including newlines) become single spaces, the result +is trimmed, and anything over `cj/signal--notify-body-max' characters +truncates to that length with a trailing ellipsis." + (let ((flat (string-trim (replace-regexp-in-string "[ \t\n\r]+" " " text)))) + (if (<= (length flat) cj/signal--notify-body-max) + flat + (concat (substring flat 0 (1- cj/signal--notify-body-max)) "…")))) + +(defun cj/signel--notify (chat-id sender body) + "Raise a desktop notification for an incoming Signal message. +Suppressed via `cj/signal--should-notify-p' when the user is actively +viewing CHAT-ID. Routes through the external notify script when it is +on PATH (type info, sound gated by `cj/signel-notify-sound'), falling +back to `notifications-notify' otherwise. SENDER names the title; +BODY is formatted by `cj/signal--format-notify-body'. Installed as +`signel-notify-function' in the use-package :config below." + (when (cj/signal--should-notify-p chat-id) + (let ((title (format "Signal: %s" sender)) + (text (cj/signal--format-notify-body body)) + (script (executable-find "notify"))) + (if script + (apply #'start-process "signel-notify" nil script "info" title text + (unless cj/signel-notify-sound (list "--silent"))) + (notifications-notify :title title :body text))))) + ;;; signel — fork integration (defcustom cj/signal-private-config-file @@ -126,7 +169,13 @@ time." (signel-auto-open-buffer nil) :config (when (file-readable-p cj/signal-private-config-file) - (load cj/signal-private-config-file nil t))) + (load cj/signal-private-config-file nil t)) + ;; Route incoming-message notifications through cj/signel--notify + ;; (suppression + notify script + truncation); warn once at load when + ;; the script is missing — the runtime path still falls back to + ;; notifications-notify, so messages are never silently dropped. + (setq signel-notify-function #'cj/signel--notify) + (cj/executable-find-or-warn "notify" "Signal desktop notifications via the notify script (falling back to notifications-notify)" 'signal-config)) ;; Chat buffers (named `*Signel: <id>*') open in the bottom 30% of the ;; frame rather than wherever display-buffer's fallback rule picks. @@ -260,7 +309,13 @@ opens the chosen recipient in `signel-chat'." (candidates (cons note-self cj/signel--contact-cache)) (table (lambda (string pred action) (if (eq action 'metadata) - '(metadata + `(metadata + (category . signal-contact) + (annotation-function + . ,(lambda (cand) + (let ((r (cdr (assoc cand candidates)))) + (when r + (concat " " (propertize r 'face 'completions-annotations)))))) (display-sort-function . identity) (cycle-sort-function . identity)) (complete-with-action action candidates string pred)))) @@ -290,7 +345,7 @@ that on first use." map) "Signel \"Messages\" prefix keymap, bound under `C-; M'. Leaves =l= unbound for now -- the future =cj/signel-link= command lands -in a later pass. See =docs/design/signal-client.org= scope summary.") +in a later pass. See =docs/specs/signal-client-spec-doing.org= scope summary.") ;; Register the messages prefix under C-; M via the documented helper. ;; keybindings.el owns cj/custom-keymap; the (require 'keybindings) above diff --git a/modules/slack-config.el b/modules/slack-config.el index 0902ef35c..adf38804c 100644 --- a/modules/slack-config.el +++ b/modules/slack-config.el @@ -45,6 +45,7 @@ (require 'system-lib) ;; provides cj/auth-source-secret-value (require 'cl-lib) +(require 'keybindings) ;; provides cj/register-prefix-map (defvar slack-current-buffer) (defvar slack-message-compose-buffer-mode-map) @@ -120,7 +121,9 @@ or more panes; this pins the choice to any non-selected window." :defer t :commands (slack-start slack-select-rooms slack-select-unread-rooms slack-im-select slack-thread-show-or-create - slack-insert-emoji slack-register-team) + slack-insert-emoji slack-register-team + slack-message-write-another-buffer + slack-message-embed-mention slack-message-embed-channel) :custom ;; Disabled: emojify-mode in lui buffers causes (wrong-type-argument listp) ;; errors on emoji characters during lui-scroll-post-command's recenter call. @@ -243,7 +246,8 @@ swallows exceptions via `websocket-try-callback'." (interactive) (let ((count 0)) (dolist (buf (buffer-list)) - (when (buffer-local-value 'slack-current-buffer buf) + (when (and (buffer-local-boundp 'slack-current-buffer buf) + (buffer-local-value 'slack-current-buffer buf)) (let ((win (get-buffer-window buf t))) (when (and win (not (window-dedicated-p win))) (delete-window win))) @@ -256,7 +260,7 @@ swallows exceptions via `websocket-try-callback'." (defvar cj/slack-keymap (make-sparse-keymap) "Keymap for Slack commands under C-; S.") -(global-set-key (kbd "C-; S") cj/slack-keymap) +(cj/register-prefix-map "S" cj/slack-keymap "slack") (define-key cj/slack-keymap (kbd "s") #'cj/slack-start) (define-key cj/slack-keymap (kbd "c") #'slack-select-unread-rooms) diff --git a/modules/system-commands.el b/modules/system-commands.el index dba4d40e2..de5e88535 100644 --- a/modules/system-commands.el +++ b/modules/system-commands.el @@ -6,18 +6,18 @@ ;; Layer: 3 (Domain Workflow). ;; Category: D/S. ;; Load shape: eager. -;; Eager reason: registers the C-; ! system-command keymap; high-impact commands +;; Eager reason: binds C-; ! to the system-command menu; high-impact commands ;; that should run only by command (command-loaded target). -;; Top-level side effects: defines a system-command keymap under cj/custom-keymap. -;; Runtime requires: keybindings, rx. +;; Top-level side effects: binds C-; ! to the system-command menu in cj/custom-keymap. +;; Runtime requires: keybindings, host-environment, rx. ;; Direct test load: yes (requires keybindings explicitly). ;; ;; System commands for logout, lock, suspend, shutdown, reboot, and Emacs -;; exit/restart. Provides both a keymap (C-; !) and a completing-read menu. +;; exit/restart. C-; ! opens a completing-read menu of all commands. ;; ;; Commands include: ;; - Logout (terminate user session) -;; - Lock screen (slock) +;; - Lock screen (hyprlock on Wayland, slock on X11) ;; - Suspend (systemctl suspend) ;; - Shutdown (systemctl poweroff) ;; - Reboot (systemctl reboot) @@ -28,12 +28,20 @@ ;; ;;; Code: -;; `keybindings' provides `cj/custom-keymap', which is referenced at load -;; time by the `keymap-set' call at the tail of this file. An +;; `keybindings' provides `cj/custom-keymap' and `cj/register-command', +;; referenced at load time by the binding call at the tail of this file. An ;; `eval-when-compile' require would silence the byte-compiler but leave ;; the load-time reference void if anything required `system-commands' ;; before `keybindings'. Make the dependency explicit. (require 'keybindings) +;; `host-environment' provides `env-wayland-p', referenced at load time by the +;; `lockscreen-cmd' defvar below to pick the session-appropriate locker. A hard +;; require keeps the module loadable on its own (tests, byte-compile) rather +;; than relying on init.el's load order. +(require 'host-environment) +;; `system-lib' provides `cj/confirm-strong', used at runtime by the `strong' +;; confirm branch of `cj/system-cmd' for irreversible actions (shutdown/reboot). +(require 'system-lib) (eval-when-compile (require 'subr-x)) (require 'rx) @@ -71,7 +79,7 @@ If CMD is deemed dangerous, ask for confirmation." ;; Strong confirm for irreversible actions (shutdown, reboot): ;; require an explicit "yes", so a stray RET/space can't trigger them. ((eq confirm 'strong) - (unless (yes-or-no-p (format "Really run %s (%s)? " label cmdstr)) + (unless (cj/confirm-strong (format "Really run %s (%s)? " label cmdstr)) (user-error "Aborted"))) ;; Quick (Y/n) confirm for recoverable actions (logout, suspend). (confirm @@ -102,7 +110,13 @@ actions like shutdown and reboot), nil for no confirmation." ;; Define system commands (cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") +;; slock is X11-only and can't grab a Wayland session. On Wayland, lock via +;; the session manager (`loginctl lock-session') rather than spawning a locker +;; directly: logind emits the Lock signal, hypridle catches it and runs its +;; lock_cmd (hyprlock), the same path idle/before-sleep locking already uses. +;; X11 machines keep slock. +(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd + (if (env-wayland-p) "loginctl lock-session" "slock")) (cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) (cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" strong) (cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" strong) @@ -167,29 +181,10 @@ daemon alive rather than killing the session blindly." (when-let ((cmd (alist-get choice commands nil nil #'equal))) (call-interactively cmd)))) -(defvar-keymap cj/system-command-map - :doc "Keymap for system commands." - "!" #'cj/system-command-menu - "L" #'cj/system-cmd-logout - "r" #'cj/system-cmd-reboot - "s" #'cj/system-cmd-shutdown - "S" #'cj/system-cmd-suspend - "l" #'cj/system-cmd-lock - "E" #'cj/system-cmd-exit-emacs - "e" #'cj/system-cmd-restart-emacs) -(cj/register-prefix-map "!" cj/system-command-map) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "C-; !" "system commands" - "C-; ! !" "system command menu" - "C-; ! L" "logout" - "C-; ! E" "exit Emacs" - "C-; ! S" "suspend" - "C-; ! e" "restart Emacs" - "C-; ! l" "lock screen" - "C-; ! r" "reboot" - "C-; ! s" "shutdown")) +;; C-; ! opens the completing-read menu directly. The per-command leaf +;; keys (s/r/e/l/L/E/S) were removed 2026-06-28 to reclaim the key +;; real-estate; every command stays reachable through the menu. +(cj/register-command "!" #'cj/system-command-menu "system commands") (provide 'system-commands) ;;; system-commands.el ends here diff --git a/modules/system-defaults.el b/modules/system-defaults.el index eccc6c353..6d9c811a6 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -101,8 +101,11 @@ Used to disable functionality with defalias \='somefunc \='cj/disabled)." ;; CUSTOMIZATIONS ;; All customizations should be declared in Emacs init files. ;; Add accidental customizations via the customization interface to a temp file that's never read. -(setq custom-file (make-temp-file - "emacs-customizations-trashbin-")) +;; Guarded so a batch module load (make validate-modules, byte-compile) doesn't +;; create a throwaway temp file on every run. +(unless noninteractive + (setq custom-file (make-temp-file + "emacs-customizations-trashbin-"))) (defun cj/--warn-customize-discarded (&rest _) "Warn once that Customize edits land in a throwaway `custom-file'. @@ -137,7 +140,9 @@ appears only once per session." ;; -------------------------------- Emacs Server ------------------------------- ;; Start server so emacsclient can connect (needed for pinentry-emacs in terminal) -(unless (or (daemonp) (server-running-p)) +;; noninteractive guard: a raw module load under --batch (make validate-modules +;; on a machine with no daemon socket) would otherwise start a server. +(unless (or noninteractive (daemonp) (server-running-p)) (server-start)) (setq system-time-locale "C") ;; use en_US locale to format time. @@ -200,24 +205,20 @@ appears only once per session." (setq confirm-nonexistent-file-or-buffer nil) ;; don't ask if a file I visit with C-x C-f or C-x b doesn't exist (setq ad-redefinition-action 'accept) ;; silence warnings about advised functions getting redefined. (setq large-file-warning-threshold nil) ;; open files regardless of size -(fset 'yes-or-no-p 'y-or-n-p) ;; require a single letter for binary answers -(setq use-short-answers t) ;; same as above with Emacs 28+ +(setq use-short-answers t) ;; single-key y/n for ordinary yes-or-no-p prompts + ;; (irreversible actions use `cj/confirm-strong', which + ;; forces a typed "yes" by binding this nil for that call) (setq auto-revert-verbose nil) ;; turn off auto revert messages (setq custom-safe-themes t) ;; treat all themes as safe (stop asking) (setq server-client-instructions nil) ;; I already know what to do when done with the frame -;; ------------------ Reduce Garbage Collections In Minibuffer ----------------- - -(defun cj/minibuffer-setup-hook () - "Hook to prevent garbage collection while user's in minibuffer." - (setq gc-cons-threshold most-positive-fixnum)) - -(defun cj/minibuffer-exit-hook () - "Hook to trigger garbage collection when exiting minibuffer." - (setq gc-cons-threshold 800000)) - -(add-hook 'minibuffer-setup-hook #'cj/minibuffer-setup-hook) -(add-hook 'minibuffer-exit-hook #'cj/minibuffer-exit-hook) +;; ----------------------------- Garbage Collection ---------------------------- +;; GC is managed by gcmh in modules/gcmh-config.el: it keeps gc-cons-threshold +;; high during activity and collects on idle, replacing the old stock-800KB +;; scheme (an early-init restore plus a minibuffer setup/exit bump). gcmh lives +;; in its own module rather than here because system-defaults.el is pre-loaded +;; by the comp-errors test harness, which has no package system -- an `:ensure' +;; package loaded here would error at load time and break those tests. ;; ----------------------------- Bookmark Settings ----------------------------- diff --git a/modules/system-lib.el b/modules/system-lib.el index 333c15ee2..8b954c6a9 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -130,5 +130,86 @@ Callers that must have a secret layer their own error on top." (secret (plist-get (car (apply #'auth-source-search spec)) :secret))) (if (functionp secret) (funcall secret) secret))) +;; ---------------------------- Strong 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/--font-lock-global-modes-excluding (current mode) + "Return CURRENT `font-lock-global-modes' with MODE added to the exclusion. +CURRENT has one of three shapes: t (font-lock on in all modes), a +\(not M...) exclusion list, or an (M...) inclusion list. Pure: returns +the new value and mutates nothing." + (cond + ((eq current t) (list 'not mode)) + ((and (consp current) (eq (car current) 'not)) + (if (memq mode (cdr current)) current + (cons 'not (cons mode (cdr current))))) + ((consp current) (delq mode (copy-sequence current))) + (t current))) + +(defun cj/exclude-from-global-font-lock (&rest modes) + "Exclude MODES from `global-font-lock-mode'. +Some major modes (dashboard, mu4e) paint their buffers with manual `face' +text properties; global font-lock then strips those, leaving the buffer +unthemed. Excluding the mode keeps its faces. Additive, so each caller +contributes its own modes regardless of load order." + (dolist (mode modes) + (setq font-lock-global-modes + (cj/--font-lock-global-modes-excluding font-lock-global-modes mode)))) + +(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 +table, or another table). The table reports CATEGORY in its metadata so +marginalia (and embark, consult, sorting) can recognize and annotate the +candidates. Use a standard category (file, buffer, function, theme, ...) when +the candidates match one; marginalia then annotates them with no further work." + (lambda (string predicate action) + (if (eq action 'metadata) + `(metadata (category . ,category)) + (complete-with-action action collection string predicate)))) + +(defun cj/completion-table-annotated (category annotate collection) + "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." + (lambda (string predicate action) + (if (eq action 'metadata) + `(metadata (category . ,category) + (annotation-function . ,annotate)) + (complete-with-action action collection string predicate)))) + +(defun cj/format-region-with-program (program &rest args) + "Replace the current buffer with PROGRAM ARGS run over its contents, via argv. +Runs PROGRAM (with ARGS) on the whole buffer through `call-process-region' +-- no shell, so no quoting or word-splitting. The buffer is replaced only +when PROGRAM exits zero; on a non-zero exit the buffer is left untouched and +a `user-error' is signalled with the program's stderr text. Point is +preserved as closely as the reformatted size allows. Returns t on success." + (let* ((point (point)) + (src (current-buffer)) + (out (generate-new-buffer " *format-out*")) + (status (apply #'call-process-region + (point-min) (point-max) program + nil out nil args))) + (unwind-protect + (if (and (integerp status) (zerop status)) + (progn + (with-current-buffer src + (replace-buffer-contents out) + (goto-char (min point (point-max)))) + t) + (user-error "%s failed: %s" program + (string-trim (with-current-buffer out (buffer-string))))) + (kill-buffer out)))) + (provide 'system-lib) ;;; system-lib.el ends here diff --git a/modules/system-utils.el b/modules/system-utils.el index 7cf958674..b393aa33f 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -102,7 +102,7 @@ detached from Emacs." (interactive) (save-some-buffers) (kill-emacs)) -(keymap-global-set "C-<f10>" #'cj/server-shutdown) +(keymap-global-set "C-x C" #'cj/server-shutdown) ;;; ---------------------------- History Persistence ---------------------------- @@ -123,7 +123,8 @@ detached from Emacs." read-char-history face-name-history bookmark-history - file-name-history)) + file-name-history + wttrin--location-history)) (put 'minibuffer-history 'history-length 50) (put 'file-name-history 'history-length 50) @@ -146,6 +147,22 @@ detached from Emacs." ;; in `nerd-icons-config'. (keymap-global-set "<remap> <list-buffers>" #'ibuffer) +;; Swap delete and diff in the ibuffer list: d diffs the buffer at point against +;; its saved file (was on =), and D marks it for deletion (was on d; `x' still +;; executes the marks). +(defvar ibuffer-mode-map) +(declare-function ibuffer-diff-with-file "ibuffer") +(declare-function ibuffer-mark-for-delete "ibuffer") +(with-eval-after-load 'ibuffer + (keymap-set ibuffer-mode-map "d" #'ibuffer-diff-with-file) + (keymap-set ibuffer-mode-map "D" #'ibuffer-mark-for-delete)) + +;; ibuffer paints its rows with manual `face' properties (nerd-icons + ibuffer +;; faces). Left in `global-font-lock-mode', font-lock leaks keyword fontification +;; onto buffer and mode names, mixing wrong colors in. Exclude it, the same fix +;; as the shr-rendered reader modes. +(cj/exclude-from-global-font-lock 'ibuffer-mode) + ;;; -------------------------- Scratch Buffer Happiness ------------------------- (defvar scratch-emacs-version-and-system diff --git a/modules/term-config.el b/modules/term-config.el deleted file mode 100644 index 2daebe9b2..000000000 --- a/modules/term-config.el +++ /dev/null @@ -1,435 +0,0 @@ -;;; term-config.el --- Settings for ghostel and the F12 toggle -*- lexical-binding: t; coding: utf-8; -*- -;; author Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; -;; Layer: 3 (Domain Workflow). -;; Category: D/P. -;; Load shape: eager. -;; Eager reason: registers terminal keymaps and the F12 toggle. -;; Top-level side effects: defines two keymaps (one under cj/custom-keymap), one -;; global key, two add-hook, package config. -;; Runtime requires: keybindings, seq, subr-x, cj-window-geometry-lib, -;; cj-window-toggle-lib. -;; Direct test load: yes (requires keybindings explicitly). -;; -;; GHOSTEL -;; ghostel is a native Emacs terminal emulator over libghostty-vt (the Ghostty -;; engine). Like a real terminal, in its default semi-char mode most keys are -;; sent to the running program; `ghostel-keymap-exceptions' lists the keys that -;; reach Emacs instead. We add C-; so the personal prefix keymap works inside -;; ghostel buffers. -;; -;; The module degrades gracefully when ghostel is unavailable (D6 of the -;; migration spec): the package installs via use-package, the native module -;; auto-downloads on first use, and ghostel emits its own warning if the module -;; cannot load. A machine without a prebuilt binary needs Zig to build it; the -;; terminal commands stay defined either way. -;; -;; Two ways to lift text out of a terminal, both with the same key story: -;; - C-; x c enters copy-mode via `cj/term-copy-mode-dwim'. When a tmux -;; client is attached (typical -- `cj/term-launch-tmux' auto-starts tmux), -;; sends tmux's prefix C-b [ then C-a, so the user lands in tmux's own -;; copy-mode with the full pane history and the cursor at column 0 (so -;; scrolling up runs up the left, not the right). Without tmux, falls back to -;; `ghostel-copy-mode' (read-only standard-Emacs navigation over the -;; scrollback; M-w copies and stays, q / C-g exit) and moves point to the -;; start of the line for the same column-0 reason. -;; - C-; x h captures the current tmux pane's full history into a temporary -;; Emacs buffer. -;; In both copy surfaces, M-w copies the active region and stays open so several -;; pieces can be grabbed in a row; C-g / q leave without copying. - -;;; Code: - -(require 'keybindings) -(require 'seq) -(require 'subr-x) -(require 'cj-window-geometry-lib) -(require 'cj-window-toggle-lib) - -(declare-function ghostel "ghostel" (&optional directory)) -(declare-function ghostel-send-string "ghostel" (string)) -(declare-function ghostel-copy-mode "ghostel" ()) -(declare-function ghostel-clear-scrollback "ghostel" ()) -(declare-function ghostel-next-prompt "ghostel" (&optional n)) -(declare-function ghostel-previous-prompt "ghostel" (&optional n)) -(declare-function ghostel-send-next-key "ghostel" ()) -(declare-function ghostel--rebuild-semi-char-keymap "ghostel" ()) -(defvar ghostel-mode-map) -(defvar ghostel-keymap-exceptions) -(defvar ghostel-buffer-name) - -(defvar-keymap cj/term-map - :doc "Personal terminal command map.") -;; Lowercase x picked over T for fewer Shift presses; t is the toggle leaf. -(cj/register-prefix-map "x" cj/term-map) - -;; ----------------------------- tmux history ---------------------------------- - -(defvar-local cj/term-tmux-history--origin-buffer nil - "Buffer active before opening the tmux history buffer.") - -(defvar-local cj/term-tmux-history--origin-window nil - "Window active before opening the tmux history buffer.") - -(defvar-local cj/term-tmux-history--origin-point nil - "Point in the origin buffer before opening the tmux history buffer.") - -(defun cj/term--tmux-output (&rest args) - "Run tmux with ARGS and return its stdout. -Signal `user-error' when tmux exits with a non-zero status." - (with-temp-buffer - (let ((exit-code (apply #'process-file "tmux" nil t nil args))) - (unless (zerop exit-code) - (user-error "tmux failed: %s" (string-trim (buffer-string)))) - (buffer-string)))) - -(defun cj/term--tmux-pane-id-for-tty (tty) - "Return the tmux pane id for client TTY." - (let* ((output (cj/term--tmux-output - "list-clients" "-F" "#{client_tty}\t#{pane_id}")) - (lines (split-string output "\n" t)) - (match (seq-find - (lambda (line) - (let ((fields (split-string line "\t"))) - (equal (car fields) tty))) - lines))) - (unless match - (user-error "No tmux client found for terminal tty %s" tty)) - (cadr (split-string match "\t")))) - -(defun cj/term--tmux-capture-pane (pane-id) - "Return full joined tmux history for PANE-ID." - (cj/term--tmux-output - "capture-pane" "-p" "-J" "-S" "-" "-E" "-" "-t" pane-id)) - -(defun cj/term--current-tmux-pane-id () - "Return the tmux pane id for the current ghostel buffer." - (unless (eq major-mode 'ghostel-mode) - (user-error "Current buffer is not a ghostel buffer")) - (let* ((proc (get-buffer-process (current-buffer))) - (tty (and proc (process-tty-name proc)))) - (unless (and tty (not (string-empty-p tty))) - (user-error "Could not determine terminal tty")) - (cj/term--tmux-pane-id-for-tty tty))) - -(defvar-keymap cj/term-tmux-history-mode-map - :doc "Keymap for `cj/term-tmux-history-mode'. -M-w copies the active region without leaving the buffer; C-g, <escape>, or q -returns to the terminal without copying. RET is left unbound." - "M-w" #'kill-ring-save - "C-g" #'cj/term-tmux-history-quit - "<escape>" #'cj/term-tmux-history-quit - "q" #'cj/term-tmux-history-quit) - -(define-derived-mode cj/term-tmux-history-mode special-mode "Tmux History" - "Mode for copying captured tmux pane history with normal Emacs keys." - (setq-local truncate-lines t) - (goto-address-mode 1)) - -(defun cj/term-tmux-history-quit () - "Quit tmux history and return to its origin buffer." - (interactive) - (let ((history-buffer (current-buffer)) - (origin-buffer cj/term-tmux-history--origin-buffer) - (origin-window cj/term-tmux-history--origin-window) - (origin-point cj/term-tmux-history--origin-point)) - (when (buffer-live-p origin-buffer) - (if (window-live-p origin-window) - (progn - (set-window-buffer origin-window origin-buffer) - (select-window origin-window)) - (pop-to-buffer origin-buffer)) - (with-current-buffer origin-buffer - (when (integer-or-marker-p origin-point) - (goto-char origin-point)))) - (when (buffer-live-p history-buffer) - (kill-buffer history-buffer)))) - -(defun cj/term-tmux-history () - "Open full tmux pane history in a temporary Emacs buffer. - -The history buffer uses normal Emacs navigation and selection. `M-w' -copies the active region and stays open, so several pieces can be -copied in a row; `q', `<escape>', or `C-g' returns point to the -terminal buffer that launched it. - -The history view replaces the origin terminal buffer in the same window -\(via `switch-to-buffer'), not a split or a popped-up window." - (interactive) - (let* ((origin-buffer (current-buffer)) - (origin-window (selected-window)) - (origin-point (point)) - (pane-id (cj/term--current-tmux-pane-id)) - (history (cj/term--tmux-capture-pane pane-id)) - (buffer (get-buffer-create - (format "*terminal tmux history: %s*" (buffer-name origin-buffer))))) - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert history)) - (cj/term-tmux-history-mode) - (setq-local cj/term-tmux-history--origin-buffer origin-buffer) - (setq-local cj/term-tmux-history--origin-window origin-window) - (setq-local cj/term-tmux-history--origin-point origin-point) - (goto-char (point-max))) - (switch-to-buffer buffer))) - -;; ----------------------------- copy mode ------------------------------------- - -(defun cj/term--in-tmux-p () - "Return non-nil when the current ghostel buffer has a tmux client attached. -Errors from the pane-id lookup (not in ghostel-mode, no tty, no matching -client, tmux not installed) are treated as nil so callers can use this as a -cheap boolean predicate." - (and (eq major-mode 'ghostel-mode) - (condition-case _ - (and (cj/term--current-tmux-pane-id) t) - (error nil)))) - -(defun cj/term-copy-mode-dwim () - "Enter copy-mode using the engine appropriate to this terminal. - -When tmux is attached, write tmux's default prefix sequence (C-b [) into the -pty so the user lands in tmux's copy-mode with the full pane history, then -C-a to land the cursor at the start of the line. Without the trailing C-a -the copy cursor inherits the live column (far right after a prompt) and -scrolling up runs up the right edge; tmux's emacs copy-mode binds C-a to -start-of-line, so column 0 makes it run up the left. Without tmux, falls -through to `ghostel-copy-mode' (a read-only standard-Emacs view of the -scrollback; M-w copies and stays, q / C-g exit), then moves point to the -start of the line for the same column-0 reason." - (interactive) - (if (cj/term--in-tmux-p) - (ghostel-send-string "\C-b[\C-a") - (ghostel-copy-mode) - (beginning-of-line))) - -;; ----------------------------- ghostel package ------------------------------- - -(defun cj/turn-off-chrome-for-term () - "Turn off line numbers and hl-line in a terminal buffer." - (hl-line-mode -1) - (display-line-numbers-mode -1)) - -(defun cj/term-launch-tmux () - "Auto-launch tmux in a ghostel buffer unless already inside tmux. - -Skipped when `cj/--ai-term-suppress-tmux' is non-nil so the AI-agent flow can -run its own project-named tmux session instead of a bare, auto-named one. -`bound-and-true-p' keeps this safe whether or not ai-term.el is loaded." - (let ((proc (get-buffer-process (current-buffer)))) - (when (and proc - (not (getenv "TMUX")) - (not (bound-and-true-p cj/--ai-term-suppress-tmux))) - (ghostel-send-string "tmux\n")))) - -(use-package ghostel - :ensure t - :commands (ghostel) - :init - ;; These keys must reach Emacs (not the terminal program) inside ghostel - ;; buffers. In semi-char mode ghostel forwards every key NOT in - ;; `ghostel-keymap-exceptions' to the pty, and `ghostel-semi-char-mode-map' - ;; is rebuilt from that list by `ghostel--rebuild-semi-char-keymap' -- - ;; `add-to-list' alone updates the list but not the already-built map, so the - ;; rebuild is what actually lets the key through to `ghostel-mode-map' / the - ;; global map. C-; and F12 are the prefix + toggle; the modified arrows are - ;; windmove (S-arrows, focus) and buffer-move (C-M-arrows, swap), which the - ;; ai-term workflow expects to work from inside an agent buffer. F10 and - ;; C-F10 are global bindings (music-playlist toggle, server shutdown) that - ;; reach Emacs by falling through to the global map once the semi-char map - ;; stops forwarding them. - (with-eval-after-load 'ghostel - (dolist (key '("C-;" "<f12>" "<f10>" "C-<f10>" - "S-<up>" "S-<down>" "S-<left>" "S-<right>" - "C-M-<up>" "C-M-<down>" "C-M-<left>" "C-M-<right>")) - (add-to-list 'ghostel-keymap-exceptions key)) - (ghostel--rebuild-semi-char-keymap)) - :hook - ((ghostel-mode . cj/turn-off-chrome-for-term) - (ghostel-mode . cj/term-launch-tmux)) - :custom - (ghostel-kill-buffer-on-exit t) - ;; Byte analog of the prior 100000-line vterm setting (~100 bytes/line) -- D7. - (ghostel-max-scrollback (* 10 1024 1024))) - -;; ----------------------- F12 toggle (custom) ----------------------- -;; -;; Mirrors the geometry-preservation pattern shared with ai-term.el: capture -;; direction + body size at toggle-off, replay them via a custom display action -;; using frame-edge directions and body-relative sizes so the result is -;; divider-independent and layout-stable. Excludes agent-prefixed buffers, -;; which ai-term.el owns via F9. - -(defcustom cj/term-toggle-window-height 0.7 - "Default fraction of frame height for the F12 terminal window." - :type 'number - :group 'term) - -(defvar cj/--term-toggle-last-direction nil - "Last user-chosen direction for the F12 terminal display. -Symbol: right, left, or below. `above' is never stored. nil means use the -default `below' for F12's traditional bottom split.") - -(defvar cj/--term-toggle-last-size nil - "Last user-chosen body size for the F12 terminal display. -Positive integer: body-cols (right/left) or body-lines (below/above). -nil means fall back to `cj/term-toggle-window-height' as a fraction.") - -(defun cj/--term-toggle-buffer-p (buffer) - "Return non-nil when BUFFER is a terminal buffer F12 should manage. - -Qualifies when BUFFER is alive and has `ghostel-mode' (or its name starts with -the ghostel buffer-name prefix), AND its name does NOT start with the agent -prefix used by ai-term.el." - (and (bufferp buffer) - (buffer-live-p buffer) - (with-current-buffer buffer - (and (or (eq major-mode 'ghostel-mode) - (string-prefix-p (or (bound-and-true-p ghostel-buffer-name) - "*ghostel*") - (buffer-name buffer))) - (not (string-prefix-p "agent [" (buffer-name buffer))))))) - -(defun cj/--term-toggle-buffers () - "Return live F12-managed terminal buffers in `buffer-list' (MRU) order." - (seq-filter #'cj/--term-toggle-buffer-p (buffer-list))) - -(defun cj/--term-toggle-displayed-window (&optional frame) - "Return a window in FRAME currently displaying an F12 terminal buffer, or nil. -FRAME defaults to the selected frame. Minibuffer is excluded." - (seq-find (lambda (w) - (cj/--term-toggle-buffer-p (window-buffer w))) - (window-list (or frame (selected-frame)) 'never))) - -(defun cj/--term-toggle-capture-state (window) - "Capture WINDOW's direction + body size into module-level state. -Default direction is `below' to match F12's traditional bottom split." - (cj/window-toggle-capture-state - window 'below - 'cj/--term-toggle-last-direction - 'cj/--term-toggle-last-size - '(right below left))) - -(defun cj/--term-toggle-display-saved (buffer alist) - "Display-buffer action: split per saved direction and body size. -Delegates to `cj/window-toggle-display-saved' against the F12 state vars, -falling back to `below' and `cj/term-toggle-window-height'." - (cj/window-toggle-display-saved - buffer alist - 'cj/--term-toggle-last-direction 'below - 'cj/--term-toggle-last-size cj/term-toggle-window-height)) - -(defun cj/--term-toggle-display-rule-list () - "Return the `display-buffer-alist' entry list installed by F12. -Routes any terminal buffer satisfying `cj/--term-toggle-buffer-p' through -reuse-window then the saved-geometry action. Excludes agent buffers." - '(((lambda (buffer-or-name _) - (cj/--term-toggle-buffer-p (get-buffer buffer-or-name))) - (display-buffer-reuse-window - cj/--term-toggle-display-saved) - (inhibit-same-window . t)))) - -(dolist (entry (cj/--term-toggle-display-rule-list)) - (add-to-list 'display-buffer-alist entry)) - -(defun cj/--term-toggle-dispatch () - "Compute the F12 (`cj/term-toggle') action without performing it. - -Returns one of: -- (toggle-off . WINDOW) -- terminal displayed in WINDOW; hide it. -- (show-recent . BUFFER) -- terminal alive but not shown; redisplay. -- (create-new) -- no terminal buffer alive; create one." - (let ((win (cj/--term-toggle-displayed-window))) - (cond - (win (cons 'toggle-off win)) - (t - (let ((buffers (cj/--term-toggle-buffers))) - (cond - (buffers (cons 'show-recent (car buffers))) - (t '(create-new)))))))) - -(defun cj/term-toggle () - "Toggle a normal (non-agent) ghostel terminal buffer. - -- If an F12-managed terminal is displayed in this frame, capture its geometry - and delete its window (toggle off). Falls back to burying when it is the - only window in the frame. -- Otherwise, if any F12-managed terminal buffer is alive, display the most - recent one via the saved-geometry action. -- Otherwise, create a new terminal via `(ghostel)' which routes through the - same display action. - -Excludes agent-prefixed buffers; those have their own F9 dispatch via -`cj/ai-term'." - (interactive) - (pcase (cj/--term-toggle-dispatch) - (`(toggle-off . ,win) - (cj/--term-toggle-capture-state win) - (if (one-window-p) - (bury-buffer (window-buffer win)) - (delete-window win)) - nil) - (`(show-recent . ,buf) - (display-buffer buf) - (let ((w (get-buffer-window buf))) - (when w (select-window w))) - buf) - (`(create-new) - (ghostel)))) - -(keymap-global-set "<f12>" #'cj/term-toggle) - -;; ----------------------------- prefix menu ----------------------------------- - -(keymap-set cj/term-map "c" #'cj/term-copy-mode-dwim) -(keymap-set cj/term-map "h" #'cj/term-tmux-history) -(keymap-set cj/term-map "l" #'ghostel-clear-scrollback) -(keymap-set cj/term-map "N" #'ghostel) -(keymap-set cj/term-map "n" #'ghostel-next-prompt) -(keymap-set cj/term-map "p" #'ghostel-previous-prompt) -(keymap-set cj/term-map "q" #'ghostel-send-next-key) -(keymap-set cj/term-map "t" #'cj/term-toggle) - -(defun cj/term-send-C-SPC () - "Forward C-SPC (NUL) to the terminal instead of setting an Emacs mark. - -ghostel forwards the `C-@' event but not the distinct `C-SPC' event GUI -Emacs produces, so a bare C-SPC in a ghostel buffer falls through to the -global `set-mark-command'. That sets an Emacs region in the terminal buffer -that follows point as output streams (a stuck \"selection\" C-g / Escape -can't clear) and, worse, never reaches tmux -- so tmux copy-mode's -begin-selection (C-Space) never starts and M-w then copies nothing. -Forwarding NUL makes C-Space behave like a terminal key." - (interactive) - (ghostel-send-string "\C-@")) - -(defun cj/term-install-keys () - "Make `C-;' resolve as the personal keymap inside ghostel buffers, bind the -F12 toggle, and forward C-SPC so it reaches the terminal (see -`cj/term-send-C-SPC')." - (when (boundp 'ghostel-mode-map) - (keymap-set ghostel-mode-map "C-;" cj/custom-keymap) - (keymap-set ghostel-mode-map "<f12>" #'cj/term-toggle) - (keymap-set ghostel-mode-map "C-SPC" #'cj/term-send-C-SPC))) - -(cj/term-install-keys) -(with-eval-after-load 'ghostel - (cj/term-install-keys)) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements - "C-; x" "terminal menu" - "C-; x c" "copy mode (tmux/ghostel)" - "C-; x h" "tmux scrollback history" - "C-; x l" "clear scrollback" - "C-; x N" "new terminal" - "C-; x n" "next prompt" - "C-; x p" "previous prompt" - "C-; x q" "send next key to terminal" - "C-; x t" "toggle terminal")) - -(provide 'term-config) -;;; term-config.el ends here. diff --git a/modules/test-runner.el b/modules/test-runner.el index 25c38f968..48a2b09fe 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -6,69 +6,18 @@ ;; Layer: 2 (Core UX). ;; Category: C/L. ;; Load shape: eager. -;; Eager reason: the test keymap entry point and project-scoped runner state. -;; Top-level side effects: defines a test keymap, registers it under cj/custom-keymap. +;; Eager reason: registers the C-; t test runner entry point and state. +;; Top-level side effects: defines and registers cj/test-map. ;; Runtime requires: ert, cl-lib, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; This module provides a powerful ERT test runner with focus/unfocus workflow -;; for efficient test-driven development in Emacs Lisp projects. -;; -;; PURPOSE: -;; -;; When working on large Emacs Lisp projects with many test files, you often -;; want to focus on running just the tests relevant to your current work without -;; waiting for the entire suite to run. This module provides a smart test runner -;; that supports both running all tests and focusing on specific test files. -;; -;; WORKFLOW: -;; -;; 1. Run all tests initially to establish baseline (C-; t R) -;; 2. Add test files to focus while working on a feature (C-; t a) -;; 3. Run focused tests repeatedly as you develop (C-; t r) -;; 4. Add more test files as needed (C-; t b from within test buffer) -;; 5. View your focused test list at any time (C-; t v) -;; 6. Clear focus and run all tests before finishing (C-; t c, then C-; t R) -;; -;; PROJECT INTEGRATION: -;; -;; - Automatically discovers test directories in Projectile projects -;; (looks for "test" or "tests" under project root) -;; - Falls back to ~/.emacs.d/tests if not in a Projectile project -;; - Test files must match pattern: test-*.el -;; -;; SPECIAL BEHAVIORS: -;; -;; - Smart test running: Automatically runs all or focused tests based on mode -;; - Test extraction: Discovers test names via regex to run specific tests -;; - At-point execution: Run individual test at cursor position (C-; t .) -;; - Error handling: Continues loading tests even if individual files fail -;; -;; KEYBINDINGS: -;; -;; C-; t L Load all test files -;; C-; t R Run all tests (full suite) -;; C-; t r Run tests smartly (all or focused based on mode) -;; C-; t . Run test at point -;; C-; t a Add test file to focus (with completion) -;; C-; t b Add current buffer's test file to focus -;; C-; t c Clear all focused test files -;; C-; t v View list of focused test files -;; C-; t t Toggle mode between 'all and 'focused -;; -;; RECOMMENDED USAGE: -;; -;; While implementing a feature: -;; - Add the main test file for the feature you're working on -;; - Add any related test files that might be affected -;; - Use C-; t r to repeatedly run just those focused tests -;; - This provides fast feedback during development -;; -;; Before committing: -;; - Clear the focus with C-; t c -;; - Run the full suite with C-; t R to ensure nothing broke -;; - Verify all tests pass before pushing changes +;; Project-aware ERT runner with two modes: all tests or a focused file set. +;; Test roots come from Projectile projects, falling back to the config's tests +;; directory, and test files are discovered by the test-*.el convention. ;; +;; Commands under C-; t load tests, run all/focused tests, run the test at point, +;; and manage the per-project focus list. + ;;; Code: (require 'ert) @@ -358,7 +307,6 @@ Returns a list of test name symbols defined in the file." (insert-file-contents file) (goto-char (point-min)) ;; Find all (ert-deftest NAME ...) forms -;; (while (re-search-forward "^\s-*(ert-deftest\s-+\\(\\(?:\\sw\\|\\s_\\)+\\)" nil t) (while (re-search-forward "^[[:space:]]*(ert-deftest[[:space:]]+\\(\\(?:\\sw\\|\\s_\\)+\\)" nil t) (push (match-string 1) test-names))) test-names)) diff --git a/modules/tramp-config.el b/modules/tramp-config.el index 23010b3e4..f2bc8457c 100644 --- a/modules/tramp-config.el +++ b/modules/tramp-config.el @@ -23,6 +23,15 @@ ;;; Code: +;; Silence byte-compiler "assignment to free variable" warnings for vars +;; defined by lazily-loaded packages (tramp, dirtrack, magit). These are +;; only set inside the use-package :config block, after the package loads. +(defvar tramp-copy-size-limit) +(defvar tramp-use-ssh-controlmaster-options) +(defvar tramp-cleanup-idle-time) +(defvar dirtrack-list) +(defvar magit-git-executable) + (use-package tramp :defer .5 :ensure nil ;; built-in @@ -48,7 +57,6 @@ (setq tramp-auto-save-directory (expand-file-name "tramp-auto-save" user-emacs-directory)) - ;; Create directory if it doesn't exist (unless (file-exists-p tramp-auto-save-directory) (make-directory tramp-auto-save-directory t)) diff --git a/modules/transcription-config.el b/modules/transcription-config.el index 566cea499..944063b88 100644 --- a/modules/transcription-config.el +++ b/modules/transcription-config.el @@ -173,13 +173,17 @@ TITLE and MESSAGE are strings. URGENCY is normal or critical." :body message :urgency (or urgency 'normal)))) -(defun cj/--start-transcription-process (audio-file &optional cleanup-file) +(defun cj/--start-transcription-process (audio-file &optional cleanup-file output-base) "Start async transcription process for AUDIO-FILE. Returns the process object. When CLEANUP-FILE is non-nil, delete that path once the transcription sentinel fires (success or failure). Used by the video flow to drop -the temp audio file produced by ffmpeg after transcription completes." +the temp audio file produced by ffmpeg after transcription completes. + +OUTPUT-BASE, when non-nil, is the path the .txt/.log outputs derive from +instead of AUDIO-FILE. The video flow passes the original video so the +transcript lands alongside the source, not next to the temp /tmp audio." (unless (file-exists-p audio-file) (user-error "Audio file does not exist: %s" audio-file)) @@ -187,10 +191,12 @@ the temp audio file produced by ffmpeg after transcription completes." (user-error "Not an audio file: %s" audio-file)) (let* ((script (cj/--transcription-script-path)) - (outputs (cj/--transcription-output-files audio-file)) + (outputs (cj/--transcription-output-files (or output-base audio-file))) (txt-file (car outputs)) (log-file (cdr outputs)) (buffer-name (format " *transcribe-%s*" (file-name-nondirectory audio-file))) + (stderr-buffer-name (format " *transcribe-stderr-%s*" + (file-name-nondirectory audio-file))) (process-name (format "transcribe-%s" (file-name-nondirectory audio-file)))) (unless (file-executable-p script) @@ -199,15 +205,25 @@ the temp audio file produced by ffmpeg after transcription completes." (cj/--init-log-file log-file audio-file script) (let* ((process-environment (cj/--build-process-environment cj/transcribe-backend)) + ;; A live, explicitly-managed buffer for stderr. Passing a file PATH + ;; to :stderr makes Emacs create a phantom buffer named after the + ;; path, so the error text never reaches the log file and that buffer + ;; leaks per run; the sentinel drains this buffer into the log and + ;; kills it. Keeping stderr off the stdout :buffer leaves the + ;; transcript (stdout) clean. + (stderr-buffer (with-current-buffer (get-buffer-create stderr-buffer-name) + (erase-buffer) + (current-buffer))) (process (make-process :name process-name :buffer (get-buffer-create buffer-name) :command (list script audio-file) :sentinel (lambda (proc event) - (cj/--transcription-sentinel proc event audio-file txt-file log-file) + (cj/--transcription-sentinel proc event audio-file + txt-file log-file stderr-buffer) (when cleanup-file (ignore-errors (delete-file cleanup-file)))) - :stderr log-file))) + :stderr stderr-buffer))) (cj/--track-transcription process audio-file) (cj/--notify "Transcription" (format "Started on %s" (file-name-nondirectory audio-file))) @@ -290,20 +306,25 @@ References TXT-FILE on success (normal urgency), LOG-FILE on failure (format "Errored. Logs in %s" (file-name-nondirectory log-file)) 'critical))) -(defun cj/--transcription-sentinel (process event _audio-file txt-file log-file) +(defun cj/--transcription-sentinel (process event _audio-file txt-file log-file stderr-buffer) "Sentinel for transcription PROCESS. EVENT is the process event string. TXT-FILE and LOG-FILE are the -associated output files." +associated output files. STDERR-BUFFER holds the process's stderr; its +contents are appended to LOG-FILE so the \"Logs in <file>\" notification +points at real error text, and the buffer is then killed so it does not +leak per run." (let* ((success-p (and (string-match-p "finished" event) (= 0 (process-exit-status process)))) (process-buffer (process-buffer process))) (cj/--write-transcript-on-success process-buffer success-p txt-file) - (cj/--append-to-log process-buffer log-file event) + (cj/--append-to-log stderr-buffer log-file event) (cj/--update-transcription-status process success-p) (when (and success-p (not (cj/--should-keep-log success-p))) (delete-file log-file)) (when (buffer-live-p process-buffer) (kill-buffer process-buffer)) + (when (buffer-live-p stderr-buffer) + (kill-buffer stderr-buffer)) (cj/--notify-completion success-p txt-file log-file) (run-at-time 600 nil #'cj/--cleanup-completed-transcriptions) (force-mode-line-update t))) @@ -371,7 +392,9 @@ FILE.log with process logs. Uses the backend in (cj/--extract-audio-from-video path extracted (lambda () - (cj/--start-transcription-process extracted extracted)))))))) + ;; Pass the source video as the output base so the .txt/.log land + ;; alongside it, not next to the temp /tmp audio. + (cj/--start-transcription-process extracted extracted path)))))))) ;;;###autoload (defun cj/transcribe-media-at-point () diff --git a/modules/ui-config.el b/modules/ui-config.el index 7afe528b2..32bd393f5 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -94,72 +94,9 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." (if cj/enable-transparency "enabled" "disabled"))) ;; ----------------------------------- Cursor ---------------------------------- -;; set cursor color according to mode -;; -;; #f06a3f indicates a read-only document -;; #c48702 indicates overwrite mode -;; #64aa0f indicates insert and read/write mode - -(defvar cj/-cursor-last-color nil - "Last color applied by `cj/set-cursor-color-according-to-mode'.") -(defvar cj/-cursor-last-buffer nil - "Last buffer name where cursor color was applied.") - -(defun cj/--buffer-cursor-state () - "Return the buffer-state symbol used to choose the cursor color. - -One of `read-only', `overwrite', `modified', or `unmodified' — keys -of `cj/buffer-status-colors'. - -A live ghostel terminal (in `ghostel-mode' and an input mode that -forwards keys — semi-char / char / line) reports `unmodified' even -though the buffer is read-only: keystrokes go to the terminal process, -so from the user's side the buffer is writeable and the read-only -(orange) cursor would be misleading. ghostel's `copy' and `emacs' -input modes are the exception — there the buffer really is a read-only -Emacs buffer the user navigates, so it falls through to `read-only' -and keeps the orange cursor." - (cond - ((and (eq major-mode 'ghostel-mode) - (not (memq (bound-and-true-p ghostel--input-mode) '(copy emacs)))) - 'unmodified) - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - ((buffer-modified-p) 'modified) - (t 'unmodified))) - -(defun cj/set-cursor-color-according-to-mode () - "Change cursor color according to buffer state (modified, read-only, overwrite). -Only updates for real user buffers, not internal/temporary buffers. -A no-op on non-graphical frames -- TTY/batch sessions have no cursor color -to set." - (when (display-graphic-p) - ;; Only update cursor for real buffers (not internal ones like *temp*, *Echo Area*, etc.) - (unless (string-prefix-p " " (buffer-name)) ; Internal buffers start with space - (let ((color (alist-get (cj/--buffer-cursor-state) cj/buffer-status-colors))) - ;; Only skip if BOTH color AND buffer are the same (optimization) - ;; This allows color to update when buffer state changes - (unless (and (string= color cj/-cursor-last-color) - (string= (buffer-name) cj/-cursor-last-buffer)) - (set-cursor-color color) - (setq cj/-cursor-last-color color - cj/-cursor-last-buffer (buffer-name))))))) - -;; Use post-command-hook to update cursor color after every command -;; This ensures cursor color always matches the current buffer's state. -;; The hook only registers under a graphical session so batch / TTY runs -;; don't pay per-command overhead for a no-op. -(when (display-graphic-p) - (add-hook 'post-command-hook #'cj/set-cursor-color-according-to-mode)) -;; Daemon mode: the first frame may be created after this module loads. -;; Re-attempt the hook install once a GUI frame appears. -(add-hook 'server-after-make-frame-hook - (lambda () - (when (and (display-graphic-p) - (not (memq #'cj/set-cursor-color-according-to-mode - post-command-hook))) - (add-hook 'post-command-hook - #'cj/set-cursor-color-according-to-mode)))) +;; The cursor uses the theme's cursor face. Buffer-state coloring (both the +;; cursor and the modeline buffer-name) was removed -- changing color by buffer +;; write state was more confusing than useful. ;; Don’t show a cursor in non-selected windows: (setq cursor-in-non-selected-windows nil) diff --git a/modules/ui-navigation.el b/modules/ui-navigation.el index f1324c164..76dd686a6 100644 --- a/modules/ui-navigation.el +++ b/modules/ui-navigation.el @@ -75,16 +75,67 @@ resize -- each moves the active window's divider in the arrow's direction "<up>" #'windsize-up "<down>" #'windsize-down) +(defun cj/window-pull-side (key) + "Map a `C-; b' arrow KEY to the side the revealed window opens on. +The arrow names the edge the current window shrinks toward, so the new +window opens on the *opposite* side and the current window keeps the +arrow's edge: <down> -> above, <up> -> below, <left> -> right, +<right> -> left. Returns nil for anything else." + (pcase key + ("<down>" 'above) + ("<up>" 'below) + ("<left>" 'right) + ("<right>" 'left) + (_ nil))) + +(defun cj/window--pull-away (side) + "Split the sole window so the previous buffer opens on SIDE. +SIDE is one of above/below/left/right -- opposite the pressed arrow, so +the current window keeps the arrow's edge. The new window is minimized +to a sliver (the current window keeps almost the whole frame) and shows +`other-buffer'; focus stays on the current window so the sticky arrows +then shrink it step by step via `windsize', exactly as resizing an +existing split does. No-op when SIDE is nil." + (when side + (let ((new (split-window (selected-window) nil side))) + (set-window-buffer new (other-buffer (current-buffer) t)) + ;; Shrink the reveal to the smallest window Emacs allows (~2 lines, the + ;; mode line) so the current window keeps almost the whole frame; the + ;; sticky `windsize' arrows grow the reveal from there. `minimize-window' + ;; floors at `window-min-height' (4 by default), so bind it down to 1. + (let ((window-min-height 1)) + (minimize-window new)) + new))) + (defun cj/window-resize-sticky () "Resize the active window's divider in the just-pressed arrow's direction -(via `windsize'), then keep `cj/window-resize-map' active so bare arrows keep -nudging until any other key. Bound to `C-; b <left>/<right>/<up>/<down>'." +\(via `windsize'), then keep `cj/window-resize-map' active so bare arrows keep +nudging until any other key. Bound to `C-; b <arrow>' and to the global +`M-<arrow>' keys (each direction); the arrow is read with `event-basic-type', +so the Meta modifier on the M-<arrow> path is stripped and both behave alike. + +When the selected window is the sole window in the frame there is no +divider to move, so the first arrow instead splits a sliver away on the +side opposite the arrow (`cj/window--pull-away'), revealing the previous +buffer; the current window keeps almost the whole frame and the following +arrows shrink it via `windsize', so it reads the same as resizing an +existing split." (interactive) - (let ((cmd (keymap-lookup cj/window-resize-map - (key-description (vector last-command-event))))) - (when cmd (call-interactively cmd))) + (let ((key (format "<%s>" (event-basic-type last-command-event)))) + (if (one-window-p) + (cj/window--pull-away (cj/window-pull-side key)) + (let ((cmd (keymap-lookup cj/window-resize-map key))) + (when cmd (call-interactively cmd))))) (set-transient-map cj/window-resize-map t)) +;; M-<arrow> mirrors `C-; b <arrow>': one chord to pull a split from a sole +;; window or nudge a divider. M-<up>/<down> are otherwise unbound; M-<left>/ +;; <right> shed their word-motion, which stays on `C-<left>'/`C-<right>'. +(keymap-global-set "M-<left>" #'cj/window-resize-sticky) +(keymap-global-set "M-<right>" #'cj/window-resize-sticky) +(keymap-global-set "M-<up>" #'cj/window-resize-sticky) +(keymap-global-set "M-<down>" #'cj/window-resize-sticky) + ;; ------------------------------ Window Splitting ----------------------------- (defun cj/split-and-follow-right () @@ -103,6 +154,49 @@ nudging until any other key. Bound to `C-; b <left>/<right>/<up>/<down>'." (consult-buffer)) (keymap-global-set "M-S-h" #'cj/split-and-follow-below) ;; was M-H +(defun cj/--dashboard-buffer () + "Return the *dashboard* buffer, creating it if needed, without changing windows." + (or (get-buffer "*dashboard*") + (save-window-excursion + (when (fboundp 'dashboard-open) (dashboard-open)) + (get-buffer "*dashboard*")))) + +(defun cj/--split-show-buffer (split-fn buffer) + "Split with SPLIT-FN, show BUFFER in the new window, keep point in the current +window. Return the new window." + (let ((new (funcall split-fn))) + (when (and (window-live-p new) buffer) + (set-window-buffer new buffer)) + new)) + +(defun cj/--split-from-dashboard-p (buffer-name) + "Return non-nil when BUFFER-NAME is the dashboard. +Splitting from the dashboard shows *scratch* in the new window instead of +the dashboard again." + (equal buffer-name "*dashboard*")) + +(defun cj/--split-companion-buffer () + "Buffer to show in the new window after a C-x 2 / C-x 3 split. +The dashboard, or the *scratch* buffer when splitting from the dashboard." + (if (cj/--split-from-dashboard-p (buffer-name)) + (get-scratch-buffer-create) + (cj/--dashboard-buffer))) + +(defun cj/split-below-with-dashboard () + "Split below and show the companion buffer in the new window; stay in this one. +The companion is the dashboard, or *scratch* when splitting from the dashboard." + (interactive) + (cj/--split-show-buffer #'split-window-below (cj/--split-companion-buffer))) + +(defun cj/split-right-with-dashboard () + "Split right and show the companion buffer in the new window; stay in this one. +The companion is the dashboard, or *scratch* when splitting from the dashboard." + (interactive) + (cj/--split-show-buffer #'split-window-right (cj/--split-companion-buffer))) + +(keymap-global-set "C-x 2" #'cj/split-below-with-dashboard) +(keymap-global-set "C-x 3" #'cj/split-right-with-dashboard) + ;; ------------------------- Split Window Reorientation ------------------------ (defun toggle-window-split () @@ -160,7 +254,9 @@ This function won't work with more than one split window." ;; UNDO KILL BUFFER (defun cj/undo-kill-buffer (arg) - "Re-open the last buffer killed. With ARG, re-open the nth buffer." + "Re-open the last buffer killed. +With numeric prefix ARG, re-open the ARGth most-recently-killed file +\(1-based, so no prefix re-opens the most recent)." (interactive "p") (require 'recentf) (unless recentf-mode @@ -173,13 +269,18 @@ This function won't work with more than one split window." (buffer-list))))) (mapc (lambda (buf-file) + ;; delete (equal), not delq (eq): buf-file is a fresh string from + ;; expand-file-name and never eq to the recentf-list entries, so the + ;; skip-open-files logic was dead. (setq recently-killed-list - (delq buf-file recently-killed-list))) + (delete buf-file recently-killed-list))) buffer-files-list) (when recently-killed-list - (find-file - (if arg (nth arg recently-killed-list) - (car recently-killed-list)))))) + (let ((file (nth (1- arg) recently-killed-list))) + (if file + (find-file file) + (user-error "Only %d killed file(s) to choose from" + (length recently-killed-list))))))) (keymap-global-set "M-S-z" #'cj/undo-kill-buffer) ;; was M-Z, overrides zap-to-char ;; ---------------------------- Undo Layout Changes ---------------------------- @@ -192,5 +293,15 @@ This function won't work with more than one split window." :config (winner-mode 1)) +;; ------------------------------- Cursor Jump (avy) --------------------------- +;; Jump anywhere visible by typing a few of the target's characters, then the +;; decision-tree key avy overlays. Fills the in-buffer motion gap that windmove +;; (windows) and isearch (text) leave. + +(use-package avy + :bind (("C-:" . avy-goto-char-timer) ;; type chars, pause, jump to a match + ("M-g w" . avy-goto-word-1) + ("M-g l" . avy-goto-line))) + (provide 'ui-navigation) ;;; ui-navigation.el ends here diff --git a/modules/ui-theme.el b/modules/ui-theme.el index a7873b9a5..499e71a49 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -37,13 +37,17 @@ ;; ------------------------------- Switch Themes ------------------------------- ;; loads themes in completing read, then persists via the functions below +(require 'system-lib) + (defun cj/switch-themes () "Function to switch themes and save chosen theme name for persistence. Unloads any other applied themes before applying the chosen theme." (interactive) (let ((chosentheme (completing-read "Load custom theme: " - (mapcar #'symbol-name - (custom-available-themes))))) + (cj/completion-table + 'theme + (mapcar #'symbol-name + (custom-available-themes)))))) (cj/theme-disable-all) (cj/theme-load-name chosentheme)) (cj/save-theme-to-file)) @@ -64,14 +68,13 @@ directory that is sync'd across machines with this configuration." :type 'file :group 'cj/ui-theme) -(defcustom fallback-theme-name "dupre" +(defcustom fallback-theme-name "modus-vivendi" "The name of the theme to fallback on. This is used when there's no file, or the theme name doesn't match any of the installed themes. It must be available wherever this config is -loaded, since the fallback has no further fallback. dupre is bundled in -themes/ and carries the dimming colors chosen for this config, so it is the -default; a built-in theme like modus-vivendi works too but has no chosen -dimming colors. If theme name is `nil', there will be no theme." +loaded, since the fallback has no further fallback. modus-vivendi ships with +Emacs, so it is present on every machine that loads this config, which makes +it the right default. If theme name is `nil', there will be no theme." :type 'string :group 'cj/ui-theme) @@ -140,12 +143,6 @@ Returns fallback-theme-name if no theme is active." (message "Cannot save theme: %s is unwriteable" theme-file) (message "%s theme saved to %s" (cj/get-active-theme-name) theme-file))) -(defun cj/load-fallback-theme (msg) - "Display MSG and load ui-theme fallback-theme-name. -Used to handle errors with loading persisted theme." - (cj/theme-disable-all) - (cj/theme-load-fallback msg)) - (defun cj/load-theme-from-file () "Apply the theme name contained in theme-file as the active UI theme. If the theme is nil, it disables all current themes. If an error occurs diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index fe43575e9..4780ef227 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -32,7 +32,13 @@ (defvar cj/undead-buffer-list '("*scratch*" "*EMMS-Playlist*" "*Messages*" "*ert*" "*AI-Assistant*") - "Buffers to bury instead of killing.") + "Buffer names to bury instead of killing (exact match).") + +(defvar cj/undead-buffer-regexps nil + "Regexps for buffer names to bury instead of killing, alongside +`cj/undead-buffer-list'. Use for dynamically-named buffer families where an +exact name can't be pre-listed -- e.g. ai-term agents, named \"agent [<project>]\". +Register one with `cj/make-buffer-pattern-undead'.") (defun cj/make-buffer-undead (name) "Append NAME to `cj/undead-buffer-list' if not present. @@ -41,6 +47,23 @@ Signal an error if NAME is not a non-empty string. Return the updated list." (error "cj/bury-alive-add: NAME must be a non-empty string")) (add-to-list 'cj/undead-buffer-list name t)) +(defun cj/make-buffer-pattern-undead (regexp) + "Append REGEXP to `cj/undead-buffer-regexps' if not present. +A buffer whose name matches REGEXP is buried instead of killed. Signal an +error if REGEXP is not a non-empty string. Return the updated list." + (unless (and (stringp regexp) (> (length regexp) 0)) + (error "cj/make-buffer-pattern-undead: REGEXP must be a non-empty string")) + (add-to-list 'cj/undead-buffer-regexps regexp t)) + +(defun cj/--buffer-undead-p (name) + "Return non-nil when buffer NAME should be buried instead of killed. +NAME is undead when it is in `cj/undead-buffer-list' (exact) or matches any +regexp in `cj/undead-buffer-regexps'." + (and (stringp name) + (or (member name cj/undead-buffer-list) + (seq-some (lambda (re) (string-match-p re name)) + cj/undead-buffer-regexps)))) + (defun cj/kill-buffer-or-bury-alive (buffer) "Kill BUFFER or bury it if it's in `cj/undead-buffer-list'." (interactive "bBuffer to kill or bury: ") @@ -49,7 +72,7 @@ Signal an error if NAME is not a non-empty string. Return the updated list." (progn (add-to-list 'cj/undead-buffer-list (buffer-name)) (message "Added %s to bury-alive-list" (buffer-name))) - (if (member (buffer-name) cj/undead-buffer-list) + (if (cj/--buffer-undead-p (buffer-name)) (bury-buffer) (kill-buffer))))) (keymap-global-set "<remap> <kill-buffer>" #'cj/kill-buffer-or-bury-alive) @@ -60,7 +83,7 @@ Undead-buffers are buffers in `cj/undead-buffer-list'." (let* ((buf (current-buffer)) (name (buffer-name buf))) (and - (not (member name cj/undead-buffer-list)) + (not (cj/--buffer-undead-p name)) (buffer-file-name buf) (buffer-modified-p buf)))) diff --git a/modules/user-constants.el b/modules/user-constants.el index 43a23d79f..570b142fb 100644 --- a/modules/user-constants.el +++ b/modules/user-constants.el @@ -53,16 +53,6 @@ mail, chime, etc." (defvar user-mail-address "c@cjennings.net" "The user's email address.") -;; ---------------------------- Buffer Status Colors --------------------------- - -(defconst cj/buffer-status-colors - '((read-only . "#f06a3f") ; red – buffer is read-only - (overwrite . "#c48702") ; gold – overwrite mode - (modified . "#64aa0f") ; green – modified & writeable - (unmodified . "#ffffff")) ; white – unmodified & writeable - "Alist mapping buffer states to their colors. -Used by cursor color, modeline, and other UI elements.") - ;; --------------------------- Media File Extensions --------------------------- (defvar cj/audio-file-extensions @@ -125,8 +115,10 @@ fallback only.") (defconst org-dir (expand-file-name "org/" sync-dir) "This directory is synchronized across machines.") -(defconst roam-dir (expand-file-name "roam/" org-dir) - "The location of org-roam files.") +(defconst roam-dir (expand-file-name "org/roam/" user-home-dir) + "The location of org-roam files. +A standalone git repo (cjennings.net:roam.git), no longer inside the +Syncthing-synced `org-dir' — see the 2026-06-10 transport migration.") (defconst journals-dir (expand-file-name "journal/" roam-dir) "The location of org-roam dailies or journals files.") @@ -149,7 +141,7 @@ fallback only.") (defconst music-dir (expand-file-name "music/" user-home-dir) "The location to save your music files.") -(defconst website-dir (expand-file-name "projects/website/" user-home-dir) +(defconst website-dir (expand-file-name "code/website/" user-home-dir) "Root directory of the Hugo website project.") @@ -162,15 +154,24 @@ fallback only.") (defvar gcal-file (expand-file-name "data/gcal.org" user-emacs-directory) "The location of the org file containing Google Calendar information. -Stored in .emacs.d/data/ so each machine syncs independently from Google Calendar.") +Stored in .emacs.d/data/ so each machine syncs independently from +Google Calendar.") (defvar pcal-file (expand-file-name "data/pcal.org" user-emacs-directory) "The location of the org file containing Proton Calendar information. -Stored in .emacs.d/data/ so each machine syncs independently from Proton Calendar.") +Stored in .emacs.d/data/ so each machine syncs independently from +Proton Calendar.") (defvar dcal-file (expand-file-name "data/dcal.org" user-emacs-directory) "The location of the org file containing DeepSat Calendar information. -Stored in .emacs.d/data/ so each machine syncs independently from Google Calendar.") +Stored in .emacs.d/data/ so each machine syncs independently from +Google Calendar.") + +(defvar keep-file (expand-file-name "data/keep.org" user-emacs-directory) + "The location of the generated org file containing Google Keep notes. +A read-only view regenerated by `cj/keep-refresh'; edits here do not +sync back to Keep. Stored in .emacs.d/data/ so each machine syncs +independently.") (defvar reference-file (expand-file-name "reference.org" org-dir) "The location of the org file containing reference information.") diff --git a/modules/vc-config.el b/modules/vc-config.el index 654116c59..fcca7e07b 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -27,6 +27,27 @@ (require 'user-constants) ;; provides code-dir (require 'keybindings) ;; provides cj/custom-keymap +;; Forward declaration: cj/vc-map is defined later in this file (see +;; `defvar-keymap' below) but referenced earlier in a use-package :bind form. +(defvar cj/vc-map) + +;; External package variables (assigned in :config blocks of lazily-loaded +;; packages, so not loaded at byte-compile time). +(defvar forge-pull-notifications) +(defvar forge-topic-list-limit) + +;; External package functions (from lazily-loaded packages). +(declare-function git-gutter:next-hunk "git-gutter") +(declare-function git-gutter:previous-hunk "git-gutter") +(declare-function git-timemachine--start "git-timemachine") +(declare-function git-timemachine--revisions "git-timemachine") +(declare-function git-timemachine-show-revision "git-timemachine") +(declare-function forge-current-repository "forge") +(declare-function forge-create-issue "forge") + +;; Defined later in this file; referenced earlier in `cj/git-timemachine'. +(declare-function cj/git-timemachine-show-selected-revision "vc-config") + ;; ---------------------------- Magit Configuration ---------------------------- (use-package magit diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index 4c934ef17..fce3d9033 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -6,104 +6,19 @@ ;; Layer: 4 (Optional). ;; Category: O/D/S. ;; Load shape: eager. -;; Eager reason: none; registers a recording keymap, but device probing should -;; run only on command (command-loaded target). -;; Top-level side effects: defines cj/record-map and conditionally registers it -;; under C-; r. +;; Eager reason: none; records only on command, but registers C-; r at load. +;; Top-level side effects: defines cj/record-map and registers it when possible. ;; Runtime requires: system-lib, keybindings. -;; Direct test load: yes (requires keybindings explicitly). +;; Direct test load: yes. ;; -;; Desktop video and audio recording from within Emacs using ffmpeg. -;; Records from both microphone and system audio simultaneously, which -;; makes it suitable for capturing meetings, presentations, and desktop activity. -;; -;; Architecture: -;; - Audio recordings use ffmpeg directly with PulseAudio inputs → M4A/AAC -;; - Video recordings differ by display server: -;; - X11: ffmpeg with x11grab + PulseAudio → MKV -;; - Wayland: wf-recorder piped to ffmpeg for audio mixing → MKV -;; (wf-recorder captures the compositor, ffmpeg mixes in audio) -;; -;; Process lifecycle: -;; - Start: `start-process-shell-command` creates a shell running the -;; ffmpeg (or wf-recorder|ffmpeg) pipeline. Process ref is stored in -;; `cj/video-recording-ffmpeg-process' or `cj/audio-recording-ffmpeg-process'. -;; - Stop: SIGINT is sent to the shell's process group so all pipeline -;; children (wf-recorder, ffmpeg) receive it. We then poll until the -;; process actually exits, giving ffmpeg time to finalize the container. -;; - Cleanup: A process sentinel auto-clears the process variable and -;; updates the modeline if the process dies unexpectedly. -;; -;; Note: video-recordings-dir and audio-recordings-dir are defined -;; (and directory created) in user-constants.el -;; -;; Quick Start -;; =========== -;; 1. Press C-; r s to run quick setup -;; 2. Pick a microphone from the list -;; 3. Pick an audio output — [in use] shows which apps are playing -;; 4. Press C-; r a to start/stop audio recording -;; 5. Recording starts - you'll see in your modeline -;; 6. Press C-; r a again to stop (🔴 disappears) -;; -;; Device Setup -;; ============ -;; C-; r a automatically prompts for device selection on first use. -;; Device selection lasts for the current Emacs session only. -;; -;; Manual device selection: -;; -;; C-; r s (cj/recording-quick-setup) - RECOMMENDED -;; Two-step setup: pick a mic, then pick an audio output to capture. -;; Both steps show status: [in use], [ready], [available], [muted]. -;; Audio outputs also show which apps are playing through them. -;; Sorted: in use → ready → available → muted. -;; -;; C-; r S (cj/recording-select-devices) - ADVANCED -;; Manual selection: choose mic and monitor separately. -;; Use when you need different devices for input/output. -;; -;; C-; r d (cj/recording-list-devices) -;; List all available audio devices and current configuration. -;; -;; C-; r w (cj/recording-show-active-audio) - DIAGNOSTIC TOOL -;; Show which apps are currently playing audio and through which device. -;; Use this DURING a phone call to see if the call audio is going through -;; the device you think it is. Helps diagnose "missing one side" issues. -;; -;; Pre-Recording Validation -;; ======================== -;; Every time you start a recording, the system audio device is -;; validated automatically: -;; 1. If the configured monitor device no longer exists (e.g. -;; USB DAC unplugged), it's auto-updated to the current -;; default sink's monitor. -;; 2. If no audio is currently playing through the monitored sink, -;; a warning is shown in the echo area. Recording proceeds -;; without interruption — run C-; r s to see active streams. -;; -;; Testing Devices Before Important Recordings -;; ============================================ -;; Always test devices before important recordings: -;; -;; C-; r t b (cj/recording-test-both) - RECOMMENDED -;; Guided test: mic only, monitor only, then both together. -;; Catches hardware issues before they ruin recordings! -;; -;; C-; r t m (cj/recording-test-mic) -;; Quick 5-second mic test with playback. -;; -;; C-; r t s (cj/recording-test-monitor) -;; Quick 5-second system audio test with playback. -;; -;; To adjust volumes: -;; - Use =M-x cj/recording-adjust-volumes= (or your keybinding =r l=) -;; - Or customize permanently: =M-x customize-group RET cj-recording RET= -;; - Or in your config: -;; #+begin_src emacs-lisp -;; (setq cj/recording-mic-boost 1.5) ; 50% louder -;; (setq cj/recording-system-volume 0.7) ; 30% quieter +;; Starts and stops ffmpeg-backed audio/video recordings from Emacs. Audio +;; captures microphone plus system monitor; video uses x11grab on X11 and +;; wf-recorder piped into ffmpeg on Wayland. ;; +;; Recording processes are tracked in module variables, stopped with SIGINT so +;; containers finalize cleanly, and reflected in the modeline. Device selection +;; is session-local; quick setup and device tests live under C-; r. + ;;; Code: (require 'system-lib) @@ -174,9 +89,10 @@ Checks if process is actually alive, not just if variable is set." (defun cj/recording-process-sentinel (process event) "Sentinel for recording processes — handles unexpected exits. PROCESS is the ffmpeg shell process, EVENT describes what happened. -This is called by Emacs when the process changes state (exits, is killed, etc.). -It clears the process variable and updates the modeline so the recording indicator -disappears even if the recording crashes or is killed externally." +This is called by Emacs when the process changes state (exits, is +killed, etc.). It clears the process variable and updates the modeline +so the recording indicator disappears even if the recording crashes or +is killed externally." (when (memq (process-status process) '(exit signal)) (cond ((eq process cj/audio-recording-ffmpeg-process) diff --git a/modules/weather-config.el b/modules/weather-config.el index 93b0a6148..017d9e31b 100644 --- a/modules/weather-config.el +++ b/modules/weather-config.el @@ -1,4 +1,4 @@ -;;; weather-config.el --- -*- lexical-binding: t; coding: utf-8; -*- +;;; weather-config.el --- wttrin weather display and modeline setup -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: ;; @@ -11,19 +11,23 @@ ;; Runtime requires: none (configures packages via use-package). ;; Direct test load: yes. ;; -;; Call M-W to open wttrin with your preferred location list immediately. -;; Adjust the city list by editing `wttrin-default-locations` or answering wttrin prompts when asked. -;; Forecasts arrive in an Emacs buffer, so you can stay keyboard-only while checking weather. +;; Configures wttrin for favorite-location forecasts, mode-line weather, and +;; whereami-backed geolocation. M-S-w opens the weather buffer. ;; ;;; Code: +(defvar wttrin-geolocation-command) + ;; ----------------------------------- Wttrin ---------------------------------- (use-package wttrin - :vc (:url "git@cjennings.net:emacs-wttrin.git" - :branch "main" - :rev :newest) - ;; :load-path "~/code/emacs-wttrin" ;; uncomment + comment :vc above for local dev + ;; Load from the local checkout (currently release/0.4.0) so recent wttrin + ;; changes are testable without a package pull. Swap back to :vc below for + ;; production tracking. + :load-path "~/code/emacs-wttrin" + ;; :vc (:url "git@cjennings.net:emacs-wttrin.git" + ;; :branch "release/0.4.0" + ;; :rev :newest) :demand t ;; REQUIRED: mode-line must start at Emacs startup :preface ;; Change this to t to enable debug logging @@ -32,7 +36,21 @@ ("M-S-w" . wttrin) ;; was M-W, overrides kill-ring-save :config (setopt wttrin-unit-system "u") + ;; Drop the "Follow @igor_chubin for wttr.in updates" footer. "F" is the + ;; wttr.in flag for "no Follow line"; everything else (forecast, header, + ;; colors) is unchanged. + (setopt wttrin-display-options "F") (setopt wttrin-favorite-location "New Orleans, LA") + ;; Scale the weather font to fit the window width, clamped to a floor/cap + ;; (wttrin-font-height-min/-max, default 100/200). + (setopt wttrin-auto-fit-font t) + ;; Higher-accuracy geolocation via the whereami WiFi-scan script (Google-backed), + ;; far better than IP behind a VPN or cellular hotspot. Used by the picker's + ;; "Current location (detect)" entry; wttrin falls back to its IP provider if the + ;; command is missing or fails. setq (not setopt): wttrin-geolocation-command is + ;; defined in the lazily-loaded wttrin-geolocation sub-module, so it may be unbound + ;; at :config time; the later defcustom won't clobber an already-set value. + (setq wttrin-geolocation-command "/home/cjennings/.local/bin/whereami --json") (setopt wttrin-mode-line-refresh-interval (* 30 60)) ;; thirty minutes (setq wttrin-default-locations '( "New Orleans, LA" |