diff options
Diffstat (limited to 'modules')
60 files changed, 2005 insertions, 1297 deletions
diff --git a/modules/ai-config.el b/modules/ai-config.el index e439ab5c9..97af1296d 100644 --- a/modules/ai-config.el +++ b/modules/ai-config.el @@ -192,6 +192,16 @@ Ensures gptel and backends are initialized." ((symbolp m) (symbol-name m)) (t (format "%s" m)))) +(defun cj/gptel--model-to-symbol (m) + "Return model M as a symbol regardless of its type. +`gptel-model' must be a symbol: gptel's modeline code calls `symbolp' +on it and signals `wrong-type-argument' on a string, which surfaces as a +redisplay hang. Coerce any model value through this before assigning it." + (cond + ((symbolp m) m) + ((stringp m) (intern m)) + (t (intern (format "%s" m))))) + ;; Backend/model switching helpers (pure logic, extracted for testability) (defun cj/gptel--build-model-list (backends model-fn) @@ -223,6 +233,20 @@ Returns a string like \"Anthropic - Claude: claude-opus-4-7\"." (or backend-name "AI") (cj/gptel--model-to-string current-model)))) +(defun cj/--gptel-apply-model-selection (scope backend model backend-name) + "Set gptel BACKEND and MODEL, globally or buffer-locally per SCOPE. +SCOPE is \"global\" or \"buffer\"; any non-\"global\" value is buffer-local. +MODEL is a symbol. BACKEND-NAME is the display name for the confirmation. +Returns the confirmation message string." + (if (string= scope "global") + (progn + (setq gptel-backend backend) + (setq gptel-model model) + (format "Changed to %s model: %s (global)" backend-name model)) + (setq-local gptel-backend backend) + (setq-local gptel-model model) + (format "Changed to %s model: %s (buffer-local)" backend-name model))) + ;; Backend/model switching commands (defun cj/gptel-change-model () "Change the GPTel backend and select a model from that backend. @@ -247,14 +271,8 @@ necessary. Prompt for whether to apply the selection globally or buffer-locally. (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))))) + (message "%s" (cj/--gptel-apply-model-selection + scope backend model backend-name))))) (defun cj/gptel-switch-backend () "Switch the GPTel backend and then choose one of its models." @@ -270,7 +288,7 @@ necessary. Prompt for whether to apply the selection globally or buffer-locally. (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) + gptel-model (cj/gptel--model-to-symbol model)) (message "Switched to %s with model: %s" choice model)))) ;; Clear assistant buffer (moved out so it's always available) diff --git a/modules/ai-conversations.el b/modules/ai-conversations.el index 839af9ad3..8061051a8 100644 --- a/modules/ai-conversations.el +++ b/modules/ai-conversations.el @@ -140,10 +140,7 @@ so a path exists to autosave to." (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)) + (cj/gptel--autosave-active-p)) (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)))))) @@ -359,10 +356,7 @@ enable autosave." (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)) + (when (cj/gptel--autosave-active-p) (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)))))) diff --git a/modules/ai-mcp.el b/modules/ai-mcp.el index 3b552d8dc..510805be4 100644 --- a/modules/ai-mcp.el +++ b/modules/ai-mcp.el @@ -12,7 +12,7 @@ ;; google-docs-work, google-keep), with write-confirmation gating and a ;; doctor for diagnosing prerequisites. ;; -;; Design doc: docs/design/mcp-el-gptel-integration.org +;; Design doc: docs/specs/mcp-el-gptel-integration-spec-doing.org ;; ;; File organization (seven sections, populated by phases): ;; 1. Constants and defcustoms <- this phase diff --git a/modules/ai-term.el b/modules/ai-term.el index baf752fe7..25e56c508 100644 --- a/modules/ai-term.el +++ b/modules/ai-term.el @@ -391,22 +391,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. - -`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)) +(defun cj/--ai-term-default-direction (&optional frame) + "Return the default split direction for the agent window. + +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. @@ -429,6 +433,18 @@ 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 F9 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. @@ -441,21 +457,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' / @@ -523,14 +546,22 @@ 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. @@ -770,6 +801,72 @@ 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 an F9 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. 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)." + ;; 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. @@ -789,55 +886,7 @@ M-F9 (and C-S-F9) close 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 @@ -877,10 +926,7 @@ when BUFFER isn't an AI-term buffer." (buffer-local-value 'default-directory buffer))) (let ((win (get-buffer-window buffer))) (when (window-live-p win) - (with-selected-window win - (switch-to-buffer - (or (cj/--ai-term-most-recent-non-agent-buffer) - (other-buffer buffer t)))))) + (cj/--ai-term-swap-to-working-buffer win))) (let ((kill-buffer-query-functions nil)) (kill-buffer buffer)))) diff --git a/modules/auth-config.el b/modules/auth-config.el index 7f729f02a..f18c0c1fd 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -33,7 +33,7 @@ ;;; 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 (defcustom cj/auth-source-debug-enabled nil "Non-nil means enable verbose auth-source debug logging. @@ -83,9 +83,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..a143f8fe0 100644 --- a/modules/auto-dim-config.el +++ b/modules/auto-dim-config.el @@ -16,8 +16,8 @@ ;; 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, @@ -79,19 +79,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..0312cdd18 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -109,12 +109,6 @@ Returns: \\='success if applied successfully, (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, diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el index 13c74ca16..2ff535668 100644 --- a/modules/calendar-sync.el +++ b/modules/calendar-sync.el @@ -454,53 +454,55 @@ 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." (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) diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el index a17bf8c91..6d5963515 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -241,6 +241,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 @@ -256,20 +279,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. @@ -293,11 +305,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. + ;; Darker sepia color (#E8DCC0) is easier on the eyes than pure white. + (let ((sepia "#E8DCC0")) + (face-remap-add-relative 'variable-pitch :family "Merriweather" :height 1.0 :foreground sepia) + (face-remap-add-relative 'default :family "Merriweather" :height 180 :foreground sepia) + (face-remap-add-relative 'fixed-pitch :height 180 :foreground sepia)) ;; Enable visual-line-mode for proper text wrapping (visual-line-mode 1) ;; Set fill-column as a fallback diff --git a/modules/chrono-tools.el b/modules/chrono-tools.el index 9ccba6676..6f88b2018 100644 --- a/modules/chrono-tools.el +++ b/modules/chrono-tools.el @@ -66,6 +66,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 +93,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 +103,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/coverage-core.el b/modules/coverage-core.el index 0a8b2464f..687a042fe 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: 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..231a03860 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -109,6 +109,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 +146,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 +186,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) - - ;; 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) +LENGTH is the total width of each line. - ;; 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 +244,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 +252,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 +261,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 +297,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 +325,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 +350,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 +390,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..6bca494d8 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -22,15 +22,16 @@ ;; - cj/insert-sortable-date ;; - cj/insert-readable-date ;; -;; Each command uses a corresponding format variable: +;; Each command is generated by `cj/--define-datetime-inserter' from 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. +;; 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': +;; 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 @@ -42,17 +43,26 @@ (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 +70,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 +79,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 +88,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 +97,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 +106,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-ordering.el b/modules/custom-ordering.el index 578bede4b..a2423742d 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -40,6 +40,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 +67,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 +81,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 +111,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 +123,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 +150,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 +164,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 +175,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 +198,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 +218,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 +242,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..5b1b00a71 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -54,48 +54,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 +108,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/dashboard-config.el b/modules/dashboard-config.el index 3b8a3c5ca..38510e801 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -17,6 +17,7 @@ ;;; 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) @@ -32,6 +33,11 @@ (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. +(defvar el) + (defun dashboard-insert-bookmarks (list-size) "Add the list of LIST-SIZE items of bookmarks." (require 'bookmark) @@ -85,15 +91,16 @@ Adjust this if the title doesn't appear centered under the banner image.") (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 '(4 4 3 3) "Navigator row lengths. Must sum to the number of `cj/dashboard--launchers'. -The last row groups Slack and Linear together.") +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,11 +141,14 @@ 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))) @@ -152,6 +162,15 @@ 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) @@ -199,15 +218,17 @@ system-defaults) are preserved rather than overwritten." (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 t) ;; per-filetype icons on the list items (nerd-icons colors them by type) (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") (cj/--dashboard-exclude-emms-from-recentf) ;; exclude EMMS history from recent files - (setq dashboard-set-footer nil) ;; don't show footer and quotes ;; == 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 @@ -222,6 +243,10 @@ system-defaults) are preserved rather than overwritten." ;; 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/dirvish-config.el b/modules/dirvish-config.el index 79d6ff41c..c86f3d1bf 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -119,6 +119,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 +160,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"))) @@ -204,28 +213,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 +268,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 @@ -497,8 +529,8 @@ 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) @@ -513,15 +545,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 ad17ea913..230a8532c 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -210,6 +210,41 @@ 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 @@ -357,9 +392,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 () @@ -448,34 +482,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) @@ -694,9 +712,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 () diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index ad7bda83a..7712f48db 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -126,23 +126,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 +213,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 +273,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) diff --git a/modules/erc-config.el b/modules/erc-config.el index 22ba7f53d..c0fa9c325 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -28,8 +28,10 @@ ;; 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 ------------------------------------ ;; Server definitions and connection settings @@ -97,7 +99,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-buffer-p) (erc-server-process-alive)) (unless (member (buffer-name) server-buffers) (push (buffer-name) server-buffers))))) @@ -182,6 +184,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 +232,6 @@ Auto-adds # prefix if missing. Offers completion from configured channels." match move-to-prompt noncommands - notifications readonly services stamp @@ -258,15 +267,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) diff --git a/modules/eshell-config.el b/modules/eshell-config.el index 0439a4673..d3c8ccdfd 100644 --- a/modules/eshell-config.el +++ b/modules/eshell-config.el @@ -101,7 +101,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")) @@ -162,20 +163,25 @@ pairs where COMMAND is the `cd' string `eshell/alias' should run." (use-package xterm-color :after eshell + ;; Two hooks. eshell-before-prompt is the real hook name; use-package appends + ;; "-hook", so writing eshell-before-prompt-hook here registered on a + ;; nonexistent eshell-before-prompt-hook-hook and never ran. The eshell-mode + ;; hook scopes TERM=xterm-256color to eshell-spawned processes only (a global + ;; setenv would leak it to every start-process regardless of terminal). :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-before-prompt . (lambda () + (setq xterm-color-preserve-properties t))) + (eshell-mode . (lambda () + (setq-local process-environment + (cons "TERM=xterm-256color" + process-environment))))) + :config + ;; Wire xterm-color into eshell's output pipeline (per its README): install + ;; the filter and drop eshell's own ANSI handler. Without this the escapes are + ;; never interpreted and TERM=xterm-256color only leaks raw codes. + (add-to-list 'eshell-preoutput-filter-functions 'xterm-color-filter) + (setq eshell-output-filter-functions + (remove 'eshell-handle-ansi-color eshell-output-filter-functions))) (use-package eshell-syntax-highlighting :after esh-mode diff --git a/modules/eww-config.el b/modules/eww-config.el index 066fae989..a41a9a76e 100644 --- a/modules/eww-config.el +++ b/modules/eww-config.el @@ -119,11 +119,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/face-diagnostic.el b/modules/face-diagnostic.el new file mode 100644 index 000000000..6b1b547f1 --- /dev/null +++ b/modules/face-diagnostic.el @@ -0,0 +1,456 @@ +;;; 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 'ghostel-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-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)\"." + (if faces (mapconcat (lambda (f) (format "%s" f)) 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))) + (format " overlays: %s\n" + (let ((ov (plist-get stack :overlays))) + (if ov + (mapconcat (lambda (e) + (format "%s (priority %s)" + (plist-get e :face) + (or (plist-get e :priority) "nil"))) + ov ", ") + "(none)"))) + (format " active remaps: %s\n" + (let ((rm (plist-get stack :remaps))) + (if rm (mapconcat (lambda (e) (format "%s" (car e))) rm ", ") "(none)"))) + " 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) + (format (concat " %s\n themes: %s\n config: %s\n" + " inherits: %s\n unspecified (-> default): %s") + (plist-get p :face) + (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/font-config.el b/modules/font-config.el index 39d21364c..4821b89e1 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -153,36 +153,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.") + +(declare-function fontaine-set-preset "fontaine") - (defun cj/apply-font-settings-to-frame (&optional frame) - "Apply font settings to FRAME if not already configured. +(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 +198,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 diff --git a/modules/help-config.el b/modules/help-config.el index df27cbea9..f8431aef2 100644 --- a/modules/help-config.el +++ b/modules/help-config.el @@ -105,15 +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 - :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))) - ) + ("M" . Info-menu))) ;; Move Info-menu to 'M' instead (provide 'help-config) ;;; help-config.el ends here. diff --git a/modules/jumper.el b/modules/jumper.el index 8941d5087..de270de66 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -106,20 +106,29 @@ 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)) + (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))))))))) + (found nil)) + (dotimes (i jumper--next-index found) + (when (jumper--with-marker-at + i (lambda () (string= key (jumper--location-key)))) + (setq found t))))) (defun jumper--register-available-p () "Check if there are registers available." @@ -127,21 +136,25 @@ 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--do-store-location () "Store current location in the next free register. @@ -208,9 +221,7 @@ Returns: \\='no-locations if no locations stored, ;; 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 @@ -248,9 +259,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)))) 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/mail-config.el b/modules/mail-config.el index dfc0c4e0c..08f50b12f 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -161,6 +161,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/" @@ -411,6 +417,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 @@ -419,24 +453,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/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..99475fcde 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -144,30 +144,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 diff --git a/modules/music-config.el b/modules/music-config.el index 799db1333..55eb47d25 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -94,6 +94,7 @@ (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) @@ -517,14 +518,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 @@ -535,15 +560,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) @@ -722,54 +760,6 @@ For URL tracks: decoded URL." (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.") diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index e2b431f9a..d5d610f27 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -179,11 +179,18 @@ Only checks DIRECTORY/*/todo.org — does not recurse deeper." ;; builds the org agenda list from all agenda targets with caching. ;; agenda targets is the schedule, contacts, project todos, ;; inbox, and org roam projects. +(defun cj/--org-agenda-base-files () + "Return the fixed 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." + (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)) @@ -262,9 +269,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 +294,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 +324,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 +344,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 +354,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) @@ -453,7 +429,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-capture-config.el b/modules/org-capture-config.el index 393f1d97b..2f245185f 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -76,6 +76,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 @@ -94,15 +109,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)))) @@ -177,27 +186,17 @@ file path. Return a plist (:file F :open-work BOOL :project NAME :warn MSG): "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." - (goto-char (point-min)) - (if (re-search-forward cj/--org-open-work-heading-regexp nil t) - (forward-line 0) - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - (insert (format "* %s Open Work\n" project-name)) - (forward-line -1))) + (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." - (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))) (defun cj/--org-capture-project-location () "Org-capture `function' target for project-aware Task/Bug capture. @@ -400,34 +399,21 @@ never split the small floating frame." 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 most templates make no sense there: -;; the context fields (%:link, %i) come up empty or point at the daemon's last -;; buffer, and the pdf templates error outright. `cj/quick-capture' offers only -;; Task, Bug, and Event; Task and Bug file to the global inbox rather than a -;; project todo.org, since a desktop capture has no meaningful project context. -;; It also closes the popup frame on every exit path (abort, error, finalize) — -;; `org-capture' only runs `org-capture-after-finalize-hook' on a completed -;; capture, so a q/C-g at the template menu or an erroring template would -;; otherwise orphan the frame. The Hyprland script calls this instead of -;; `org-capture'. - -(defun cj/--org-capture-popup-templates (templates inbox) - "Return the desktop-popup subset of TEMPLATES: Task, Bug, Event. -Task (\"t\") and Bug (\"b\") are retargeted to INBOX's \"Inbox\" headline; -Event (\"e\") passes through unchanged. All other templates are dropped. -Template bodies and properties are preserved." - (delq nil - (mapcar - (lambda (entry) - (pcase (car-safe entry) - ((or "t" "b") - ;; (KEY DESC TYPE TARGET TEMPLATE . PROPS) -> retarget TARGET - (append (list (nth 0 entry) (nth 1 entry) (nth 2 entry) - (list 'file+headline inbox "Inbox")) - (nthcdr 4 entry))) - ("e" entry) - (_ nil))) - templates))) +;; 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." @@ -438,8 +424,8 @@ Template bodies and properties are preserved." (defun cj/quick-capture () "Org-capture entry point for the Hyprland desktop popup (frame \"org-capture\"). -Offers only Task, Bug, and Event; Task and Bug file to the global inbox. -Closes the popup frame on abort or error so a stray selection never orphans it. +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 @@ -450,34 +436,11 @@ daemon's main frame and the capture would otherwise land there." (condition-case err (progn (when frame (select-frame-set-input-focus frame)) - (let ((org-capture-templates - (cj/--org-capture-popup-templates org-capture-templates inbox-file))) - (org-capture))) + (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))))) -;; The template menu's "C — Customize org-capture-templates" special makes no -;; sense in the desktop popup (it would open a Customize buffer in the floating -;; frame). Strip it from the menu when the selection runs in the popup frame, -;; keeping "q — Abort". `org-mks' is the menu primitive; advising it (gated on -;; the frame name) catches the capture template selection without touching -;; org-mks's other callers. - -(defun cj/--org-capture-popup-strip-specials (specials) - "Remove the \"C\" Customize entry from org-mks SPECIALS, keeping the rest. -SPECIALS is the org-mks specials alist (e.g. the Customize and Abort entries)." - (delq nil (mapcar (lambda (s) (unless (equal (car-safe s) "C") s)) specials))) - -(defun cj/org-capture--popup-mks-advice (orig table title &optional prompt specials) - "Around-advice for `org-mks': hide the Customize special in the quick-capture popup. -ORIG is the real `org-mks'; TABLE TITLE PROMPT SPECIALS are its arguments." - (funcall orig table title prompt - (if (cj/org-capture--popup-frame-p) - (cj/--org-capture-popup-strip-specials specials) - specials))) - -(advice-add 'org-mks :around #'cj/org-capture--popup-mks-advice) - (provide 'org-capture-config) ;;; org-capture-config.el ends here. diff --git a/modules/org-config.el b/modules/org-config.el index d2a0be34f..8d722ad46 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -44,9 +44,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 +60,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 +129,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 +206,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) diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index d558245b6..556530eb2 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -115,14 +115,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) diff --git a/modules/org-faces-config.el b/modules/org-faces-config.el new file mode 100644 index 000000000..e0dfa83fd --- /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 (:foreground "#8fbf73" :weight bold))) + "Face for the TODO keyword." :group 'org-faces-config) +(defface org-faces-project '((t (:foreground "#7a9abe" :weight bold))) + "Face for the PROJECT keyword." :group 'org-faces-config) +(defface org-faces-doing '((t (:foreground "#e8c668" :weight bold))) + "Face for the DOING keyword." :group 'org-faces-config) +(defface org-faces-waiting '((t (:foreground "#c9b08a" :weight bold))) + "Face for the WAITING keyword." :group 'org-faces-config) +(defface org-faces-verify '((t (:foreground "#d98a5a" :weight bold))) + "Face for the VERIFY keyword." :group 'org-faces-config) +(defface org-faces-stalled '((t (:foreground "#9a8fb0" :weight bold))) + "Face for the STALLED keyword." :group 'org-faces-config) +(defface org-faces-delegated '((t (:foreground "#7fc0a8" :weight bold))) + "Face for the DELEGATED keyword." :group 'org-faces-config) +(defface org-faces-failed '((t (:foreground "#d05a5a" :weight bold))) + "Face for the FAILED keyword." :group 'org-faces-config) +(defface org-faces-done '((t (:foreground "#6f7a82" :weight bold))) + "Face for the DONE keyword." :group 'org-faces-config) +(defface org-faces-cancelled '((t (:foreground "#6f7a82" :weight bold :strike-through t))) + "Face for the CANCELLED keyword." :group 'org-faces-config) + +;; -------------------------- Priority faces (focused) ------------------------- + +(defface org-faces-priority-a '((t (:foreground "#7aa0d0" :weight bold))) + "Face for the [#A] priority cookie." :group 'org-faces-config) +(defface org-faces-priority-b '((t (:foreground "#e8c668"))) + "Face for the [#B] priority cookie." :group 'org-faces-config) +(defface org-faces-priority-c '((t (:foreground "#8fbf73"))) + "Face for the [#C] priority cookie." :group 'org-faces-config) +(defface org-faces-priority-d '((t (:foreground "#8a8a8a"))) + "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 (:foreground "#5f7a4d" :weight bold))) + "Dimmed TODO keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-project-dim '((t (:foreground "#4f6680" :weight bold))) + "Dimmed PROJECT keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-doing-dim '((t (:foreground "#9a8544" :weight bold))) + "Dimmed DOING keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-waiting-dim '((t (:foreground "#87745c" :weight bold))) + "Dimmed WAITING keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-verify-dim '((t (:foreground "#8f5a3c" :weight bold))) + "Dimmed VERIFY keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-stalled-dim '((t (:foreground "#665e75" :weight bold))) + "Dimmed STALLED keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-delegated-dim '((t (:foreground "#547d6c" :weight bold))) + "Dimmed DELEGATED keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-failed-dim '((t (:foreground "#8a3c3c" :weight bold))) + "Dimmed FAILED keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-done-dim '((t (:foreground "#4a5158" :weight bold))) + "Dimmed DONE keyword for non-selected windows." :group 'org-faces-config) +(defface org-faces-cancelled-dim '((t (:foreground "#4a5158" :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 (:foreground "#4f6a8a" :weight bold))) + "Dimmed [#A] priority cookie for non-selected windows." :group 'org-faces-config) +(defface org-faces-priority-b-dim '((t (:foreground "#9a8544"))) + "Dimmed [#B] priority cookie for non-selected windows." :group 'org-faces-config) +(defface org-faces-priority-c-dim '((t (:foreground "#5f7a4d"))) + "Dimmed [#C] priority cookie for non-selected windows." :group 'org-faces-config) +(defface org-faces-priority-d-dim '((t (:foreground "#5a5a5a"))) + "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/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 8b4dedda4..968032831 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -64,20 +64,36 @@ (defvar treesit-auto-recipe-list) ;; 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 +189,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 +232,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 +259,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,17 +275,14 @@ 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)) @@ -336,14 +347,9 @@ defer to `electric-pair-default-inhibit' for any other CHAR." (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) 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/selection-framework.el b/modules/selection-framework.el index b136ad154..a567e8003 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -37,13 +37,17 @@ (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)) diff --git a/modules/signal-config.el b/modules/signal-config.el index 7e980b62e..86cb523ce 100644 --- a/modules/signal-config.el +++ b/modules/signal-config.el @@ -339,7 +339,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-defaults.el b/modules/system-defaults.el index 1703b1bf7..0062a82cf 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. diff --git a/modules/system-lib.el b/modules/system-lib.el index 9e25be5b7..49bb6cd1a 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -141,5 +141,52 @@ 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/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/term-config.el b/modules/term-config.el index f9c126357..0a7991409 100644 --- a/modules/term-config.el +++ b/modules/term-config.el @@ -226,6 +226,15 @@ run its own project-named tmux session instead of a bare, auto-named one. (ghostel-send-string "tmux\n")))) (use-package ghostel + ;; PINNED at module 0.33.0 (ghostel-20260604.2049, the last pre-rework June-4 + ;; build), installed directly into elpa/ rather than from MELPA. The 0.35.0-0.35.2 + ;; native-PTY rework (worker threads + mutex-outside-read-loop) hard-crashes the + ;; whole Emacs process when a ghostel buffer is displayed: on Linux/glibc a + ;; SIGSETXID handler calls malloc while the main thread holds the arena lock + ;; (ghostel upstream #422); on macOS a recursive os_unfair_lock via + ;; run_window_change_functions (#423). `:ensure t' is satisfied by the present + ;; 0.33.0 dir and will NOT upgrade it -- do NOT `package-upgrade' ghostel until + ;; #422/#423 are fixed upstream, or it returns to the crashing 0.35.x. :ensure t :commands (ghostel) :init @@ -252,6 +261,12 @@ run its own project-named tmux session instead of a bare, auto-named one. (ghostel-mode . cj/term-launch-tmux)) :custom (ghostel-kill-buffer-on-exit t) + ;; Auto-download the prebuilt native module on first launch instead of the + ;; default `ask' prompt -- it fetches the platform release asset from GitHub + ;; (for the pinned 0.33.0 source this resolves to the matching v0.33.0 module). + ;; The compile-from-source fallback also works here: zig 0.15.2 is installed at + ;; /usr/local/bin/zig (see M-x ghostel-module-compile). + (ghostel-module-auto-install 'download) ;; Byte analog of the prior 100000-line vterm setting (~100 bytes/line) -- D7. (ghostel-max-scrollback (* 10 1024 1024))) @@ -264,18 +279,43 @@ run its own project-named tmux session instead of a bare, auto-named one. ;; 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." + "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 body size for the F12 terminal display. -Positive integer: body-cols (right/left) or body-lines (below/above). + "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) @@ -306,9 +346,10 @@ FRAME defaults to the selected frame. Minibuffer is excluded." (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." +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 'below + window (cj/--term-toggle-default-direction) 'cj/--term-toggle-last-direction 'cj/--term-toggle-last-size '(right below left))) @@ -316,11 +357,13 @@ Default direction is `below' to match F12's traditional bottom split." (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)) +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. diff --git a/modules/test-runner.el b/modules/test-runner.el index 25c38f968..50d4f7e40 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -358,7 +358,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/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 f2181d97e..c099e0834 100644 --- a/modules/ui-navigation.el +++ b/modules/ui-navigation.el @@ -75,14 +75,55 @@ 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 <left>/<right>/<up>/<down>'. + +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 (key-description (vector 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)) ;; ------------------------------ Window Splitting ----------------------------- @@ -103,6 +144,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 () @@ -175,8 +259,11 @@ With numeric prefix ARG, re-open the ARGth most-recently-killed file (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 (let ((file (nth (1- arg) recently-killed-list))) diff --git a/modules/ui-theme.el b/modules/ui-theme.el index a7873b9a5..eb4efd9b5 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -64,14 +64,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 +139,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/user-constants.el b/modules/user-constants.el index 2e64b355e..dab12dcbe 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 |