diff options
50 files changed, 1509 insertions, 538 deletions
diff --git a/modules/ai-config.el b/modules/ai-config.el index 20bf6ec88..97af1296d 100644 --- a/modules/ai-config.el +++ b/modules/ai-config.el @@ -233,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. @@ -257,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." 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/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/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/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/dirvish-config.el b/modules/dirvish-config.el index 8b672764b..b7e33337e 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -259,6 +259,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 @@ -489,8 +520,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) 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 067b1e577..c0fa9c325 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -184,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" @@ -259,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/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/mail-config.el b/modules/mail-config.el index 1ec41f213..08f50b12f 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -417,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 @@ -425,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 d669425d3..61dcb69c6 100644 --- a/modules/modeline-config.el +++ b/modules/modeline-config.el @@ -71,6 +71,16 @@ 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 @@ -82,10 +92,7 @@ Example: `my-very-long-name.el' → `my-ver...me.el'" 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)))) + 'local-map (cj/--modeline-click-map 'previous-buffer 'next-buffer)))) "Buffer name in the mode line. Truncates in narrow windows. Click to switch buffers.") @@ -195,10 +202,7 @@ break it. Caching nil degrades to \"no VC info\" instead." '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 @@ -215,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/org-agenda-config.el b/modules/org-agenda-config.el index 704eaac9a..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) @@ -424,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 18e130dc6..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. diff --git a/modules/org-config.el b/modules/org-config.el index e7538f244..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 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/prog-general.el b/modules/prog-general.el index 53f20ce46..968032831 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -64,9 +64,21 @@ (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 --------------------- @@ -177,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. @@ -233,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 @@ -243,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) @@ -265,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)) 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-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/system-lib.el b/modules/system-lib.el index ed98a476e..49bb6cd1a 100644 --- a/modules/system-lib.el +++ b/modules/system-lib.el @@ -164,5 +164,29 @@ contributes its own modes regardless of load order." (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/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-navigation.el b/modules/ui-navigation.el index d8d7162e2..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 ----------------------------- diff --git a/modules/ui-theme.el b/modules/ui-theme.el index 8be3b4fdf..eb4efd9b5 100644 --- a/modules/ui-theme.el +++ b/modules/ui-theme.el @@ -139,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/tests/test-ai-config--apply-model-selection.el b/tests/test-ai-config--apply-model-selection.el new file mode 100644 index 000000000..4ccd6d7a0 --- /dev/null +++ b/tests/test-ai-config--apply-model-selection.el @@ -0,0 +1,45 @@ +;;; test-ai-config--apply-model-selection.el --- Tests for cj/--gptel-apply-model-selection -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--gptel-apply-model-selection is the apply step extracted from the +;; interactive cj/gptel-change-model: it sets gptel-backend/gptel-model globally +;; or buffer-locally and returns the confirmation message. The extraction also +;; dropped a dead `(if (stringp model) ...)' branch (model is always a symbol by +;; that point). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'ai-config) + +(defvar gptel-backend) +(defvar gptel-model) + +(ert-deftest test-ai-config-apply-model-global-sets-globals () + "Normal: global scope assigns the global vars and reports (global)." + (let ((gptel-backend nil) (gptel-model nil)) + (let ((msg (cj/--gptel-apply-model-selection "global" 'mybackend 'mymodel "MyAI"))) + (should (eq gptel-backend 'mybackend)) + (should (eq gptel-model 'mymodel)) + (should (string-match-p "MyAI" msg)) + (should (string-match-p "mymodel" msg)) + (should (string-match-p "global" msg))))) + +(ert-deftest test-ai-config-apply-model-buffer-sets-buffer-locals () + "Normal: buffer scope makes the vars buffer-local and reports (buffer-local)." + (let ((gptel-backend 'orig) (gptel-model 'origm)) + (with-temp-buffer + (let ((msg (cj/--gptel-apply-model-selection "buffer" 'be 'mo "Name"))) + (should (local-variable-p 'gptel-backend)) + (should (local-variable-p 'gptel-model)) + (should (eq gptel-backend 'be)) + (should (eq gptel-model 'mo)) + (should (string-match-p "buffer-local" msg)))) + ;; outside the temp buffer the globals are untouched + (should (eq gptel-backend 'orig)) + (should (eq gptel-model 'origm)))) + +(provide 'test-ai-config--apply-model-selection) +;;; test-ai-config--apply-model-selection.el ends here diff --git a/tests/test-browser-config.el b/tests/test-browser-config.el index 7faecbfc8..9fe5b02e4 100644 --- a/tests/test-browser-config.el +++ b/tests/test-browser-config.el @@ -273,29 +273,6 @@ (should (string= (plist-get loaded :name) "Second")))) (test-browser-teardown)) -;;; Public wrappers (message side-effects mocked) - -(ert-deftest test-browser-apply-wrapper-success-messages-name () - "Normal: =cj/apply-browser-choice= reports the chosen name on success." - (test-browser-setup) - (let ((browser (test-browser-make-plist "Wrapper Test")) - (received nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq received (apply #'format fmt args))))) - (cj/apply-browser-choice browser)) - (should (string-match-p "Wrapper Test" received)) - (should (string-match-p "Default browser set" received))) - (test-browser-teardown)) - -(ert-deftest test-browser-apply-wrapper-invalid-plist-messages-error () - "Error: =cj/apply-browser-choice= surfaces an error message for a bad plist." - (test-browser-setup) - (let ((received nil)) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq received (apply #'format fmt args))))) - (cj/apply-browser-choice nil)) - (should (string-match-p "Invalid" received))) - (test-browser-teardown)) (ert-deftest test-browser-initialize-wrapper-loaded-branch-applies () "Normal: =cj/initialize-browser= applies the saved browser when one is loaded." diff --git a/tests/test-chrono-tools--sound-helpers.el b/tests/test-chrono-tools--sound-helpers.el new file mode 100644 index 000000000..08f71f9bb --- /dev/null +++ b/tests/test-chrono-tools--sound-helpers.el @@ -0,0 +1,54 @@ +;;; test-chrono-tools--sound-helpers.el --- Tests for the tmr sound-file helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/tmr--current-sound-name and cj/tmr--apply-sound-file were extracted from +;; the deeply-nested cj/tmr-select-sound-file so the "what's the current sound" +;; and "set the chosen sound" steps are unit-testable apart from the +;; completing-read UI. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'chrono-tools) + +(defvar tmr-sound-file) +(defvar sounds-dir) +(defvar notification-sound) + +(ert-deftest test-chrono-current-sound-name-existing () + "Normal: returns the basename when the current sound file exists." + (let* ((f (make-temp-file "tmr-sound" nil ".wav")) + (tmr-sound-file f)) + (unwind-protect + (should (equal (cj/tmr--current-sound-name) (file-name-nondirectory f))) + (delete-file f)))) + +(ert-deftest test-chrono-current-sound-name-missing-or-nil () + "Boundary: a missing file or nil yields nil." + (let ((tmr-sound-file "/no/such/file.wav")) + (should (null (cj/tmr--current-sound-name)))) + (let ((tmr-sound-file nil)) + (should (null (cj/tmr--current-sound-name))))) + +(ert-deftest test-chrono-apply-sound-file-sets-and-messages () + "Normal: sets tmr-sound-file under sounds-dir and reports the choice." + (let ((sounds-dir "/snd") + (notification-sound "/snd/default.wav") + (tmr-sound-file nil)) + (let ((msg (cj/tmr--apply-sound-file "chime.wav"))) + (should (equal tmr-sound-file "/snd/chime.wav")) + (should (string-match-p "Timer sound set to: chime.wav" msg))))) + +(ert-deftest test-chrono-apply-sound-file-default-branch () + "Boundary: choosing the notification sound reports it as the default." + (let ((sounds-dir "/snd") + (notification-sound "/snd/default.wav") + (tmr-sound-file nil)) + (let ((msg (cj/tmr--apply-sound-file "default.wav"))) + (should (equal tmr-sound-file "/snd/default.wav")) + (should (string-match-p "default: default.wav" msg))))) + +(provide 'test-chrono-tools--sound-helpers) +;;; test-chrono-tools--sound-helpers.el ends here diff --git a/tests/test-custom-datetime-all-methods.el b/tests/test-custom-datetime-all-methods.el index c9cfa41e2..62b421bdc 100644 --- a/tests/test-custom-datetime-all-methods.el +++ b/tests/test-custom-datetime-all-methods.el @@ -108,5 +108,19 @@ (cj/insert-sortable-date)) (should (string-prefix-p "before 2026-02-15" (buffer-string))))) +;;; Macro-generated commands stay interactive + +(ert-deftest test-custom-datetime-all-methods-are-interactive-commands () + "All six inserters generated by `cj/--define-datetime-inserter' are +interactive commands (so they keep working via M-x and the C-; d keymap)." + (dolist (cmd '(cj/insert-readable-date-time + cj/insert-sortable-date-time + cj/insert-sortable-time + cj/insert-readable-time + cj/insert-sortable-date + cj/insert-readable-date)) + (should (fboundp cmd)) + (should (commandp cmd)))) + (provide 'test-custom-datetime-all-methods) ;;; test-custom-datetime-all-methods.el ends here diff --git a/tests/test-custom-ordering--region-helpers.el b/tests/test-custom-ordering--region-helpers.el new file mode 100644 index 000000000..2ec747966 --- /dev/null +++ b/tests/test-custom-ordering--region-helpers.el @@ -0,0 +1,52 @@ +;;; test-custom-ordering--region-helpers.el --- Tests for the shared ordering region helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--ordering-validate-region and cj/--ordering-replace-region were extracted +;; from the seven pure ordering helpers (the copy-pasted start>end guard) and the +;; interactive ordering commands (the copy-pasted delete-region + insert tail). +;; The per-command behavior stays covered by the existing wrapper/transform +;; tests; these cover the extracted helpers directly. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-ordering) + +;;; cj/--ordering-validate-region + +(ert-deftest test-custom-ordering-validate-region-accepts-ordered () + "Normal: start < end returns nil without signalling." + (should (null (cj/--ordering-validate-region 1 10)))) + +(ert-deftest test-custom-ordering-validate-region-accepts-equal () + "Boundary: start = end (empty region) is allowed." + (should (null (cj/--ordering-validate-region 5 5)))) + +(ert-deftest test-custom-ordering-validate-region-rejects-inverted () + "Error: start > end signals with both positions in the message." + (let ((err (should-error (cj/--ordering-validate-region 10 3) :type 'error))) + (should (string-match-p "10" (error-message-string err))) + (should (string-match-p "3" (error-message-string err))))) + +;;; cj/--ordering-replace-region + +(ert-deftest test-custom-ordering-replace-region-swaps-text () + "Normal: the region between START and END is replaced with INSERTION and +point is left at START." + (with-temp-buffer + (insert "AAAABBBB") + (cj/--ordering-replace-region 1 5 "xx") ; replace the first AAAA + (should (equal "xxBBBB" (buffer-string))) + (should (= (point) 3)))) ; START (1) + len("xx") + +(ert-deftest test-custom-ordering-replace-region-empty-insertion () + "Boundary: an empty INSERTION just deletes the region." + (with-temp-buffer + (insert "keepDROP") + (cj/--ordering-replace-region 5 9 "") ; drop "DROP" (positions 5-8) + (should (equal "keep" (buffer-string))))) + +(provide 'test-custom-ordering--region-helpers) +;;; test-custom-ordering--region-helpers.el ends here diff --git a/tests/test-custom-text-enclose--enclose-region-or-word.el b/tests/test-custom-text-enclose--enclose-region-or-word.el new file mode 100644 index 000000000..4075fb050 --- /dev/null +++ b/tests/test-custom-text-enclose--enclose-region-or-word.el @@ -0,0 +1,62 @@ +;;; test-custom-text-enclose--enclose-region-or-word.el --- Tests for the shared enclose dispatch -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--enclose-region-or-word is the dispatch+edit skeleton extracted from +;; cj/surround/wrap/unwrap-word-or-region (region target, else word at point, +;; else a no-target message). The three commands stay covered by +;; test-custom-text-enclose-public-wrappers.el; these cover the helper directly, +;; including the custom and default no-target messages. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'custom-text-enclose) + +(ert-deftest test-cte-enclose-region-target () + "Normal: an active region is the target; TRANSFORM is applied to it." + (with-temp-buffer + (let ((transient-mark-mode t)) + (insert "abc") + (goto-char (point-min)) + (push-mark (point) t t) + (goto-char (point-max)) + (cj/--enclose-region-or-word #'upcase)) + (should (equal (buffer-string) "ABC")) + (should (= (point) 4)))) ; after the inserted "ABC" (start 1 + 3) + +(ert-deftest test-cte-enclose-word-at-point-target () + "Normal: with no region, the word at point is the target." + (with-temp-buffer + (insert "foo bar") + (goto-char (point-min)) ; point on "foo" + (cj/--enclose-region-or-word (lambda (s) (concat "<" s ">"))) + (should (equal (buffer-string) "<foo> bar")))) + +(ert-deftest test-cte-enclose-no-target-default-message () + "Boundary: no region and no word => default message, buffer untouched." + (with-temp-buffer + (insert " ") ; whitespace, no word + (goto-char (point-min)) + (let ((msg nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/--enclose-region-or-word #'upcase)) + (should (string-match-p "No word at point" msg)) + (should (equal (buffer-string) " "))))) + +(ert-deftest test-cte-enclose-no-target-custom-message () + "Boundary: a supplied NO-TARGET-MESSAGE overrides the default." + (with-temp-buffer + (insert " ") + (goto-char (point-min)) + (let ((msg nil)) + (cl-letf (((symbol-function 'message) + (lambda (fmt &rest args) (setq msg (apply #'format fmt args))))) + (cj/--enclose-region-or-word #'upcase "custom no-target text")) + (should (equal msg "custom no-target text"))))) + +(provide 'test-custom-text-enclose--enclose-region-or-word) +;;; test-custom-text-enclose--enclose-region-or-word.el ends here diff --git a/tests/test-dirvish-config-hard-delete-command.el b/tests/test-dirvish-config-hard-delete-command.el new file mode 100644 index 000000000..eb12d2830 --- /dev/null +++ b/tests/test-dirvish-config-hard-delete-command.el @@ -0,0 +1,47 @@ +;;; test-dirvish-config-hard-delete-command.el --- Tests for cj/--dirvish-hard-delete-command -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/--dirvish-hard-delete-command' is the pure string builder behind the +;; forced `sudo rm -rf' hard-delete bound to D in dirvish. It shell-quotes +;; every path and guards the list with `--' so a leading-dash or space-bearing +;; filename can't be misread. The interactive command (prompt + shell-command) +;; is verified live, not here. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'dirvish-config) + +(ert-deftest test-dirvish-config-hard-delete-command-multiple () + "Normal: two paths are quoted and joined behind `sudo rm -rf -- '." + (should (equal (cj/--dirvish-hard-delete-command '("/tmp/a.txt" "/tmp/b.txt")) + "sudo rm -rf -- /tmp/a.txt /tmp/b.txt"))) + +(ert-deftest test-dirvish-config-hard-delete-command-single () + "Boundary: a single path still carries the `--' option terminator." + (should (equal (cj/--dirvish-hard-delete-command '("/tmp/report.pdf")) + "sudo rm -rf -- /tmp/report.pdf"))) + +(ert-deftest test-dirvish-config-hard-delete-command-spaces-and-dash () + "Boundary: a path with spaces is shell-quoted, and `--' protects a +leading-dash filename from being read as an option." + (let ((cmd (cj/--dirvish-hard-delete-command + '("/tmp/my file.txt" "/tmp/-rf")))) + ;; `--' precedes the paths so `-rf' is a target, not an option. + (should (string-prefix-p "sudo rm -rf -- " cmd)) + ;; the space-bearing path is quoted (not a bare " " splitting the args). + (should (string-match-p (regexp-quote (shell-quote-argument "/tmp/my file.txt")) + cmd)) + (should (string-match-p (regexp-quote (shell-quote-argument "/tmp/-rf")) + cmd)))) + +(ert-deftest test-dirvish-config-hard-delete-command-empty () + "Error: an empty list yields just the prefix (no targets) -- the +interactive command never reaches here, guarding `No file at point' first." + (should (equal (cj/--dirvish-hard-delete-command '()) + "sudo rm -rf -- "))) + +(provide 'test-dirvish-config-hard-delete-command) +;;; test-dirvish-config-hard-delete-command.el ends here diff --git a/tests/test-elfeed-config--decode-html-entities.el b/tests/test-elfeed-config--decode-html-entities.el new file mode 100644 index 000000000..a3fba3c49 --- /dev/null +++ b/tests/test-elfeed-config--decode-html-entities.el @@ -0,0 +1,31 @@ +;;; test-elfeed-config--decode-html-entities.el --- Tests for cj/--decode-html-entities -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--decode-html-entities replaces the six inline replace-regexp-in-string +;; calls that cj/youtube-to-elfeed-feed-format used to hand-decode an og:title. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'elfeed-config) + +(ert-deftest test-elfeed-decode-html-entities-all () + "Normal: every supported entity is decoded." + (should (equal (cj/--decode-html-entities + "a & b <c> "d" 'e'") + "a & b <c> \"d\" 'e'"))) + +(ert-deftest test-elfeed-decode-html-entities-no-entities () + "Boundary: text without entities is unchanged." + (should (equal (cj/--decode-html-entities "plain title") "plain title")) + (should (equal (cj/--decode-html-entities "") ""))) + +(ert-deftest test-elfeed-decode-html-entities-amp-first () + "Boundary: & is decoded before the others (no double-decoding chains)." + (should (equal (cj/--decode-html-entities "Tom & Jerry <3") + "Tom & Jerry <3"))) + +(provide 'test-elfeed-config--decode-html-entities) +;;; test-elfeed-config--decode-html-entities.el ends here diff --git a/tests/test-erc-config--generate-buffer-name.el b/tests/test-erc-config--generate-buffer-name.el new file mode 100644 index 000000000..cbc716c82 --- /dev/null +++ b/tests/test-erc-config--generate-buffer-name.el @@ -0,0 +1,31 @@ +;;; test-erc-config--generate-buffer-name.el --- Tests for cj/erc-generate-buffer-name -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/erc-generate-buffer-name formats an ERC buffer name as SERVER-CHANNEL. +;; It was defined inside the erc use-package :config (so unreachable under +;; `make test'); lifting it to top level makes it unit-testable. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'erc-config) + +(ert-deftest test-erc-generate-buffer-name-server-and-channel () + "Normal: a target yields SERVER-CHANNEL." + (should (equal (cj/erc-generate-buffer-name '(:server "libera" :target "#emacs")) + "libera-#emacs"))) + +(ert-deftest test-erc-generate-buffer-name-server-only () + "Boundary: no target yields just the server name." + (should (equal (cj/erc-generate-buffer-name '(:server "libera")) + "libera"))) + +(ert-deftest test-erc-generate-buffer-name-missing-pieces () + "Boundary: missing server/target degrade to empty strings, not nil." + (should (equal (cj/erc-generate-buffer-name '(:target "#emacs")) "-#emacs")) + (should (equal (cj/erc-generate-buffer-name '()) ""))) + +(provide 'test-erc-config--generate-buffer-name) +;;; test-erc-config--generate-buffer-name.el ends here diff --git a/tests/test-font-config--frame-lifecycle.el b/tests/test-font-config--frame-lifecycle.el new file mode 100644 index 000000000..826edbd69 --- /dev/null +++ b/tests/test-font-config--frame-lifecycle.el @@ -0,0 +1,75 @@ +;;; test-font-config--frame-lifecycle.el --- Tests for the lifted font frame helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/apply-font-settings-to-frame, cj/cleanup-frame-list, and +;; cj/maybe-install-all-the-icons-fonts were defined inside use-package +;; :config / with-eval-after-load (unreachable under `make test'). Lifting +;; them to top level makes their branching unit-testable; env-gui-p and the +;; package side-effect calls are mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'font-config) + +(defvar cj/fontaine-configured-frames) + +(ert-deftest test-font-cleanup-frame-list-removes-frame () + "Normal: cleanup drops the given frame from the configured list." + (let ((cj/fontaine-configured-frames '(fr1 fr2 fr3))) + (cj/cleanup-frame-list 'fr2) + (should (equal cj/fontaine-configured-frames '(fr1 fr3))))) + +(ert-deftest test-font-apply-gui-unconfigured-sets-preset () + "Normal: a GUI frame not yet configured gets the preset and is tracked." + (let ((cj/fontaine-configured-frames nil) + (called nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) + (cj/apply-font-settings-to-frame (selected-frame))) + (should called) + (should (member (selected-frame) cj/fontaine-configured-frames)))) + +(ert-deftest test-font-apply-already-configured-is-noop () + "Boundary: an already-configured frame is not re-preset." + (let ((cj/fontaine-configured-frames (list (selected-frame))) + (called nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) + (cj/apply-font-settings-to-frame (selected-frame))) + (should-not called))) + +(ert-deftest test-font-apply-non-gui-is-noop () + "Boundary: without a GUI nothing is applied or tracked." + (let ((cj/fontaine-configured-frames nil) + (called nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () nil)) + ((symbol-function 'fontaine-set-preset) (lambda (_p) (setq called t)))) + (cj/apply-font-settings-to-frame (selected-frame))) + (should-not called) + (should-not (member (selected-frame) cj/fontaine-configured-frames)))) + +(ert-deftest test-font-maybe-install-icons-gui-missing-installs () + "Normal: GUI present and font missing triggers the install." + (let ((installed nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'cj/font-installed-p) (lambda (_n) nil)) + ((symbol-function 'all-the-icons-install-fonts) (lambda (&rest _) (setq installed t))) + ((symbol-function 'remove-hook) #'ignore)) + (cj/maybe-install-all-the-icons-fonts)) + (should installed))) + +(ert-deftest test-font-maybe-install-icons-already-present-skips () + "Boundary: an installed font means no install attempt." + (let ((installed nil)) + (cl-letf (((symbol-function 'env-gui-p) (lambda () t)) + ((symbol-function 'cj/font-installed-p) (lambda (_n) t)) + ((symbol-function 'all-the-icons-install-fonts) (lambda (&rest _) (setq installed t)))) + (cj/maybe-install-all-the-icons-fonts)) + (should-not installed))) + +(provide 'test-font-config--frame-lifecycle) +;;; test-font-config--frame-lifecycle.el ends here diff --git a/tests/test-jumper--location-candidates.el b/tests/test-jumper--location-candidates.el new file mode 100644 index 000000000..df095830a --- /dev/null +++ b/tests/test-jumper--location-candidates.el @@ -0,0 +1,52 @@ +;;; test-jumper--location-candidates.el --- Tests for jumper--location-candidates -*- lexical-binding: t; -*- + +;;; Commentary: +;; jumper--location-candidates is the (display . index) builder extracted from +;; the verbatim cl-loop in jumper-jump-to-location and jumper-remove-location. +;; It composes jumper--format-location (which now goes through the extracted +;; jumper--with-marker-at). The wrappers cover it transitively; this exercises +;; it directly against stored locations. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'jumper) + +(ert-deftest test-jumper-location-candidates-one-pair-per-stored-location () + "Normal: one (display . index) pair per stored location, indices in order." + (let ((saved-regs jumper--registers) + (saved-idx jumper--next-index)) + (unwind-protect + (progn + (setq jumper--registers (make-vector jumper-max-locations nil) + jumper--next-index 0) + (with-temp-buffer + (insert "line one\nline two\nline three\n") + (goto-char (point-min)) + (should (integerp (jumper--do-store-location))) ; index 0 + (forward-line 2) + (should (integerp (jumper--do-store-location))) ; index 1 + (let ((cands (jumper--location-candidates))) + (should (= (length cands) 2)) + (should (equal (mapcar #'cdr cands) '(0 1))) + (should (stringp (car (nth 0 cands)))) + (should (stringp (car (nth 1 cands))))))) + (setq jumper--registers saved-regs + jumper--next-index saved-idx)))) + +(ert-deftest test-jumper-location-candidates-empty-when-none-stored () + "Boundary: no stored locations yields an empty candidate list." + (let ((saved-regs jumper--registers) + (saved-idx jumper--next-index)) + (unwind-protect + (progn + (setq jumper--registers (make-vector jumper-max-locations nil) + jumper--next-index 0) + (should (null (jumper--location-candidates)))) + (setq jumper--registers saved-regs + jumper--next-index saved-idx)))) + +(provide 'test-jumper--location-candidates) +;;; test-jumper--location-candidates.el ends here diff --git a/tests/test-mail-config--account-search-queries.el b/tests/test-mail-config--account-search-queries.el new file mode 100644 index 000000000..9f1b6b3e6 --- /dev/null +++ b/tests/test-mail-config--account-search-queries.el @@ -0,0 +1,53 @@ +;;; test-mail-config--account-search-queries.el --- Tests for the mail account-nav helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--mail-account-search-queries (pure: account name -> the four mu4e search +;; strings) and cj/--mail-make-account-map (builds the per-account nav keymap) +;; replace three near-identical defvar-keymap blocks that differed only by +;; maildir prefix. The map test invokes each binding with mu4e-search mocked, +;; which also verifies each loop-built closure captured its own query. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'mail-config) + +(ert-deftest test-mail-account-search-queries-cmail () + "Normal: the four searches are scoped to the account's INBOX maildir." + (should (equal (cj/--mail-account-search-queries "cmail") + '(("i" . "maildir:/cmail/INBOX") + ("u" . "maildir:/cmail/INBOX AND flag:unread AND NOT flag:trashed") + ("s" . "maildir:/cmail/INBOX AND flag:flagged") + ("l" . "maildir:/cmail/INBOX AND size:5M..999M"))))) + +(ert-deftest test-mail-account-search-queries-prefix-varies () + "Boundary: only the maildir prefix changes between accounts." + (should (equal (cdr (assoc "i" (cj/--mail-account-search-queries "dmail"))) + "maildir:/dmail/INBOX")) + (should (equal (cdr (assoc "i" (cj/--mail-account-search-queries "gmail"))) + "maildir:/gmail/INBOX"))) + +(ert-deftest test-mail-make-account-map-binds-four-keys () + "Normal: the built keymap binds i/u/s/l to commands." + (let ((map (cj/--mail-make-account-map "cmail"))) + (dolist (key '("i" "u" "s" "l")) + (should (commandp (keymap-lookup map key)))))) + +(ert-deftest test-mail-make-account-map-closures-capture-distinct-queries () + "Normal: each binding runs its own account-scoped search (no closure leak). +mu4e-search is mocked to capture the query each command passes." + (let ((searched '())) + (cl-letf (((symbol-function 'mu4e-search) + (lambda (q) (push q searched)))) + (let ((map (cj/--mail-make-account-map "dmail"))) + (funcall (keymap-lookup map "i")) + (funcall (keymap-lookup map "u")))) + (should (member "maildir:/dmail/INBOX" searched)) + (should (member "maildir:/dmail/INBOX AND flag:unread AND NOT flag:trashed" + searched)))) + +(provide 'test-mail-config--account-search-queries) +;;; test-mail-config--account-search-queries.el ends here diff --git a/tests/test-modeline-config--click-map.el b/tests/test-modeline-config--click-map.el new file mode 100644 index 000000000..6c5ba4c7e --- /dev/null +++ b/tests/test-modeline-config--click-map.el @@ -0,0 +1,29 @@ +;;; test-modeline-config--click-map.el --- Tests for cj/--modeline-click-map -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--modeline-click-map is the shared mode-line `local-map' builder extracted +;; from three clickable segments (buffer-name, vc, major-mode) that each spelled +;; out the same make-sparse-keymap + define-key dance. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'modeline-config) + +(ert-deftest test-modeline-click-map-binds-mouse-1-and-3 () + "Normal: with both commands, mouse-1 and mouse-3 are bound." + (let ((map (cj/--modeline-click-map 'vc-diff 'vc-root-diff))) + (should (keymapp map)) + (should (eq (lookup-key map [mode-line mouse-1]) 'vc-diff)) + (should (eq (lookup-key map [mode-line mouse-3]) 'vc-root-diff)))) + +(ert-deftest test-modeline-click-map-mouse-1-only () + "Boundary: with no MOUSE-3, only mouse-1 is bound." + (let ((map (cj/--modeline-click-map 'describe-mode))) + (should (eq (lookup-key map [mode-line mouse-1]) 'describe-mode)) + (should (null (lookup-key map [mode-line mouse-3]))))) + +(provide 'test-modeline-config--click-map) +;;; test-modeline-config--click-map.el ends here diff --git a/tests/test-mousetrap-mode--bind-events.el b/tests/test-mousetrap-mode--bind-events.el new file mode 100644 index 000000000..6772d6fa3 --- /dev/null +++ b/tests/test-mousetrap-mode--bind-events.el @@ -0,0 +1,41 @@ +;;; test-mousetrap-mode--bind-events.el --- Tests for mouse-trap--bind-events-to-ignore -*- lexical-binding: t; -*- + +;;; Commentary: +;; mouse-trap--bind-events-to-ignore is the per-category binding loop extracted +;; from mouse-trap--build-keymap-1 (which previously nested it five deep). It +;; binds a category's events, across modifier prefixes, to `ignore'. The full +;; keymap build stays covered by test-mousetrap-mode--build-keymap.el. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'mousetrap-mode) + +(ert-deftest test-mousetrap-bind-events-wheel () + "Normal: wheel events are bound to ignore across every prefix variant." + (let ((map (make-sparse-keymap)) + (spec '((wheel . ("wheel-up" "wheel-down"))))) + (mouse-trap--bind-events-to-ignore spec '("" "C-") map) + (should (eq (lookup-key map (kbd "<wheel-up>")) #'ignore)) + (should (eq (lookup-key map (kbd "<C-wheel-up>")) #'ignore)) + (should (eq (lookup-key map (kbd "<wheel-down>")) #'ignore)))) + +(ert-deftest test-mousetrap-bind-events-click () + "Normal: type x button click events are bound to ignore." + (let ((map (make-sparse-keymap)) + (spec '((types . ("mouse" "down-mouse")) (buttons . (1 3))))) + (mouse-trap--bind-events-to-ignore spec '("") map) + (should (eq (lookup-key map (kbd "<mouse-1>")) #'ignore)) + (should (eq (lookup-key map (kbd "<mouse-3>")) #'ignore)) + (should (eq (lookup-key map (kbd "<down-mouse-1>")) #'ignore)))) + +(ert-deftest test-mousetrap-bind-events-empty-spec-no-op () + "Boundary: a spec with neither wheel nor types/buttons binds nothing." + (let ((map (make-sparse-keymap))) + (mouse-trap--bind-events-to-ignore '((other . t)) '("") map) + (should (null (lookup-key map (kbd "<mouse-1>")))))) + +(provide 'test-mousetrap-mode--bind-events) +;;; test-mousetrap-mode--bind-events.el ends here diff --git a/tests/test-org-agenda-config--base-files.el b/tests/test-org-agenda-config--base-files.el new file mode 100644 index 000000000..c6939b4d7 --- /dev/null +++ b/tests/test-org-agenda-config--base-files.el @@ -0,0 +1,36 @@ +;;; test-org-agenda-config--base-files.el --- Tests for the agenda base-file helper -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-agenda-base-files is the single source of the fixed agenda base list +;; (inbox, schedule, and the three calendars) that was previously spelled out as +;; a literal in three places. The path vars are special (defvar'd in +;; user-constants), so they can be dynamically bound here. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-agenda-config) + +(ert-deftest test-org-agenda-base-files-returns-fixed-list-in-order () + "Normal: returns inbox, schedule, gcal, pcal, dcal in that order." + (let ((inbox-file "/i") + (schedule-file "/s") + (gcal-file "/g") + (pcal-file "/p") + (dcal-file "/d")) + (should (equal (cj/--org-agenda-base-files) + '("/i" "/s" "/g" "/p" "/d"))))) + +(ert-deftest test-org-agenda-base-files-reflects-current-values () + "Boundary: the helper reads the vars at call time (not a captured snapshot)." + (let ((inbox-file "first") + (schedule-file "x") (gcal-file "x") (pcal-file "x") (dcal-file "x")) + (should (equal (car (cj/--org-agenda-base-files)) "first")) + (setq inbox-file "second") + (should (equal (car (cj/--org-agenda-base-files)) "second")) + (should (= (length (cj/--org-agenda-base-files)) 5)))) + +(provide 'test-org-agenda-config--base-files) +;;; test-org-agenda-config--base-files.el ends here diff --git a/tests/test-org-capture-config--find-or-create-top-heading.el b/tests/test-org-capture-config--find-or-create-top-heading.el new file mode 100644 index 000000000..236c87c87 --- /dev/null +++ b/tests/test-org-capture-config--find-or-create-top-heading.el @@ -0,0 +1,45 @@ +;;; test-org-capture-config--find-or-create-top-heading.el --- Tests for the shared find-or-create helper -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/--org-find-or-create-top-heading is the search-or-append positioning block +;; extracted from cj/org-capture--goto-file-headline, cj/--org-capture-goto-open-work, +;; and cj/--org-capture-goto-exact-headline. The three call sites stay covered by +;; test-org-capture-config-project-target.el (open-work, exact-headline) and the +;; target-cache test; these cover the generic helper directly with a plain regexp +;; (so the test doesn't depend on org's complex-heading format). + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-capture-config) + +(ert-deftest test-org-find-or-create-top-heading-finds-existing () + "Normal: an existing heading is found; point lands at its line start and the +buffer is unchanged." + (with-temp-buffer + (insert "* Alpha\nbody\n* Target\nmore\n") + (cj/--org-find-or-create-top-heading "^\\* Target$" "* Target") + (should (looking-at-p "\\* Target$")) + (should (equal (buffer-string) "* Alpha\nbody\n* Target\nmore\n")))) + +(ert-deftest test-org-find-or-create-top-heading-creates-when-absent () + "Boundary: with no match, the heading line is appended (a separating newline +added because the buffer doesn't end in one) and point lands on it." + (with-temp-buffer + (insert "some text") ; no trailing newline + (cj/--org-find-or-create-top-heading "^\\* Missing$" "* Missing") + (should (equal (buffer-string) "some text\n* Missing\n")) + (should (looking-at-p "\\* Missing$")))) + +(ert-deftest test-org-find-or-create-top-heading-empty-buffer () + "Boundary: in an empty buffer the heading is inserted at the top, no extra +leading newline." + (with-temp-buffer + (cj/--org-find-or-create-top-heading "^\\* X$" "* X") + (should (equal (buffer-string) "* X\n")) + (should (looking-at-p "\\* X$")))) + +(provide 'test-org-capture-config--find-or-create-top-heading) +;;; test-org-capture-config--find-or-create-top-heading.el ends here diff --git a/tests/test-prog-general--deadgrep.el b/tests/test-prog-general--deadgrep.el new file mode 100644 index 000000000..21223105d --- /dev/null +++ b/tests/test-prog-general--deadgrep.el @@ -0,0 +1,44 @@ +;;; test-prog-general--deadgrep.el --- Tests for the deadgrep helpers -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/deadgrep--initial-term (region text or symbol at point) and cj/--deadgrep-run +;; (the normalize-root + read-term + invoke tail shared by cj/deadgrep-here and +;; cj/deadgrep-in-dir) were lifted out of the deadgrep use-package :config. +;; deadgrep is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +(ert-deftest test-prg-deadgrep-initial-term-symbol-at-point () + "Normal: with no region, the symbol at point seeds the search." + (with-temp-buffer + (insert "hello world") + (goto-char (point-min)) + (should (equal (cj/deadgrep--initial-term) "hello")))) + +(ert-deftest test-prg-deadgrep-initial-term-region () + "Normal: an active region's text seeds the search." + (with-temp-buffer + (insert "needle") + (transient-mark-mode 1) + (set-mark (point-min)) + (goto-char (point-max)) + (activate-mark) + (should (equal (cj/deadgrep--initial-term) "needle")))) + +(ert-deftest test-prg-deadgrep-run-normalizes-root-and-passes-term () + "Normal: ROOT is normalized to a directory and TERM is passed through." + (let (got-term got-root) + (cl-letf (((symbol-function 'deadgrep) + (lambda (term root) (setq got-term term got-root root)))) + (cj/--deadgrep-run "/tmp/foo" "needle")) + (should (equal got-term "needle")) + (should (equal got-root "/tmp/foo/")))) + +(provide 'test-prog-general--deadgrep) +;;; test-prog-general--deadgrep.el ends here diff --git a/tests/test-prog-general--find-project-root-file.el b/tests/test-prog-general--find-project-root-file.el new file mode 100644 index 000000000..97db0b979 --- /dev/null +++ b/tests/test-prog-general--find-project-root-file.el @@ -0,0 +1,49 @@ +;;; test-prog-general--find-project-root-file.el --- Tests for cj/find-project-root-file -*- lexical-binding: t; -*- + +;;; Commentary: +;; cj/find-project-root-file returns the first file in the current Projectile +;; project root matching a regexp (string or rx form), case-insensitively. It +;; was defined inside the projectile use-package :config (unreachable under +;; `make test'); lifting it to top level makes it unit-testable. projectile's +;; root and directory-files are mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) +(require 'seq) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +(defmacro test-prg--with-root (files &rest body) + "Run BODY with projectile-project-root \"/proj/\" and directory-files = FILES." + (declare (indent 1)) + `(cl-letf (((symbol-function 'projectile-project-root) (lambda (&rest _) "/proj/")) + ((symbol-function 'directory-files) (lambda (&rest _) ,files))) + ,@body)) + +(ert-deftest test-prg-find-root-file-string-regexp () + "Normal: a string regexp matches case-insensitively." + (test-prg--with-root '("README.md" "TODO.org" "src") + (should (equal (cj/find-project-root-file "^todo\\.org$") "TODO.org")))) + +(ert-deftest test-prg-find-root-file-rx-form () + "Normal: an rx form is converted and matched." + (test-prg--with-root '("notes.txt" "todo.md" "x") + (should (equal (cj/find-project-root-file + '(seq bos "todo." (or "org" "md" "txt") eos)) + "todo.md")))) + +(ert-deftest test-prg-find-root-file-no-match () + "Boundary: no matching file yields nil." + (test-prg--with-root '("a.el" "b.el") + (should (null (cj/find-project-root-file "^todo\\.org$"))))) + +(ert-deftest test-prg-find-root-file-no-project () + "Boundary: outside a project (nil root) yields nil." + (cl-letf (((symbol-function 'projectile-project-root) (lambda (&rest _) nil))) + (should (null (cj/find-project-root-file "^todo\\.org$"))))) + +(provide 'test-prog-general--find-project-root-file) +;;; test-prog-general--find-project-root-file.el ends here diff --git a/tests/test-system-lib--format-region-with-program.el b/tests/test-system-lib--format-region-with-program.el new file mode 100644 index 000000000..29b392b84 --- /dev/null +++ b/tests/test-system-lib--format-region-with-program.el @@ -0,0 +1,68 @@ +;;; test-system-lib--format-region-with-program.el --- Tests for cj/format-region-with-program -*- lexical-binding: t; -*- + +;;; Commentary: +;; `cj/format-region-with-program' runs an external formatter over the whole +;; buffer via `call-process-region' (argv, no shell) and replaces the buffer +;; only when the program exits zero. Extracted from the byte-identical +;; per-language helpers in prog-json.el / prog-yaml.el, so this is the first +;; direct unit coverage of the logic. call-process-region is mocked at the +;; boundary (the established pattern in test-prog-json--json-format-buffer.el). + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'system-lib) + +(ert-deftest test-system-lib-format-region-with-program-replaces-on-success () + "Normal: on exit 0 the buffer is replaced with the program's output, returns t." + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end _prog &rest rest) + (with-current-buffer (nth 1 rest) (insert "FORMATTED")) + 0))) + (with-temp-buffer + (insert "raw") + (should (eq t (cj/format-region-with-program "fmt"))) + (should (equal "FORMATTED" (buffer-string)))))) + +(ert-deftest test-system-lib-format-region-with-program-forwards-argv () + "Normal: PROGRAM and ARGS reach call-process-region as argv (no shell)." + (let (got-prog got-args) + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end prog &rest rest) + (setq got-prog prog + got-args (nthcdr 3 rest)) + (with-current-buffer (nth 1 rest) (insert "x")) + 0))) + (with-temp-buffer + (cj/format-region-with-program "jq" "--sort-keys" "."))) + (should (equal "jq" got-prog)) + (should (equal '("--sort-keys" ".") got-args)))) + +(ert-deftest test-system-lib-format-region-with-program-empty-output () + "Boundary: empty program output empties the buffer and still returns t." + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end _prog &rest _rest) 0))) ; writes nothing + (with-temp-buffer + (insert "raw") + (should (eq t (cj/format-region-with-program "fmt"))) + (should (equal "" (buffer-string)))))) + +(ert-deftest test-system-lib-format-region-with-program-nonzero-untouched () + "Error: a non-zero exit leaves the buffer untouched and signals user-error +carrying the program's stderr text." + (cl-letf (((symbol-function 'call-process-region) + (lambda (_start _end _prog &rest rest) + (with-current-buffer (nth 1 rest) (insert "boom: bad input")) + 1))) + (with-temp-buffer + (insert "raw") + (let ((err (should-error (cj/format-region-with-program "fmt") + :type 'user-error))) + (should (string-match-p "boom: bad input" (error-message-string err)))) + (should (equal "raw" (buffer-string)))))) + +(provide 'test-system-lib--format-region-with-program) +;;; test-system-lib--format-region-with-program.el ends here diff --git a/tests/test-ui-navigation--window-resize.el b/tests/test-ui-navigation--window-resize.el index 3be0313b8..553219755 100644 --- a/tests/test-ui-navigation--window-resize.el +++ b/tests/test-ui-navigation--window-resize.el @@ -24,8 +24,11 @@ (should (eq (keymap-lookup cj/window-resize-map "<down>") #'windsize-down))) (ert-deftest test-ui-navigation-window-resize-sticky-dispatches-and-arms () - "Normal: `cj/window-resize-sticky' runs the `windsize' command matching the -arrow key that triggered it, then arms the sticky-repeat map." + "Normal: with more than one window, `cj/window-resize-sticky' runs the +`windsize' command matching the arrow key that triggered it, then arms the +sticky-repeat map. `one-window-p' is forced nil so the resize path is taken +deterministically -- in `--batch' the sole frame is one-window-p, which would +otherwise route to the pull-away path." (dolist (case '((left . windsize-left) (right . windsize-right) (up . windsize-up) @@ -33,13 +36,45 @@ arrow key that triggered it, then arms the sticky-repeat map." (let ((ran nil) (overriding-terminal-local-map nil) (pre-command-hook nil)) - (cl-letf (((symbol-function (cdr case)) + (cl-letf (((symbol-function 'one-window-p) (lambda (&rest _) nil)) + ((symbol-function (cdr case)) (lambda (&rest _) (interactive) (setq ran t)))) (let ((last-command-event (car case))) (cj/window-resize-sticky))) (should ran) ; dispatched to the right command (should overriding-terminal-local-map)))) ; loop armed +(ert-deftest test-ui-navigation-window-pull-side () + "Normal/Error: each arrow maps to the *opposite* side (where the revealed +window opens, so the current window keeps the arrow's edge); anything else +is nil." + (should (eq (cj/window-pull-side "<down>") 'above)) + (should (eq (cj/window-pull-side "<up>") 'below)) + (should (eq (cj/window-pull-side "<left>") 'right)) + (should (eq (cj/window-pull-side "<right>") 'left)) + (should (null (cj/window-pull-side "<prior>"))) + (should (null (cj/window-pull-side "x")))) + +(ert-deftest test-ui-navigation-window-resize-sticky-sole-window-pulls-away () + "Normal: with a single window, the arrow pulls a sliver away on the side +opposite the arrow (via `cj/window--pull-away') rather than resizing, then +arms the loop. `cj/window--pull-away' is stubbed to capture the side so no +real window split happens under `--batch'." + (dolist (case '((down . above) + (up . below) + (left . right) + (right . left))) + (let ((pulled nil) + (overriding-terminal-local-map nil) + (pre-command-hook nil)) + (cl-letf (((symbol-function 'one-window-p) (lambda (&rest _) t)) + ((symbol-function 'cj/window--pull-away) + (lambda (dir) (setq pulled dir)))) + (let ((last-command-event (car case))) + (cj/window-resize-sticky))) + (should (eq pulled (cdr case))) ; pulled toward the arrow + (should overriding-terminal-local-map)))) ; loop armed + (ert-deftest test-ui-navigation-window-resize-bound-under-c-semicolon-b () "Normal: `C-; b <arrow>' (each direction) reaches the sticky-resize command." (require 'custom-buffer-file) diff --git a/tests/test-ui-theme-commands.el b/tests/test-ui-theme-commands.el index 4e3ce7f28..1b273cf57 100644 --- a/tests/test-ui-theme-commands.el +++ b/tests/test-ui-theme-commands.el @@ -7,7 +7,6 @@ ;; cj/switch-themes ;; cj/save-theme-to-file ;; cj/get-active-theme-name -;; cj/load-fallback-theme ;;; Code: @@ -68,23 +67,6 @@ does not raise." (cj/save-theme-to-file)) (should (string-match-p "Cannot save theme" messaged)))) -;;; cj/load-fallback-theme - -(ert-deftest test-ui-theme-load-fallback-disables-then-loads () - "Normal: load-fallback-theme disables all then loads the fallback." - (let ((fallback-theme-name "modus-vivendi") - (custom-enabled-themes '(old-one old-two)) - disabled loaded) - (cl-letf (((symbol-function 'disable-theme) - (lambda (theme) (push theme disabled))) - ((symbol-function 'load-theme) - (lambda (theme &optional _no-confirm _no-enable) - (push theme loaded))) - ((symbol-function 'message) #'ignore)) - (cj/load-fallback-theme "boom")) - (should (equal (sort (copy-sequence disabled) #'string<) '(old-one old-two))) - (should (equal loaded '(modus-vivendi))))) - ;;; cj/switch-themes (ert-deftest test-ui-theme-switch-disables-loads-then-saves () @@ -55,11 +55,134 @@ Tags are additive. For example, a small wrong-behavior fix can be =:bug:quick:=, and a feature that requires internal restructuring can be =:feature:refactor:=. * Emacs Open Work -** DONE [#C] todo.org org-lint follow-ups :refactor: -CLOSED: [2026-06-20 Sat] -From the lint-org sweeps (2026-06-15, refreshed 2026-06-20). Resolved 2026-06-20: the misplaced-heading false positive was reworded (the bug-capture task's prose quoted heading-like "* TODO" strings), and the broken link was repointed from the missing =~/code/signel/todo.org= to =~/code/smoke/todo.org= (smoke is the evolved Signal package). The obsolete-properties-drawer entries no longer reproduce under a full org-lint pass. Both lint-org --check and the built-in org-lint now report zero. +** TODO [#B] Codebase refactoring program — remaining batch :refactor:solo: +Resumes the full-codebase refactoring scan run of 2026-06-20 (8-agent fan-out over +modules/ + scripts/theme-studio/). The goal: apply every scan finding except the +won't-do items, one focused refactor per commit. 20 done and pushed this session +(see =.ai/sessions/= for the 2026-06-20 log); 13 remain, listed below. + +*** Working protocol (apply to every item) +- TDD: write/keep a failing-then-green test; harvest new test seams the refactor opens. +- Behavior-preserving only. If a "dedup" would delete a real test seam or couple + dissimilar code, SKIP it and record why (see skips below). +- Per refactor, verify in this order, then commit + push (no-approvals mode): + 1. =make test-file FILE=<basename.el>= for touched + new tests. + 2. =make validate-modules= (loads all 123 modules; catches load/paren errors). + 3. Init-launch smoke on a throwaway daemon: =emacs --daemon=cj-sNN=, then + =emacsclient -s cj-sNN -e '(emacs-pid)'= to capture the PID, check + =(length features)= = 807 and no init errors in the log, then kill by that + PID (the emacsclient kill-emacs is flaky; pkill -f 'daemon=cj-sNN' + self-matches its own shell — kill the captured PID). + 4. Live-reload the edited module into Craig's running daemon + (=emacsclient -e '(load "/home/cjennings/.emacs.d/modules/<m>.el")'=); skip + the live reload for big use-package modules whose :config restacks (verify via + the fresh smoke daemon instead, as with mail-config). +- Tab-heavy files: =sed -n 'A,Bp' FILE | cat -A= to get exact bytes before an Edit; + write NEW code in the documented 2-space style. +- Shared asset already created: =cj/format-region-with-program= in system-lib.el + (the run-a-formatter-over-the-buffer helper). Reuse it for any further + format-region duplicates. + +*** Remaining — medium extractions +- calibredb-epub-config.el: =cj/nov-update-layout= (~29 lines, nesting 5) — extract + a render-preserving-position helper + a margin/fringe helper; also the =#E8DCC0= + sepia literal repeated 3x in =cj/nov-apply-preferences= → a local binding. Visual; + verify with the reload-and-verify loop. +- ai-term.el: =cj/ai-term= toggle-off pcase arm (~50 of its ~76 lines) — extract the + teardown into =cj/--ai-term-toggle-off (win)=; and the 3x "switch window to + most-recent non-agent buffer" idiom (lines ~813-817, 839-843, 884-887) → + =cj/--ai-term-swap-to-working-buffer=. Behavior-sensitive window logic; existing + tests test-ai-term--single-window-toggle / --collapse-split are the net. +- calendar-sync.el: =calendar-sync--collect-recurrence-exceptions= (~457-504, nesting + 5, a 14-binding let*) — extract =calendar-sync--parse-exception-event (event-str)= + returning the exception plist; the dolist body becomes a thin puthash. Has a + dedicated test (characterization net). +- dirvish-config.el: =cj/dired-create-playlist-from-marked= (nesting 5) — extract a + pure =cj/--playlist-resolve-target= (the name-validate + overwrite-prompt loop), + leaving filter → resolve → write. +- custom-case.el: =cj/title-case-region= (~71 lines, cyclomatic ~16) — write a + characterization test FIRST, then extract =cj/--title-case-word= (the per-word + decision); main loops boundaries and delegates. + +*** Remaining — big single-file (characterization tests first) +- custom-comments.el: the divider/box render-skeleton duplication — simple-divider vs + padded-divider (~40 lines each, differ only in the padding loop) and box vs + heavy-box (~45 each, heavy-box just adds two blank inserts); plus the comment-syntax + prologue repeated 7x and the doubled-semicolon / length-option constants. Extract a + shared emit-prefix helper + a border/text/border emitter parameterized by padding + lambda + extra-blank-lines. Insertion-order-sensitive: characterize each generator's + output before refactoring. The heaviest item. +- dwim-shell-config.el: ~46 =cj/dwim-shell-commands-*= defuns are trapped in the + =use-package dwim-shell-command :config=, so untestable under =make test=. For the + branching ones (=-video-trim= pcase x3, =-text-to-speech= darwin/linux, + =-extract-archive=/zip/tar single-vs-multi), extract each command's command-string + construction into a top-level pure =cj/dwim-shell--<name>-command= (takes prompted + values, returns the template string), leaving a thin interactive wrapper in :config. + Mirrors the existing =cj/dwim-shell--dated-backup-command= pattern. Do the + high-value branching commands; the trivial ones can stay. + +*** Remaining — theme-studio (scripts/theme-studio/) +Suite: =make check= (Python/Node/ERT) + =./run-tests.sh= (browser gates) + +=make check-generated= (byte-identical html) + =make coverage=. After ANY +generate.py-output change, stage theme-studio.html in the SAME commit +(check-generated compares to the working tree, not HEAD). +- app-core.js: =dropdownRowTextColor= is exported + has 4 tests but no runtime caller + (live path computes inline at app.js:82). Decide: wire it into the dropdown popup + row painting, or delete it + its 4 tests. Needs Craig's intent — default to delete. +- generate.py: ~230 lines of module-level build run at import; =face_coverage.py= does + =import generate= just for two constants and pays the whole cost. Wrap the assembly + in =build()= gated behind =__main__=; keep UI_FACES/CATS/COLS cheap module + constants. (The CRITICAL item.) +- capture-default-faces.py: =condition_matches= (166-206) has parallel dict-branch and + list-branch clause checkers encoding the same four rules + constants twice. Normalize + both shapes to one mapping, run one set of checks. NOT in =make check= — verify by + running it. +- face_coverage.py: =bucket_from_source= (118) and =bucket_of_source= (157) duplicate + the elpa/user/builtin path-kind detection. Extract =path_kind(path)= and have both + map its result to their own vocabulary. +- browser-gates.js (HIGHEST RISK — rewrites the harness that verifies everything): + ~39/44 gates copy-paste the =let ok=true;const notes=[];const A=(c,n)=>{...}= setup + + the =document.title=...; result-div= postamble (note format already drifted: 17 use + " | " vs 24 " fails="). Extract one =gate(name, body)= helper. CRITICAL CONSTRAINT: + each gate's =if(...)= MUST keep the literal substring =location.hash==='#NAMEtest'= + because run-tests.sh:76 discovers gates by grepping exactly that — a registry/loop + that hides the hash check breaks discovery (silent false-green). Pair with a + =withSavedState(keys, body)= helper for the ~13 mutating gates' inconsistent + PALETTE/MAP/UIMAP/SYNTAX snapshot-restore (7 mutating gates currently restore + nothing). Verify: all gates green AND a deliberately-broken assertion still FAILS + (prove the harness can't manufacture greens). Also =assertPreviewFaces= for the 3 + copy-pasted preview-face validators (mdtest/mupreviewtest/gnustest). +- theme-studio test files: =plan(overrides)= factory for the ~30 planPaletteGenerator + full-option-literal calls (test-app-core.mjs + test-palette-generator-core.mjs); one + shared =stripExports= (reimplemented 3x in app-core/colormath/app-util tests, must + stay aligned with generate.py's strip per test_generate.py:48); and an + =assertInlinedVerbatim(name)= loop for the 5 inline-integrity cases. + +*** WON'T-DO (do not re-attempt — assessed and rejected) +- theme-studio buildTable/buildUITable/buildPkgTable merge: genuine per-tier divergence + (column order, syntax dual fg/bg dropdowns, ui preview cell, pkg nd markers) + the + =.cells[N]= positional sort coupling make a unified builder MORE complex than the + three explicit ones. Close as won't-do. +- Cross-language test overlap (browser-gates preview gate vs test_generate.py + PackageFaceCoverage): don't merge — would couple a fast Python test to a headless + browser run. A one-line comment in each noting the split is the most that's worth it. + +*** Skipped this run (with reasons — don't redo) +- eshell-config ssh-alias "merge the two helpers": =cj/--eshell-ssh-alias-commands= is + a deliberate pure/effectful split with 3 dedicated tests; merging deletes the seam. +- prog-*-setup boilerplate: only python+webdev share the full pattern; shell/c/elisp/ + common-lisp differ materially. A keyword-arg helper would be less readable. No + premature abstraction. +- erc join-command =cj/erc--ensure-active-connection= extraction: nesting-only on + untestable UI (call-interactively/switch-to-buffer), no test seam, risky tab-rewrite. +- coverage-core =simplecov-executable-lines= vs =parse-simplecov= clone: borderline + MEDIUM, differs only by a =(> hits 0)= predicate; parameterize with a keep-line-p + only if revisiting. Low priority. ** TODO [#B] Un-pin ghostel from 0.33.0 once upstream fixes #422/#423 :bug: +:PROPERTIES: +:LAST_REVIEWED: 2026-06-20 +:END: ghostel is held at 0.33.0 (=ghostel-20260604.2049=, commit 5779a2adceb2) in =modules/term-config.el= to dodge the 0.35.x native-PTY crash. When dakra/ghostel ships a fix for #422 (Linux malloc/signal reentrancy) and #423 (macOS recursive lock), restore =:ensure t= (drop the pin comment) and =package-upgrade ghostel=, then re-run the open-ghostel-in-a-GUI-frame survival check. Watch the two issues for the fixing commit. archsetup automated the zig 0.15.2 pin (managed =install_zig_pin= step, sha-verified, unit-tested). If the un-pinned ghostel bumps its ghostty dependency to a newer zig, send archsetup the new version + sha256 so it bumps its =ZIG_VERSION= / =ZIG_SHA256= constants (=inbox-send archsetup=). @@ -82,6 +205,9 @@ Needs from Craig: re-enabling native-comp config-wide is a stability/perf judgme From the 2026-06 config audit (verified against the live daemon). =early-init.el:69= =(setq native-comp-deferred-compilation nil)= — the obsolete alias of =native-comp-jit-compilation= — turns JIT native compilation OFF entirely, not "synchronous" as the comment claims: 19 .eln files exist for 184 packages, ~100 of 121 modules run interpreted for the daemon's lifetime, and system-defaults.el:42-44's speed-3/8-jobs/always-compile settings are dead. Plus =early-init.el:113-116= restores =gc-cons-threshold= to the captured STOCK default (800000, verified) post-startup — frequent small GC pauses forever. Together these plausibly feed the filed org-capture 15-20s task more than anything in the capture path itself. Actions: retest the old "Selecting deleted buffer" race on 30.2 and re-enable JIT (or AOT sweep); set a deliberate 16-64MB threshold (or gcmh). Check both before burning time on the capture-perf debug task. ** VERIFY [#B] calendar-sync robustness: atomic writes, curl --fail, zero-event false errors :bug:solo:next: +:PROPERTIES: +:LAST_REVIEWED: 2026-06-20 +:END: Deferred, pairs with the calendar-sync recurrence VERIFY above. The mechanical parts (write to a temp file + rename, add curl --fail, guard the zero-event case) are doable, but any calendar-sync change needs verification against a real .ics feed to avoid masking a genuine empty/failed sync. Do this together with the recurrence fix once you provide a fixture / confirm the live feed. From the 2026-06 config audit, =modules/calendar-sync.el=: - =:1309= — agenda file written via =with-temp-file= directly on the target (truncate-in-place); org-agenda/chime reading mid-write sees a partial calendar, hourly. Write temp + =rename-file= (atomic same-fs). Same for =--save-state= :258. @@ -89,18 +215,23 @@ From the 2026-06 config audit, =modules/calendar-sync.el=: - =:1229-1233= — =--parse-ics= returns nil for both garbage and a valid calendar with zero in-window events, so healthy near-empty calendars report "parse failed" in =calendar-sync-status=. Distinguish the cases. ** VERIFY [#B] org-roam :config triggers the 15-20s refile scan synchronously at first idle :bug:solo:next: +:PROPERTIES: +:LAST_REVIEWED: 2026-06-20 +:END: Needs from Craig: this is measurement-first (perf), not a blind fix — it's the same bottleneck as the "optimize org-capture target building" debug task. Run /debug with debug-profiling to measure what actually costs the 15-20s (file count? regex? agenda rebuild?), then fix from the data. I won't restructure the refile/agenda scan without a profile. Say "let's debug it" and I'll profile + fix. =modules/org-roam-config.el:78-79= — org-roam is =:defer 1=, so its :config calls =cj/build-org-refile-targets= at 1s idle, BEFORE the 5s background timer (=org-refile-config.el:144-151=); on a cold cache the 30k-file scan runs inline and freezes Emacs at first idle. Drop the call — org-roam is loaded long before the 5s timer fires. Likely a player in the filed org-capture 15-20s perf task (=[#B] Optimize org-capture target building performance=) — check both together. From the 2026-06 config audit. ** VERIFY [#B] transcription: stderr never reaches the log, video transcripts stranded in /tmp :bug:solo:next: +:PROPERTIES: +:LAST_REVIEWED: 2026-06-20 +:END: Deferred from the batch (no blocker; needs a focused pass with live verification). Plan: (1) transcription-config.el:210 — make-process :stderr with a file path creates a buffer, not a file; route stderr into the process buffer and write the captured text out in the sentinel, then drop the leaked buffer. (2) :370-374 — derive the txt/log base from the VIDEO path, not the temp mp3's /tmp path, so transcripts land alongside the source. The path-derivation half is cleanly unit-testable; the stderr half needs a real transcription run to verify, which is why I held it for a focused session rather than the batch. From the 2026-06 config audit, =modules/transcription-config.el=: - =:210= — =make-process :stderr= with a file PATH creates a BUFFER named like the path (verified by probe); the "Errored. Logs in <file>" notification points at a log without the error text, and the hidden stderr buffer leaks per transcription. Route stderr into the process buffer or write it out in the sentinel. - =:370-374= — video path derives txt/log from the temp mp3's /tmp path; the transcript lands in /tmp and dies on reboot, contradicting the "alongside the source" docstring. Pass the video's path as the output base. -** VERIFY [#C] Dirvish: free D for hard-delete, move duplicate :feature:quick:next: -Needs from Craig: two confirmations before I wire this. (1) Which key for the moved duplicate command (your note said "duplicate on 2" — confirm 2)? (2) Binding D to sudo rm -rf is genuinely dangerous; confirm you want a forced hard-delete on a single capital key, and whether it should prompt (yes-or-no-p naming the target) before running. I won't bind an unguarded sudo rm -rf autonomously. -In dirvish, keep =d= = delete (=dired-do-delete=), move duplicate (=cj/dirvish-duplicate-file=, currently =D=) to another key, and bind =D= = =sudo rm -rf= for a forced hard delete — capital for the more destructive op. Craig's note says "duplicate on 2"; confirm that's the intended key, and guard the sudo path carefully before wiring. From the roam inbox. +** 2026-06-20 Sat @ 10:29:42 -0400 Dirvish: d duplicates, D force-deletes (guarded) +Decided with Craig 2026-06-20: remove delete-to-trash entirely, bind =d= = =cj/dirvish-duplicate-file= and =D= = =cj/dirvish-hard-delete= (sudo rm -rf after a =yes-or-no-p= naming the exact targets). Built in =modules/dirvish-config.el= (=cj/--dirvish-hard-delete-command= pure builder + =cj/dirvish-hard-delete= command; keymap =d=/=D= swap). 4 ERT tests for the command builder; full suite green; live-reloaded into the daemon (=dirvish-mode-map= =d=/=D= rebinding confirmed). Manual keypress + sudo-flow check filed under Manual testing and validation. ** VERIFY [#C] page-signal pager account deregistered — re-registration needs your hands :PROPERTIES: @@ -108,11 +239,13 @@ In dirvish, keep =d= = delete (=dired-do-delete=), move duplicate (=cj/dirvish-d :END: Reported by .emacs.d 2026-06-12 01:01: the dedicated pager number (+15045173983, the Claude Pager Google Voice number on signal-cli) returns "User ... is not registered" on every send — Signal appears to have deregistered it (GV numbers get periodically re-verified). Re-registration requires captcha/SMS, which only you can do. Until then every page-signal call fails; .emacs.d's config-audit page fell back to email. Wrapper lives at claude-templates/bin/page-signal. -** VERIFY [#C] Pull a fullscreen terminal window away with C-; b + arrow :feature:next: -Needs from Craig: confirm the intended behavior. When a terminal fills the frame, C-; b + arrow should "pull a window away" — split off a new window in the arrow's direction and move focus there? Or pop the terminal out and restore the prior layout? The C-; b window family exists (resize lives there); I need the exact gesture + target before wiring it. -When a terminal fills the frame, =C-; b= then a right or down arrow should shrink the window from that edge, reducing its width or height so another buffer can share the screen without leaving the terminal. Relates to the ai-term adaptive placement and unified-popup tasks. From the roam inbox. +** 2026-06-20 Sat @ 10:29:42 -0400 C-; b + arrow pulls a window away from a sole window +Decided with Craig 2026-06-20: when the selected window is the sole window, =C-; b= + arrow keeps that window on the arrow's edge and slivers =other-buffer= in on the opposite side (=minimize-window=, so the current window keeps almost the whole frame), focus staying put; each further arrow then shrinks it step by step via =windsize=, reading the same as resizing an existing split. Generalizes to any sole window, not just terminals — resize was a no-op there before. Built in =modules/ui-navigation.el= (=cj/window-pull-side= pure mapping + =cj/window--pull-away= + a =one-window-p= branch in =cj/window-resize-sticky=). ERT tests for the mapping and both sticky paths; geometry verified in a headless frame (down -> terminal 37/40 at the bottom, reveal 2 lines slivered on top via window-min-height=1, windsize-down then steps it down); full suite green; live-reloaded into the daemon. Refined from a first cut that split toward the arrow and jumped to 50%, per Craig's feedback. Manual gesture check filed under Manual testing and validation. ** VERIFY [#C] Remove unused system-power keybindings :refactor:quick:next: +:PROPERTIES: +:LAST_REVIEWED: 2026-06-20 +:END: Needs from Craig: the task says "confirm the exact set to keep before unbinding." Under C-; ! the bindings are shutdown (s), reboot (r), restart-Emacs (e), and friends. Tell me which to keep bound and which to drop (the completing-read menu still reaches the rare ones), and I'll unbind the rest. =modules/system-commands.el= binds shutdown (=C-; ! s=), reboot (=C-; ! r=), restart-Emacs (=C-; ! e=) and friends under the =C-; != prefix. Craig rarely uses them and wants the key real-estate back. Drop the bindings he doesn't use; the completing-read menu can still reach the rare ones. Confirm the exact set to keep before unbinding. From the roam inbox. @@ -330,6 +463,14 @@ What we're verifying: C-c c t and C-c c b file into the current projectile proje - Run C-c c b (Bug) similarly and confirm it lands as "* TODO [#C] ..." under the same header. - Run a capture from outside any project (or a project with no todo.org) and confirm the global-inbox fallback with a warning. Expected: in-project captures land in that project's Open Work; out-of-project captures fall back to the global inbox with a warning. +*** VERIFY Dirvish d duplicates, D force-deletes with a confirm +What we're verifying: in dirvish, d now duplicates the file at point (delete-to-trash removed), and D force-deletes the marked files via sudo rm -rf after a yes-or-no-p naming the targets. The pure command builder is unit-tested; this is the live keypress plus the guarded destructive path. +- Open dirvish on a scratch directory holding a couple of throwaway files +- Put point on a file and press d — confirm a "<name>-copy.<ext>" appears (a duplicate, nothing deleted) +- Mark one or two throwaway files, press D, and read the "Force-delete (sudo rm -rf, NO undo): <names>?" prompt +- Answer no first (confirm nothing happens), then press D again and answer yes +- Note whether sudo prompts for a password and whether the file actually disappears +Expected: d duplicates; D names the exact targets and only deletes on yes; the files are gone with no trash copy. If sudo needs a password that shell-command can't supply, flag it — the delete may need to route through a tty instead. ** PROJECT [#A] Theme-Studio Open Work Parent grouping the open theme-studio / theming issues; close each child independently. @@ -8585,3 +8726,6 @@ Compare mode (=make face-coverage-diff=): - Optional: append a dated =covered/total= line to a small coverage-log for progress over time. Dump from the live daemon by default (reflects the packages actually run); the batch fallback won't see lazily-loaded packages until required. +** DONE [#C] todo.org org-lint follow-ups :refactor: +CLOSED: [2026-06-20 Sat] +From the lint-org sweeps (2026-06-15, refreshed 2026-06-20). Resolved 2026-06-20: the misplaced-heading false positive was reworded (the bug-capture task's prose quoted heading-like "* TODO" strings), and the broken link was repointed from the missing =~/code/signel/todo.org= to =~/code/smoke/todo.org= (smoke is the evolved Signal package). The obsolete-properties-drawer entries no longer reproduce under a full org-lint pass. Both lint-org --check and the built-in org-lint now report zero. |