diff options
Diffstat (limited to 'modules')
| -rw-r--r-- | modules/ai-conversations.el | 3 | ||||
| -rw-r--r-- | modules/browser-config.el | 81 | ||||
| -rw-r--r-- | modules/custom-misc.el | 90 | ||||
| -rw-r--r-- | modules/custom-ordering.el | 228 | ||||
| -rw-r--r-- | modules/custom-text-enclose.el | 295 | ||||
| -rw-r--r-- | modules/custom-whitespace.el | 196 | ||||
| -rw-r--r-- | modules/flyspell-and-abbrev.el | 2 | ||||
| -rw-r--r-- | modules/font-config.el | 2 | ||||
| -rw-r--r-- | modules/jumper.el | 255 | ||||
| -rw-r--r-- | modules/lipsum-generator.el | 9 | ||||
| -rw-r--r-- | modules/lorem-optimum.el (renamed from modules/lorem-generator.el) | 102 | ||||
| -rw-r--r-- | modules/org-agenda-config.el | 2 | ||||
| -rw-r--r-- | modules/org-contacts-config.el | 155 | ||||
| -rw-r--r-- | modules/org-roam-config.el | 88 | ||||
| -rw-r--r-- | modules/org-webclipper.el | 80 | ||||
| -rw-r--r-- | modules/reconcile-open-repos.el | 1 | ||||
| -rw-r--r-- | modules/test-runner.el | 331 | ||||
| -rw-r--r-- | modules/wip.el | 1 |
18 files changed, 1346 insertions, 575 deletions
diff --git a/modules/ai-conversations.el b/modules/ai-conversations.el index 92549176..4f97d761 100644 --- a/modules/ai-conversations.el +++ b/modules/ai-conversations.el @@ -159,7 +159,6 @@ Expect FILENAME to match _YYYYMMDD-HHMMSS.gptel." (or (get-buffer buf-name) (user-error "Could not create or find *AI-Assistant* buffer")))) -;;;###autoload (defun cj/gptel-save-conversation () "Save the current AI-Assistant buffer to a .gptel file. @@ -188,7 +187,6 @@ Enable autosave for subsequent AI responses to the same file." (setq-local cj/gptel-autosave-enabled t)) (message "Conversation saved to: %s" filepath)))) -;;;###autoload (defun cj/gptel-delete-conversation () "Delete a saved GPTel conversation file (chronologically sorted candidates)." (interactive) @@ -218,7 +216,6 @@ Enable autosave for subsequent AI responses to the same file." (when (looking-at "^\n+") (delete-region (point) (match-end 0))))) -;;;###autoload (defun cj/gptel-load-conversation () "Load a saved GPTel conversation into the AI-Assistant buffer. diff --git a/modules/browser-config.el b/modules/browser-config.el index fddc02e6..52c3b8a6 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -80,19 +80,44 @@ Returns the browser plist if found, nil otherwise." cj/saved-browser-choice)) (error nil)))) -(defun cj/apply-browser-choice (browser-plist) - "Apply the browser settings from BROWSER-PLIST." - (when browser-plist +(defun cj/--do-apply-browser-choice (browser-plist) + "Apply the browser settings from BROWSER-PLIST. +Returns: \\='success if applied successfully, + \\='invalid-plist if browser-plist is nil or missing required keys." + (if (null browser-plist) + 'invalid-plist (let ((browse-fn (plist-get browser-plist :function)) (executable (plist-get browser-plist :executable)) (path (plist-get browser-plist :path)) (program-var (plist-get browser-plist :program-var))) - ;; Set the main browse-url function - (setq browse-url-browser-function browse-fn) - ;; Set the specific browser program variable if it exists - (when program-var - (set program-var (or path executable))) - (message "Default browser set to: %s" (plist-get browser-plist :name))))) + (if (null browse-fn) + 'invalid-plist + ;; Set the main browse-url function + (setq browse-url-browser-function browse-fn) + ;; Set the specific browser program variable if it exists + (when program-var + (set program-var (or path executable))) + 'success)))) + +(defun cj/apply-browser-choice (browser-plist) + "Apply the browser settings from BROWSER-PLIST." + (pcase (cj/--do-apply-browser-choice browser-plist) + ('success (message "Default browser set to: %s" (plist-get browser-plist :name))) + ('invalid-plist (message "Invalid browser configuration")))) + +(defun cj/--do-choose-browser (browser-plist) + "Save and apply BROWSER-PLIST as the default browser. +Returns: \\='success if browser was saved and applied, + \\='save-failed if save operation failed, + \\='invalid-plist if browser-plist is invalid." + (condition-case _err + (progn + (cj/save-browser-choice browser-plist) + (let ((result (cj/--do-apply-browser-choice browser-plist))) + (if (eq result 'success) + 'success + 'invalid-plist))) + (error 'save-failed))) (defun cj/choose-browser () "Interactively choose a browser from available options. @@ -107,21 +132,39 @@ Persists the choice for future sessions." (string= (plist-get b :name) choice)) browsers))) (when selected - (cj/save-browser-choice selected) - (cj/apply-browser-choice selected)))))) + (pcase (cj/--do-choose-browser selected) + ('success (message "Default browser set to: %s" (plist-get selected :name))) + ('save-failed (message "Failed to save browser choice")) + ('invalid-plist (message "Invalid browser configuration")))))))) ;; Initialize: Load saved choice or use first available browser -(defun cj/initialize-browser () - "Initialize browser configuration on startup." +(defun cj/--do-initialize-browser () + "Initialize browser configuration. +Returns: (cons \\='loaded browser-plist) if saved choice was loaded, + (cons \\='first-available browser-plist) if using first discovered browser, + (cons \\='no-browsers nil) if no browsers found." (let ((saved-choice (cj/load-browser-choice))) (if saved-choice - (cj/apply-browser-choice saved-choice) - ;; No saved choice - try to set first available browser silently + (cons 'loaded saved-choice) + ;; No saved choice - try to set first available browser (let ((browsers (cj/discover-browsers))) - (when browsers - (cj/apply-browser-choice (car browsers)) - (message "No browser configured. Using %s. Run M-x cj/choose-browser to change." - (plist-get (car browsers) :name))))))) + (if browsers + (cons 'first-available (car browsers)) + (cons 'no-browsers nil)))))) + +(defun cj/initialize-browser () + "Initialize browser configuration on startup." + (let ((result (cj/--do-initialize-browser))) + (pcase (car result) + ('loaded + (cj/--do-apply-browser-choice (cdr result))) + ('first-available + (let ((browser (cdr result))) + (cj/--do-apply-browser-choice browser) + (message "No browser configured. Using %s. Run M-x cj/choose-browser to change." + (plist-get browser :name)))) + ('no-browsers + (message "No supported browsers found"))))) ;; Run initialization (cj/initialize-browser) diff --git a/modules/custom-misc.el b/modules/custom-misc.el index 0c6d7ac8..2af9c244 100644 --- a/modules/custom-misc.el +++ b/modules/custom-misc.el @@ -46,19 +46,27 @@ If not on a delimiter, show a message. Respects the current syntax table." (message "Point is not on a delimiter."))))) +(defun cj/--format-region (start end) + "Internal implementation: Reformat text between START and END. +START and END define the region to operate on. +Replaces tabs with spaces, reindents, and deletes trailing whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (untabify (point-min) (point-max)) + (indent-region (point-min) (point-max)) + (delete-trailing-whitespace (point-min) (point-max))))) + (defun cj/format-region-or-buffer () "Reformat the region or the entire buffer. Replaces tabs with spaces, deletes trailing whitespace, and reindents." (interactive) (let ((start-pos (if (use-region-p) (region-beginning) (point-min))) - (end-pos (if (use-region-p) (region-end) (point-max)))) - (save-excursion - (save-restriction - (narrow-to-region start-pos end-pos) - (untabify (point-min) (point-max)) - (indent-region (point-min) (point-max)) - (delete-trailing-whitespace (point-min) (point-max)))) - (message "Formatted %s" (if (use-region-p) "region" "buffer")))) + (end-pos (if (use-region-p) (region-end) (point-max)))) + (cj/--format-region start-pos end-pos) + (message "Formatted %s" (if (use-region-p) "region" "buffer")))) (defun cj/switch-to-previous-buffer () "Switch to previously open buffer. @@ -66,6 +74,14 @@ Repeated invocations toggle between the two most recently open buffers." (interactive) (switch-to-buffer (other-buffer (current-buffer) 1))) +(defun cj/--count-words (start end) + "Internal implementation: Count words between START and END. +START and END define the region to count. +Returns the word count as an integer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (count-words start end)) + (defun cj/count-words-buffer-or-region () "Count the number of words in the buffer or region. Display the result in the minibuffer." @@ -73,9 +89,38 @@ Display the result in the minibuffer." (let* ((use-region (use-region-p)) (begin (if use-region (region-beginning) (point-min))) (end (if use-region (region-end) (point-max))) - (area-type (if use-region "the region" "the buffer"))) - (message "There are %d words in %s." (count-words begin end) area-type))) + (area-type (if use-region "the region" "the buffer")) + (word-count (cj/--count-words begin end))) + (message "There are %d words in %s." word-count area-type))) + +(defun cj/--replace-fraction-glyphs (start end to-glyphs) + "Internal implementation: Replace fraction glyphs or text between START and END. +START and END define the region to operate on. +TO-GLYPHS when non-nil converts text (1/4) to glyphs (¼), +otherwise converts glyphs to text." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((replacements (if to-glyphs + '(("1/4" . "¼") + ("1/2" . "½") + ("3/4" . "¾") + ("1/3" . "⅓") + ("2/3" . "⅔")) + '(("¼" . "1/4") + ("½" . "1/2") + ("¾" . "3/4") + ("⅓" . "1/3") + ("⅔" . "2/3")))) + (count 0) + (end-marker (copy-marker end))) + (save-excursion + (dolist (r replacements) + (goto-char start) + (while (search-forward (car r) end-marker t) + (replace-match (cdr r)) + (setq count (1+ count))))) + count)) (defun cj/replace-fraction-glyphs (start end) "Replace common fraction glyphs between START and END. @@ -83,27 +128,10 @@ Operate on the buffer or region designated by START and END. Replace the text representations with glyphs when called with a \\[universal-argument] prefix." (interactive (if (use-region-p) - (list (region-beginning) (region-end)) - (list (point-min) (point-max)))) - (let ((replacements (if current-prefix-arg - '(("1/4" . "¼") - ("1/2" . "½") - ("3/4" . "¾") - ("1/3" . "⅓") - ("2/3" . "⅔")) - '(("¼" . "1/4") - ("½" . "1/2") - ("¾" . "3/4") - ("⅓" . "1/3") - ("⅔" . "2/3")))) - (count 0)) - (save-excursion - (dolist (r replacements) - (goto-char start) - (while (search-forward (car r) end t) - (replace-match (cdr r)) - (setq count (1+ count))))) - (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) + (list (region-beginning) (region-end)) + (list (point-min) (point-max)))) + (let ((count (cj/--replace-fraction-glyphs start end current-prefix-arg))) + (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) (defun cj/align-regexp-with-spaces (orig-fun &rest args) "Call ORIG-FUN with ARGS while temporarily disabling tabs for alignment. diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 5d308604..abc9995a 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -2,47 +2,197 @@ ;;; Commentary: -;; This module provides functions for converting text between different formats and sorting operations. -;; These utilities are useful for reformatting data structures and organizing text. - -;; Functions include: - -;; - converting lines to quoted comma-separated arrays (arrayify) -;; - converting arrays back to separate lines (unarrayify) -;; - alphabetically sorting words in a region -;; - splitting comma-separated text into individual lines - +;; Text transformation and sorting utilities for reformatting data structures. +;; +;; Array/list formatting: +;; - arrayify/listify - convert lines to comma-separated format (with/without quotes, brackets) +;; - unarrayify - convert arrays back to separate lines +;; +;; Line manipulation: +;; - toggle-quotes - swap double ↔ single quotes +;; - reverse-lines - reverse line order +;; - number-lines - add line numbers with custom format (supports zero-padding) +;; - alphabetize-region - sort words alphabetically +;; - comma-separated-text-to-lines - split CSV text into lines +;; +;; Convenience functions: listify, arrayify-json, arrayify-python ;; Bound to keymap prefix C-; o ;;; Code: +(require 'cl-lib) + ;; cj/custom-keymap defined in keybindings.el (eval-when-compile (defvar cj/custom-keymap)) (defvar cj/ordering-map) +(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. +QUOTE specifies the quotation characters to surround each element. + Use \"\" for no quotes, \"\\\"\" for double quotes, \"'\" for single quotes. +PREFIX is an optional string to prepend to the result (e.g., \"[\" or \"(\"). +SUFFIX is an optional string to append to the result (e.g., \"]\" or \")\"). +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((result (mapconcat + (lambda (x) (format "%s%s%s" quote x quote)) + (split-string (buffer-substring start end)) ", "))) + (concat (or prefix "") result (or suffix "")))) + (defun cj/arrayify (start end quote) "Convert lines between START and END into quoted, comma-separated strings. 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 - (mapconcat - (lambda (x) (format "%s%s%s" quote x quote)) - (split-string (buffer-substring start end)) ", "))) + (let ((insertion (cj/--arrayify start end quote))) (delete-region start end) (insert insertion))) +(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))) + +(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))) + +(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))) + +(defun cj/--unarrayify (start end) + "Internal implementation: Convert comma-separated array to lines. +START and END define the region to operate on. +Removes quotes (both single and double) and splits by ', '. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (mapconcat + (lambda (x) (replace-regexp-in-string "[\"']" "" x)) + (split-string (buffer-substring start end) ", ") "\n")) + (defun cj/unarrayify (start end) "Convert quoted comma-separated strings between START and END to separate lines. START and END identify the active region." (interactive "r") - (let ((insertion - (mapconcat - (lambda (x) (replace-regexp-in-string "[\"']" "" x)) - (split-string (buffer-substring start end) ", ") "\n"))) + (let ((insertion (cj/--unarrayify start end))) (delete-region start end) (insert insertion))) +(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)) + (let ((text (buffer-substring start end))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + ;; Use a placeholder to avoid double-swapping + (while (search-forward "\"" nil t) + (replace-match "\001" nil t)) + (goto-char (point-min)) + (while (search-forward "'" nil t) + (replace-match "\"" nil t)) + (goto-char (point-min)) + (while (search-forward "\001" nil t) + (replace-match "'" nil t)) + (buffer-string)))) + +(defun cj/toggle-quotes (start end) + "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))) + +(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)) + (let ((lines (split-string (buffer-substring start end) "\n"))) + (mapconcat #'identity (nreverse lines) "\n"))) + +(defun cj/reverse-lines (start end) + "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))) + +(defun cj/--number-lines (start end format-string zero-pad) + "Internal implementation: Number lines in region with custom format. +START and END define the region to operate on. +FORMAT-STRING is the format for each line, with N as placeholder for number. + Example: \"N. \" produces \"1. \", \"2. \", etc. + Example: \"[N] \" produces \"[1] \", \"[2] \", etc. +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)) + (let* ((lines (split-string (buffer-substring start end) "\n")) + (line-count (length lines)) + (width (if zero-pad (length (number-to-string line-count)) 1)) + (format-spec (if zero-pad (format "%%0%dd" width) "%d"))) + (mapconcat + (lambda (pair) + (let* ((num (car pair)) + (line (cdr pair)) + (num-str (format format-spec num))) + (concat (replace-regexp-in-string "N" num-str format-string) line))) + (cl-loop for line in lines + for i from 1 + collect (cons i line)) + "\n"))) + +(defun cj/number-lines (start end format-string zero-pad) + "Number lines in region between START and END with custom format. +START and END identify the active region. +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))) + +(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)) + (let ((string (buffer-substring-no-properties start end))) + (mapconcat #'identity + (sort (split-string string "[[:space:],]+" t) + #'string-lessp) + ", "))) + (defun cj/alphabetize-region () "Alphabetize words in the active region and replace the original text. Produce a comma-separated list as the result." @@ -51,14 +201,26 @@ Produce a comma-separated list as the result." (user-error "No region selected")) (let ((start (region-beginning)) (end (region-end)) - (string (buffer-substring-no-properties (region-beginning) (region-end)))) + (insertion (cj/--alphabetize-region (region-beginning) (region-end)))) (delete-region start end) (goto-char start) - (insert - (mapconcat #'identity - (sort (split-string string "[[:space:],]+" t) - #'string-lessp) - ", ")))) + (insert insertion))) + +(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)) + (let ((text (buffer-substring-no-properties start end))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (search-forward "," nil t) + (replace-match "\n" nil t)) + (delete-trailing-whitespace) + (buffer-string)))) (defun cj/comma-separated-text-to-lines () "Break up comma-separated text in active region so each item is on own line." @@ -68,15 +230,7 @@ Produce a comma-separated list as the result." (let ((beg (region-beginning)) (end (region-end)) - (text (buffer-substring-no-properties (region-beginning) (region-end)))) - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (while (search-forward "," nil t) - (replace-match "\n" nil t)) - (delete-trailing-whitespace) - (setq text (buffer-string))) - + (text (cj/--comma-separated-text-to-lines (region-beginning) (region-end)))) (delete-region beg end) (goto-char beg) (insert text))) @@ -88,8 +242,14 @@ Produce a comma-separated list as the result." :doc "Keymap for text ordering and sorting operations" "a" #'cj/arrayify "u" #'cj/unarrayify + "l" #'cj/listify + "j" #'cj/arrayify-json + "p" #'cj/arrayify-python + "q" #'cj/toggle-quotes + "r" #'cj/reverse-lines + "n" #'cj/number-lines "A" #'cj/alphabetize-region - "l" #'cj/comma-separated-text-to-lines) + "L" #'cj/comma-separated-text-to-lines) (keymap-set cj/custom-keymap "o" cj/ordering-map) (with-eval-after-load 'which-key diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 514419cd..ccacdd2d 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -2,78 +2,269 @@ ;;; Commentary: -;; This module provides functions to surround words or regions with custom strings, and to append or prepend text to lines. +;; Text enclosure utilities for wrapping and line manipulation. +;; +;; Wrapping functions: +;; - surround-word-or-region - wrap text with same delimiter on both sides +;; - wrap-word-or-region - wrap with different opening/closing delimiters +;; - unwrap-word-or-region - remove surrounding delimiters +;; +;; Line manipulation: +;; - append-to-lines - add suffix to each line +;; - prepend-to-lines - add prefix to each line +;; - indent-lines - add leading whitespace (spaces or tabs) +;; - dedent-lines - remove leading whitespace +;; +;; Most functions work on region or entire buffer when no region is active. +;; +;; Bound to keymap prefix C-; s -;; It includes three main functions: -;; - surround word or region with a user-specified string -;; - append text to the end of lines -;; - prepend text to the beginning of lines +;;; Code: -;; All functions work on both the active region and the entire buffer when no region is selected. +;; cj/custom-keymap defined in keybindings.el +(eval-when-compile (defvar cj/custom-keymap)) -;; Bound to keymap prefix C-; s +(defun cj/--surround (text surround-string) + "Internal implementation: Surround TEXT with SURROUND-STRING. +TEXT is the string to be surrounded. +SURROUND-STRING is prepended and appended to TEXT. +Returns the surrounded text without modifying the buffer." + (concat surround-string text surround-string)) -;;; Code: +(defun cj/--wrap (text opening closing) + "Internal implementation: Wrap TEXT with OPENING and CLOSING strings. +TEXT is the string to be wrapped. +OPENING is prepended to TEXT. +CLOSING is appended to TEXT. +Returns the wrapped text without modifying the buffer." + (concat opening text closing)) (defun cj/surround-word-or-region () - "Surround the word at point or active region with a string read from the minibuffer." + "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))) - (save-excursion - (if regionp - (let ((beg (region-beginning)) - (end (region-end))) - (goto-char end) - (insert str) - (goto-char beg) - (insert str)) - (if (thing-at-point 'word) - (let ((bounds (bounds-of-thing-at-point 'word))) - (goto-char (cdr bounds)) - (insert str) - (goto-char (car bounds)) - (insert str)) - (message "Can't insert around. No word at point and no region selected.")))))) + (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."))))) + +(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."))))) + +(defun cj/--unwrap (text opening closing) + "Internal implementation: Remove OPENING and CLOSING from TEXT if present. +TEXT is the string to unwrap. +OPENING is checked at the start of TEXT. +CLOSING is checked at the end of TEXT. +Returns the unwrapped text if both delimiters present, otherwise unchanged." + (if (and (string-prefix-p opening text) + (string-suffix-p closing text) + (>= (length text) (+ (length opening) (length closing)))) + (substring text (length opening) (- (length text) (length closing))) + text)) + +(defun cj/unwrap-word-or-region () + "Remove surrounding delimiters from word at point or active region. +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."))))) + +(defun cj/--append-to-lines (text suffix) + "Internal implementation: Append SUFFIX to each line in TEXT. +TEXT is the string containing one or more lines. +SUFFIX is appended to the end of each line. +Returns the transformed string without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + ;; If has trailing newline, last element will be empty string - exclude it + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines))) + (concat + (mapconcat (lambda (line) (concat line suffix)) lines-to-process "\n") + (if has-trailing-newline "\n" "")))) (defun cj/append-to-lines-in-region-or-buffer (str) "Append STR to the end of each line in the region or entire buffer." (interactive "sEnter string to append: ") - (let ((start-pos (if (use-region-p) - (region-beginning) - (point-min))) - (end-pos (if (use-region-p) - (region-end) - (point-max)))) - (save-excursion - (goto-char start-pos) - (while (< (point) end-pos) - (move-end-of-line 1) - (insert str) - (forward-line 1))))) + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--append-to-lines text str))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--prepend-to-lines (text prefix) + "Internal implementation: Prepend PREFIX to each line in TEXT. +TEXT is the string containing one or more lines. +PREFIX is prepended to the beginning of each line. +Returns the transformed string without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + ;; If has trailing newline, last element will be empty string - exclude it + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines))) + (concat + (mapconcat (lambda (line) (concat prefix line)) lines-to-process "\n") + (if has-trailing-newline "\n" "")))) (defun cj/prepend-to-lines-in-region-or-buffer (str) "Prepend STR to the beginning of each line in the region or entire buffer." (interactive "sEnter string to prepend: ") - (let ((start-pos (if (use-region-p) - (region-beginning) - (point-min))) - (end-pos (if (use-region-p) - (region-end) - (point-max)))) - (save-excursion - (goto-char start-pos) - (while (< (point) end-pos) - (beginning-of-line 1) - (insert str) - (forward-line 1))))) - -;; Surround, append, prepend prefix keymap + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--prepend-to-lines text str))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--indent-lines (text count use-tabs) + "Internal implementation: Indent each line in TEXT by COUNT characters. +TEXT is the string containing one or more lines. +COUNT is the number of indentation characters to add. +USE-TABS when non-nil uses tabs instead of spaces for indentation. +Returns the indented text without modifying the buffer." + (let ((indent-string (if use-tabs + (make-string count ?\t) + (make-string count ?\s)))) + (cj/--prepend-to-lines text indent-string))) + +(defun cj/indent-lines-in-region-or-buffer (count use-tabs) + "Indent each line in region or buffer by COUNT characters. +COUNT is the number of characters to indent (default 4). +USE-TABS when non-nil (prefix argument) uses tabs instead of spaces." + (interactive "p\nP") + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--indent-lines text count use-tabs))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--dedent-lines (text count) + "Internal implementation: Remove up to COUNT leading characters from each line. +TEXT is the string containing one or more lines. +COUNT is the maximum number of leading whitespace characters to remove. +Removes spaces and tabs, but only up to COUNT characters per line. +Returns the dedented text without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines)) + (dedented-lines + (mapcar + (lambda (line) + (let ((removed 0) + (pos 0) + (len (length line))) + (while (and (< removed count) + (< pos len) + (memq (aref line pos) '(?\s ?\t))) + (setq removed (1+ removed)) + (setq pos (1+ pos))) + (substring line pos))) + lines-to-process))) + (concat + (mapconcat #'identity dedented-lines "\n") + (if has-trailing-newline "\n" "")))) + +(defun cj/dedent-lines-in-region-or-buffer (count) + "Remove up to COUNT leading whitespace characters from each line. +COUNT is the number of characters to remove (default 4). +Works on region if active, otherwise entire buffer." + (interactive "p") + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--dedent-lines text count))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +;; Text enclosure keymap (defvar-keymap cj/enclose-map - :doc "Keymap for enclosing text: surrounding, appending, and prepending" + :doc "Keymap for text enclosure: wrapping, line manipulation, and indentation" "s" #'cj/surround-word-or-region + "w" #'cj/wrap-word-or-region + "u" #'cj/unwrap-word-or-region "a" #'cj/append-to-lines-in-region-or-buffer - "p" #'cj/prepend-to-lines-in-region-or-buffer) + "p" #'cj/prepend-to-lines-in-region-or-buffer + "i" #'cj/indent-lines-in-region-or-buffer + "d" #'cj/dedent-lines-in-region-or-buffer) (keymap-set cj/custom-keymap "s" cj/enclose-map) (with-eval-after-load 'which-key diff --git a/modules/custom-whitespace.el b/modules/custom-whitespace.el index a69d6138..df93459a 100644 --- a/modules/custom-whitespace.el +++ b/modules/custom-whitespace.el @@ -17,14 +17,32 @@ ;;; Code: +(eval-when-compile (defvar cj/custom-keymap)) ;; cj/custom-keymap defined in keybindings.el ;;; ---------------------- Whitespace Operations And Keymap --------------------- +;; ------------------- Remove Leading/Trailing Whitespace --------------------- + +(defun cj/--remove-leading-trailing-whitespace (start end) + "Internal implementation: Remove leading and trailing whitespace. +START and END define the region to operate on. +Removes leading whitespace (^[ \\t]+) and trailing whitespace ([ \\t]+$). +Preserves interior whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]+" nil t) (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" nil t) (replace-match ""))))) + (defun cj/remove-leading-trailing-whitespace () "Remove leading and trailing whitespace in a region, line, or buffer. When called interactively: - If a region is active, operate on the region. -- If called with a \[universal-argument] prefix, operate on the entire buffer. +- If called with a \\[universal-argument] prefix, operate on the entire buffer. - Otherwise, operate on the current line." (interactive) (let ((start (cond (current-prefix-arg (point-min)) @@ -33,36 +51,90 @@ When called interactively: (end (cond (current-prefix-arg (point-max)) ((use-region-p) (region-end)) (t (line-end-position))))) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (re-search-forward "^[ \t]+" nil t) (replace-match "")) - (goto-char (point-min)) - (while (re-search-forward "[ \t]+$" nil t) (replace-match "")))))) + (cj/--remove-leading-trailing-whitespace start end))) + +;; ----------------------- Collapse Whitespace --------------------------------- + +(defun cj/--collapse-whitespace (start end) + "Internal implementation: Collapse whitespace to single spaces. +START and END define the region to operate on. +Converts tabs to spaces, removes leading/trailing whitespace, +and collapses multiple spaces to single space. +Preserves newlines and line structure." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + ;; Replace all tabs with space + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " " nil t)) + ;; Remove leading and trailing spaces (but not newlines) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]+\\|[ \t]+$" nil t) + (replace-match "" nil nil)) + ;; Ensure only one space between words (but preserve newlines) + (goto-char (point-min)) + (while (re-search-forward "[ \t]\\{2,\\}" nil t) + (replace-match " " nil nil))))) (defun cj/collapse-whitespace-line-or-region () "Collapse whitespace to one space in the current line or active region. -Ensure there is exactly one space between words and remove leading and trailing whitespace." +Ensure there is exactly one space between words and remove leading and +trailing whitespace." (interactive) + (let* ((region-active (use-region-p)) + (beg (if region-active (region-beginning) (line-beginning-position))) + (end (if region-active (region-end) (line-end-position)))) + (cj/--collapse-whitespace beg end))) + +;; --------------------- Ensure Single Blank Line ------------------------------ + +(defun cj/--ensure-single-blank-line (start end) + "Internal implementation: Collapse consecutive blank lines to one. +START and END define the region to operate on. +Replaces runs of 2+ blank lines with exactly one blank line. +A blank line is defined as a line containing only whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) (save-excursion - (let* ((region-active (use-region-p)) - (beg (if region-active (region-beginning) (line-beginning-position))) - (end (if region-active (region-end) (line-end-position)))) - (save-restriction - (narrow-to-region beg end) - ;; Replace all tabs with space - (goto-char (point-min)) - (while (search-forward "\t" nil t) - (replace-match " " nil t)) - ;; Remove leading and trailing spaces - (goto-char (point-min)) - (while (re-search-forward "^\\s-+\\|\\s-+$" nil t) - (replace-match "" nil nil)) - ;; Ensure only one space between words/symbols - (goto-char (point-min)) - (while (re-search-forward "\\s-\\{2,\\}" nil t) - (replace-match " " nil nil)))))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + ;; Match 2+ consecutive blank lines (lines with only whitespace) + ;; Pattern: Match sequences of blank lines (newline + optional space + newline) + ;; but preserve leading whitespace on the following content line + ;; Match: newline, then 1+ (optional whitespace + newline), capturing the last one + (while (re-search-forward "\n\\(?:[[:space:]]*\n\\)+" nil t) + (replace-match "\n\n"))))) + +(defun cj/ensure-single-blank-line (start end) + "Collapse consecutive blank lines to exactly one blank line. +START and END define the region to operate on. +Operates on the active region when one exists. +Prompt before operating on the whole buffer when no region is selected." + (interactive + (if (use-region-p) + (list (region-beginning) (region-end)) + (if (yes-or-no-p "Ensure single blank lines in entire buffer? ") + (list (point-min) (point-max)) + (user-error "Aborted")))) + (cj/--ensure-single-blank-line start end)) + +;; ------------------------ Delete Blank Lines --------------------------------- + +(defun cj/--delete-blank-lines (start end) + "Internal implementation: Delete blank lines between START and END. +Blank lines are lines containing only whitespace or nothing. +Uses the regexp ^[[:space:]]*$ to match blank lines." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (widen) + ;; Regexp "^[[:space:]]*$" matches lines of zero or more spaces/tabs/newlines. + (flush-lines "^[[:space:]]*$" start end)))) (defun cj/delete-blank-lines-region-or-buffer (start end) "Delete blank lines between START and END. @@ -73,32 +145,62 @@ Signal a user error and do nothing when the user declines. Restore point to its original position after deletion." (interactive (if (use-region-p) - ;; grab its boundaries if there's a region - (list (region-beginning) (region-end)) - ;; or ask if user intended operating on whole buffer - (if (yes-or-no-p "Delete blank lines in entire buffer? ") - (list (point-min) (point-max)) - (user-error "Aborted")))) - (save-excursion - (save-restriction - (widen) - ;; Regexp "^[[:space:]]*$" matches lines of zero or more spaces/tabs. - (flush-lines "^[[:space:]]*$" start end))) + ;; grab its boundaries if there's a region + (list (region-beginning) (region-end)) + ;; or ask if user intended operating on whole buffer + (if (yes-or-no-p "Delete blank lines in entire buffer? ") + (list (point-min) (point-max)) + (user-error "Aborted")))) + (cj/--delete-blank-lines start end) ;; Return nil (Emacs conventions). Point is already restored. nil) +;; ------------------------- Delete All Whitespace ----------------------------- + +(defun cj/--delete-all-whitespace (start end) + "Internal implementation: Delete all whitespace from region. +START and END define the region to operate on. +Removes all spaces, tabs, newlines, and carriage returns." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n\r]+" nil t) + (replace-match ""))))) + +(defun cj/delete-all-whitespace (start end) + "Delete all whitespace between START and END. +Removes all spaces, tabs, newlines, and carriage returns. +Operates on the active region." + (interactive "*r") + (if (use-region-p) + (cj/--delete-all-whitespace start end) + (message "No region; nothing to delete."))) + +;; ------------------------- Hyphenate Whitespace ------------------------------ + +(defun cj/--hyphenate-whitespace (start end) + "Internal implementation: Replace whitespace runs with hyphens. +START and END define the region to operate on. +Replaces all runs of spaces, tabs, newlines, and carriage returns with hyphens." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n\r]+" nil t) + (replace-match "-"))))) + (defun cj/hyphenate-whitespace-in-region (start end) "Replace runs of whitespace between START and END with hyphens. Operate on the active region designated by START and END." (interactive "*r") (if (use-region-p) - (save-excursion - (save-restriction - (narrow-to-region start end) - (goto-char (point-min)) - (while (re-search-forward "[ \t\n\r]+" nil t) - (replace-match "-")))) - (message "No region; nothing to hyphenate."))) + (cj/--hyphenate-whitespace start end) + (message "No region; nothing to hyphenate."))) ;; Whitespace operations prefix and keymap @@ -107,7 +209,11 @@ Operate on the active region designated by START and END." "r" #'cj/remove-leading-trailing-whitespace "c" #'cj/collapse-whitespace-line-or-region "l" #'cj/delete-blank-lines-region-or-buffer - "-" #'cj/hyphenate-whitespace-in-region) + "1" #'cj/ensure-single-blank-line + "d" #'cj/delete-all-whitespace + "-" #'cj/hyphenate-whitespace-in-region + "t" #'untabify + "T" #'tabify) (keymap-set cj/custom-keymap "w" cj/whitespace-map) (with-eval-after-load 'which-key diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index 12e0d348..379fc7b2 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -111,7 +111,6 @@ ;; ------------------------------ Flyspell Toggle ------------------------------ ;; easy toggling flyspell and also leverage the 'for-buffer-type' functionality. -;;;###autoload (defun cj/flyspell-toggle () "Turn Flyspell on if it is off, or off if it is on. @@ -198,7 +197,6 @@ buffer." (downcase misspelled-word) nil))) -;;;###autoload (defun cj/flyspell-then-abbrev (p) "Find and correct the previous misspelled word, creating an abbrev. diff --git a/modules/font-config.el b/modules/font-config.el index 1541f55f..eea09da6 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -142,7 +142,6 @@ If FRAME is nil, uses the selected frame." ;; ----------------------------- Font Install Check ---------------------------- ;; convenience function to indicate whether a font is available by name. -;;;###autoload (defun cj/font-installed-p (font-name) "Check if font with FONT-NAME is available." (if (find-font (font-spec :name font-name)) @@ -224,7 +223,6 @@ If FRAME is nil, uses the selected frame." ;; -------------------------- Display Available Fonts -------------------------- ;; display all available fonts on the system in a side panel -;;;###autoload (defun cj/display-available-fonts () "Display a list of all font faces with sample text in another read-only buffer." (interactive) diff --git a/modules/jumper.el b/modules/jumper.el index e1025472..67d930aa 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -10,24 +10,76 @@ ;; Jumper provides a simple way to store and jump between locations ;; in your codebase without needing to remember register assignments. +;; +;; PURPOSE: +;; +;; When working on large codebases, you often need to jump between +;; multiple related locations: a function definition, its tests, its +;; callers, configuration files, etc. Emacs registers are perfect for +;; this, but require you to remember which register you assigned to +;; which location. Jumper automates register management, letting you +;; focus on your work instead of bookkeeping. +;; +;; WORKFLOW: +;; +;; 1. Navigate to an important location in your code +;; 2. Press M-SPC SPC to store it (automatically assigned to register 0) +;; 3. Continue working, storing more locations as needed (registers 1-9) +;; 4. Press M-SPC j to jump back to any stored location +;; 5. Select from the list using completion (shows file, line, context) +;; 6. Press M-SPC d to remove locations you no longer need +;; +;; RECOMMENDED USAGE: +;; +;; Store locations temporarily while working on a feature: +;; - Store the main function you're implementing +;; - Store the test file where you're writing tests +;; - Store the caller that needs updating +;; - Store the documentation that needs changes +;; - Jump between them freely as you work +;; - Clear them when done with the feature +;; +;; SPECIAL BEHAVIORS: +;; +;; - Duplicate prevention: Storing the same location twice shows a message +;; instead of wasting a register slot. +;; +;; - Single location toggle: When only one location is stored, M-SPC j +;; toggles between that location and your current position. Perfect for +;; rapid back-and-forth between two related files. +;; +;; - Last location tracking: The last position before each jump is saved +;; in register 'z', allowing quick "undo" of navigation. +;; +;; - Smart selection: With multiple locations, completing-read shows +;; helpful context: "[0] filename.el:42 - function definition..." +;; +;; KEYBINDINGS: +;; +;; M-SPC SPC Store current location in next available register +;; M-SPC j Jump to a stored location (with completion) +;; M-SPC d Delete a stored location from the list +;; +;; CONFIGURATION: +;; +;; You can customize the prefix key and maximum locations: +;; +;; (setq jumper-prefix-key "C-c j") ; Change prefix key +;; (setq jumper-max-locations 20) ; Store up to 20 locations +;; +;; Note: Changing jumper-max-locations requires restarting Emacs or +;; manually reinitializing jumper--registers. ;;; Code: -(defgroup jumper nil - "Quick navigation between stored locations." - :group 'convenience) +(require 'cl-lib) -(defcustom jumper-prefix-key "M-SPC" +(defvar jumper-prefix-key "M-SPC" "Prefix key for jumper commands. +Note that using M-SPC will override the default binding to just-one-space.") -Note that using M-SPC will override the default binding to just-one-space." - :type 'string - :group 'jumper) - -(defcustom jumper-max-locations 10 - "Maximum number of locations to store." - :type 'integer - :group 'jumper) +(defvar jumper-max-locations 10 + "Maximum number of locations to store.") ;; Internal variables (defvar jumper--registers (make-vector jumper-max-locations nil) @@ -50,12 +102,10 @@ Note that using M-SPC will override the default binding to just-one-space." "Check if current location is already stored." (let ((key (jumper--location-key)) (found nil)) - (dotimes (i - jumper--next-index found) + (dotimes (i jumper--next-index found) (let* ((reg (aref jumper--registers i)) - (pos (get-register reg)) - (marker (and pos (registerv-data pos)))) - (when marker + (marker (get-register reg))) + (when (and marker (markerp marker)) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -70,9 +120,8 @@ 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)) - (pos (get-register reg)) - (marker (and pos (registerv-data pos)))) - (when marker + (marker (get-register reg))) + (when (and marker (markerp marker)) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -86,49 +135,83 @@ Note that using M-SPC will override the default binding to just-one-space." (min (+ (line-beginning-position) 40) (line-end-position))))))))) +(defun jumper--do-store-location () + "Store current location in the next free register. +Returns: \\='already-exists if location is already stored, + \\='no-space if all registers are full, + register character if successfully stored." + (cond + ((jumper--location-exists-p) 'already-exists) + ((not (jumper--register-available-p)) 'no-space) + (t + (let ((reg (+ ?0 jumper--next-index))) + (point-to-register reg) + (aset jumper--registers jumper--next-index reg) + (setq jumper--next-index (1+ jumper--next-index)) + reg)))) + (defun jumper-store-location () "Store current location in the next free register." (interactive) - (if (jumper--location-exists-p) - (message "Location already stored") - (if (jumper--register-available-p) - (let ((reg (+ ?0 jumper--next-index))) - (point-to-register reg) - (aset jumper--registers jumper--next-index reg) - (setq jumper--next-index (1+ jumper--next-index)) - (message "Location stored in register %c" reg)) - (message "Sorry - all jump locations are filled!")))) + (pcase (jumper--do-store-location) + ('already-exists (message "Location already stored")) + ('no-space (message "Sorry - all jump locations are filled!")) + (reg (message "Location stored in register %c" reg)))) + +(defun jumper--do-jump-to-location (target-idx) + "Jump to location at TARGET-IDX. +TARGET-IDX: -1 for last location, 0-9 for stored locations, nil for toggle. +Returns: \\='no-locations if no locations stored, + \\='already-there if at the only location (toggle case), + \\='jumped if successfully jumped." + (cond + ((= jumper--next-index 0) 'no-locations) + ;; Toggle behavior when target-idx is nil and only 1 location + ((and (null target-idx) (= jumper--next-index 1)) + (if (jumper--location-exists-p) + 'already-there + (let ((reg (aref jumper--registers 0))) + (point-to-register jumper--last-location-register) + (jump-to-register reg) + 'jumped))) + ;; Jump to specific target + (t + (if (= target-idx -1) + ;; Jumping to last location - don't overwrite it + (jump-to-register jumper--last-location-register) + ;; Jumping to stored location - save current for "last" + (progn + (point-to-register jumper--last-location-register) + (jump-to-register (aref jumper--registers target-idx)))) + 'jumped))) (defun jumper-jump-to-location () "Jump to a stored location." (interactive) - (if (= jumper--next-index 0) - (message "No locations stored") - (if (= jumper--next-index 1) - ;; Special case for one location - toggle behavior - (let ((reg (aref jumper--registers 0))) - (if (jumper--location-exists-p) - (message "You're already at the stored location") - (point-to-register jumper--last-location-register) - (jump-to-register reg) - (message "Jumped to location"))) - ;; Multiple locations - use completing-read - (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) - ;; Add last location if available - (last-pos (get-register jumper--last-location-register)) - (locations (if last-pos - (cons (cons "[z] Last location" -1) locations) - locations)) - (choice (completing-read "Jump to: " locations nil t)) - (idx (cdr (assoc choice locations)))) - (point-to-register jumper--last-location-register) - (if (= idx -1) - (jump-to-register jumper--last-location-register) - (jump-to-register (aref jumper--registers idx))) - (message "Jumped to location"))))) + (cond + ;; No locations + ((= jumper--next-index 0) + (message "No locations stored")) + ;; Single location - toggle + ((= jumper--next-index 1) + (pcase (jumper--do-jump-to-location nil) + ('already-there (message "You're already at the stored location")) + ('jumped (message "Jumped to location")))) + ;; Multiple locations - prompt user + (t + (let* ((locations + (cl-loop for i from 0 below jumper--next-index + for fmt = (jumper--format-location i) + when fmt collect (cons fmt i))) + ;; Add last location if available + (last-pos (get-register jumper--last-location-register)) + (locations (if last-pos + (cons (cons "[z] Last location" -1) locations) + locations)) + (choice (completing-read "Jump to: " locations nil t)) + (idx (cdr (assoc choice locations)))) + (jumper--do-jump-to-location idx) + (message "Jumped to location"))))) (defun jumper--reorder-registers (removed-idx) "Reorder registers after removing the one at REMOVED-IDX." @@ -139,32 +222,40 @@ Note that using M-SPC will override the default binding to just-one-space." (aset jumper--registers i next-reg)))) (setq jumper--next-index (1- jumper--next-index))) +(defun jumper--do-remove-location (index) + "Remove location at INDEX. +Returns: \\='no-locations if no locations stored, + \\='cancelled if index is -1, + t if successfully removed." + (cond + ((= jumper--next-index 0) 'no-locations) + ((= index -1) 'cancelled) + (t + (jumper--reorder-registers index) + t))) + (defun jumper-remove-location () "Remove a stored location." (interactive) (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))) - (locations (cons (cons "Cancel" -1) locations)) - (choice (completing-read "Remove location: " locations nil t)) - (idx (cdr (assoc choice locations)))) - (if (= idx -1) - (message "Operation cancelled") - (jumper--reorder-registers idx) - (message "Location removed"))))) - -(defvar jumper-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "SPC") #'jumper-store-location) - (define-key map (kbd "j") #'jumper-jump-to-location) - (define-key map (kbd "d") #'jumper-remove-location) - map) - "Keymap for jumper commands.") - -;;;###autoload + (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))) + (locations (cons (cons "Cancel" -1) locations)) + (choice (completing-read "Remove location: " locations nil t)) + (idx (cdr (assoc choice locations)))) + (pcase (jumper--do-remove-location idx) + ('cancelled (message "Operation cancelled")) + ('t (message "Location removed")))))) + +(defvar-keymap jumper-map + :doc "Keymap for jumper commands" + "SPC" #'jumper-store-location + "j" #'jumper-jump-to-location + "d" #'jumper-remove-location) + (defun jumper-setup-keys () "Setup default keybindings for jumper." (interactive) @@ -173,5 +264,13 @@ Note that using M-SPC will override the default binding to just-one-space." ;; Call jumper-setup-keys when the package is loaded (jumper-setup-keys) +;; which-key integration +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "M-SPC" "jumper menu" + "M-SPC SPC" "store location" + "M-SPC j" "jump to location" + "M-SPC d" "remove location")) + (provide 'jumper) ;;; jumper.el ends here. diff --git a/modules/lipsum-generator.el b/modules/lipsum-generator.el index b328b989..11ed8caa 100644 --- a/modules/lipsum-generator.el +++ b/modules/lipsum-generator.el @@ -129,25 +129,21 @@ Defaults to 'liber-primus.txt' in the modules directory." (when candidates (nth (random (length candidates)) candidates)))) -;;;###autoload (defvar cj/lipsum-chain (cj/markov-chain-create) "Global Markov chain for lipsum generation.") -;;;###autoload (defun cj/lipsum-reset () "Reset the global lipsum Markov chain." (interactive) (setq cj/lipsum-chain (cj/markov-chain-create)) (message "cj/lipsum-chain reset.")) -;;;###autoload (defun cj/lipsum-learn-region (beg end) "Learn text from region." (interactive "r") (cj/markov-learn cj/lipsum-chain (buffer-substring-no-properties beg end)) (message "Learned from region.")) -;;;###autoload (defun cj/lipsum-learn-buffer () "Learn from entire buffer." (interactive) @@ -155,7 +151,6 @@ Defaults to 'liber-primus.txt' in the modules directory." (buffer-substring-no-properties (point-min) (point-max))) (message "Learned from buffer.")) -;;;###autoload (defun cj/lipsum-learn-file (file) "Learn from FILE containing plain text." (interactive "fTrain from file: ") @@ -164,12 +159,10 @@ Defaults to 'liber-primus.txt' in the modules directory." (cj/markov-learn cj/lipsum-chain (buffer-string))) (message "Learned from file: %s" file)) -;;;###autoload (defun cj/lipsum (n) "Return N words of lorem ipsum." (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) -;;;###autoload (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." (interactive "nNumber of words: ") @@ -181,7 +174,6 @@ Defaults to 'liber-primus.txt' in the modules directory." (defconst cj/lipsum-title-max 8) (defconst cj/lipsum-title-small 3) -;;;###autoload (defun cj/lipsum-title () "Generate a pseudo-Latin title." (interactive) @@ -205,7 +197,6 @@ Defaults to 'liber-primus.txt' in the modules directory." ;;; Paragraphs -;;;###autoload (defun cj/lipsum-paragraphs (count &optional min max) "Insert COUNT paragraphs of lipsum. Each paragraph has a random length between MIN and MAX words. diff --git a/modules/lorem-generator.el b/modules/lorem-optimum.el index 6148dfdc..6ccca55f 100644 --- a/modules/lorem-generator.el +++ b/modules/lorem-optimum.el @@ -1,4 +1,4 @@ -;;; lorem-generator.el --- Fake Latin Text Generator -*- coding: utf-8; lexical-binding: t; -*- +;;; lorem-optimum.el --- Fake Latin Text Generator -*- coding: utf-8; lexical-binding: t; -*- ;; ;; Author: Craig Jennings ;; Version: 0.5 @@ -24,6 +24,19 @@ (require 'cl-lib) +;;; Configuration + +(defvar cj/lipsum-training-file "assets/liber-primus.txt" + "Default training file name (relative to `user-emacs-directory`).") + +(defvar cj/lipsum-default-file + (expand-file-name cj/lipsum-training-file user-emacs-directory) + "Default training file for cj-lipsum. + +This should be a plain UTF-8 text file with hundreds of Latin words +or sentences. By default it points to the file specified in +`cj/lipsum-training-file` relative to `user-emacs-directory`.") + (cl-defstruct (cj/markov-chain (:constructor cj/markov-chain-create)) "An order-two Markov chain." @@ -31,25 +44,45 @@ (keys nil)) (defun cj/markov-tokenize (text) - "Split TEXT into tokens: words and punctuation separately." - (let ((case-fold-search nil)) - (split-string text "\\b" t "[[:space:]\n]+"))) - + "Split TEXT into tokens: words and punctuation separately. +Returns a list of words and punctuation marks as separate tokens." + (let ((tokens '()) + (pos 0) + (len (length text))) + (while (< pos len) + (cond + ;; Skip whitespace + ((string-match-p "[[:space:]]" (substring text pos (1+ pos))) + (setq pos (1+ pos))) + ;; Match word (sequence of alphanumeric characters) + ((string-match "\\`\\([[:alnum:]]+\\)" (substring text pos)) + (let ((word (match-string 1 (substring text pos)))) + (push word tokens) + (setq pos (+ pos (length word))))) + ;; Match punctuation (single character) + ((string-match "\\`\\([[:punct:]]\\)" (substring text pos)) + (let ((punct (match-string 1 (substring text pos)))) + (push punct tokens) + (setq pos (+ pos (length punct))))) + ;; Skip any other character + (t (setq pos (1+ pos))))) + (nreverse tokens))) (defun cj/markov-learn (chain text) "Add TEXT into the Markov CHAIN with tokenized input." - (let* ((words (cj/markov-tokenize text)) + (let* ((word-list (cj/markov-tokenize text)) + ;; Convert to vector for O(1) access instead of O(n) with nth + (words (vconcat word-list)) (len (length words))) (cl-loop for i from 0 to (- len 3) - for a = (nth i words) - for b = (nth (1+ i) words) - for c = (nth (+ i 2) words) + for a = (aref words i) + for b = (aref words (1+ i)) + for c = (aref words (+ i 2)) do (let* ((bigram (list a b)) (nexts (gethash bigram (cj/markov-chain-map chain)))) (puthash bigram (cons c nexts) (cj/markov-chain-map chain))))) - (setf (cj/markov-chain-keys chain) - (cl-loop for k being the hash-keys of (cj/markov-chain-map chain) - collect k))) + ;; Invalidate cached keys after learning new data + (setf (cj/markov-chain-keys chain) nil)) (defun cj/markov-fix-capitalization (sentence) "Capitalize the first word and the first word after .!? in SENTENCE." @@ -94,7 +127,7 @@ (defun cj/markov-generate (chain n &optional start) "Generate a sentence of N tokens from CHAIN." - (when (cj/markov-chain-keys chain) + (when (> (hash-table-count (cj/markov-chain-map chain)) 0) (let* ((state (or (and start (gethash start (cj/markov-chain-map chain)) start) @@ -116,33 +149,37 @@ (cj/markov-join-tokens tokens)))) (defun cj/markov-random-key (chain) - (nth (random (length (cj/markov-chain-keys chain))) - (cj/markov-chain-keys chain))) + "Return a random bigram key from CHAIN. +Builds and caches the keys list lazily if not already cached." + (unless (cj/markov-chain-keys chain) + ;; Lazily build keys list only when needed + (setf (cj/markov-chain-keys chain) + (cl-loop for k being the hash-keys of (cj/markov-chain-map chain) + collect k))) + (let ((keys (cj/markov-chain-keys chain))) + (when keys + (nth (random (length keys)) keys)))) (defun cj/markov-next-word (chain bigram) (let ((candidates (gethash bigram (cj/markov-chain-map chain)))) (when candidates (nth (random (length candidates)) candidates)))) -;;;###autoload (defvar cj/lipsum-chain (cj/markov-chain-create) "Global Markov chain for lipsum generation.") -;;;###autoload (defun cj/lipsum-reset () "Reset the global lipsum Markov chain." (interactive) (setq cj/lipsum-chain (cj/markov-chain-create)) (message "cj/lipsum-chain reset.")) -;;;###autoload (defun cj/lipsum-learn-region (beg end) "Learn text from region." (interactive "r") (cj/markov-learn cj/lipsum-chain (buffer-substring-no-properties beg end)) (message "Learned from region.")) -;;;###autoload (defun cj/lipsum-learn-buffer () "Learn from entire buffer." (interactive) @@ -150,7 +187,6 @@ (buffer-substring-no-properties (point-min) (point-max))) (message "Learned from buffer.")) -;;;###autoload (defun cj/lipsum-learn-file (file) "Learn from FILE containing plain text." (interactive "fTrain from file: ") @@ -159,12 +195,10 @@ (cj/markov-learn cj/lipsum-chain (buffer-string))) (message "Learned from file: %s" file)) -;;;###autoload (defun cj/lipsum (n) "Return N words of lorem ipsum." (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) -;;;###autoload (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." (interactive "nNumber of words: ") @@ -176,7 +210,6 @@ (defconst cj/lipsum-title-max 8) (defconst cj/lipsum-title-small 3) -;;;###autoload (defun cj/lipsum-title () "Generate a pseudo-Latin title." (interactive) @@ -190,6 +223,7 @@ (or (cj/markov-next-word cj/lipsum-chain state) (cadr (cj/markov-random-key cj/lipsum-chain)))))) collect (replace-regexp-in-string "^[[:punct:]]+\\|[[:punct:]]+$" "" w)))) + ;; Filter empty strings from generated words (setq words (cl-remove-if #'string-empty-p words)) (mapconcat (lambda (word idx) @@ -200,7 +234,6 @@ ;;; Paragraphs -;;;###autoload (defun cj/lipsum-paragraphs (count &optional min max) "Insert COUNT paragraphs of lipsum. @@ -213,23 +246,6 @@ Defaults: MIN=30, MAX=80." (let ((len (+ min (random (1+ (- max min)))))) (insert (cj/lipsum len) "\n\n"))))) -;;; Customization - -(defgroup cj-lipsum nil - "Pseudo-Latin lorem ipsum text generator." - :prefix "cj/lipsum-" - :group 'text) - -(defcustom cj/lipsum-default-file - (expand-file-name "latin.txt" - (file-name-directory (or load-file-name buffer-file-name))) - "Default training file for cj-lipsum. - -This should be a plain UTF-8 text file with hundreds of Latin words -or sentences. By default it points to the bundled `latin.txt`." - :type 'file - :group 'cj-lipsum) - ;;; Initialization: train on default file (defun cj/lipsum--init () "Initialize cj-lipsum by learning from `cj/lipsum-default-file`." @@ -240,5 +256,5 @@ or sentences. By default it points to the bundled `latin.txt`." (cj/lipsum--init) -(provide 'lorem-generator) -;;; lorem-generator.el ends here. +(provide 'lorem-optimum) +;;; lorem-optimum.el ends here. diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index c7aac99b..c86ac6a3 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -244,7 +244,6 @@ The agenda is rebuilt from all sources before display, including: (defun cj/add-timestamp-to-org-entry (s) "Add an event with time S to appear underneath the line-at-point. - This allows a line to show in an agenda without being scheduled or a deadline." (interactive "sTime: ") (defvar cj/timeformat "%Y-%m-%d %a") @@ -253,7 +252,6 @@ This allows a line to show in an agenda without being scheduled or a deadline." (open-line 1) (forward-line 1) (insert (concat "<" (format-time-string cj/timeformat (current-time)) " " s ">" )))) -;;(global-set-key (kbd "M-t") #'cj/add-timestamp-to-org-entry) ;; --------------------------- Notifications / Alerts -------------------------- ;; send libnotify notifications for agenda items diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 706412a2..df4e18f1 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -20,17 +20,17 @@ ;; Add a wrapper function that ensures proper context (defun cj/org-contacts-anniversaries-safe () - "Safely call org-contacts-anniversaries with required bindings." - (require 'diary-lib) - ;; These need to be dynamically bound for diary functions - (defvar date) - (defvar entry) - (defvar original-date) - (let ((date (calendar-current-date)) - (entry "") - (original-date (calendar-current-date))) - (ignore-errors - (org-contacts-anniversaries)))) + "Safely call org-contacts-anniversaries with required bindings." + (require 'diary-lib) + ;; These need to be dynamically bound for diary functions + (defvar date) + (defvar entry) + (defvar original-date) + (let ((date (calendar-current-date)) + (entry "") + (original-date (calendar-current-date))) + (ignore-errors + (org-contacts-anniversaries)))) ;; Use the safe wrapper instead (add-hook 'org-agenda-finalize-hook 'cj/org-contacts-anniversaries-safe)) @@ -39,8 +39,8 @@ (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) + '("C" "Contact" entry (file+headline contacts-file "Contacts") + "* %(cj/org-contacts-template-name) :PROPERTIES: :EMAIL: %(cj/org-contacts-template-email) :PHONE: %^{Phone(s) - separate multiple with commas} @@ -57,31 +57,31 @@ Added: %U"))) ;; 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) +;; '("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." (let ((name (when (boundp 'cj/contact-name) cj/contact-name))) - (or name - (when (eq major-mode 'mu4e-headers-mode) - (mu4e-message-field (mu4e-message-at-point) :from-or-to)) - (when (eq major-mode 'mu4e-view-mode) - (mu4e-message-field mu4e~view-message :from-or-to)) - (read-string "Name: ")))) + (or name + (when (eq major-mode 'mu4e-headers-mode) + (mu4e-message-field (mu4e-message-at-point) :from-or-to)) + (when (eq major-mode 'mu4e-view-mode) + (mu4e-message-field mu4e~view-message :from-or-to)) + (read-string "Name: ")))) (defun cj/org-contacts-template-email () "Get email for contact template from context." (let ((email (when (boundp 'cj/contact-email) cj/contact-email))) - (or email - (when (eq major-mode 'mu4e-headers-mode) - (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) - (when from (cdr (car from))))) - (when (eq major-mode 'mu4e-view-mode) - (let ((from (mu4e-message-field mu4e~view-message :from))) - (when from (cdr (car from))))) - (read-string "Email: ")))) + (or email + (when (eq major-mode 'mu4e-headers-mode) + (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) + (when from (cdr (car from))))) + (when (eq major-mode 'mu4e-view-mode) + (let ((from (mu4e-message-field mu4e~view-message :from))) + (when from (cdr (car from))))) + (read-string "Email: ")))) ;;; ------------------------- Quick Contact Functions --------------------------- @@ -91,13 +91,13 @@ Added: %U"))) (find-file contacts-file) (goto-char (point-min)) (let ((contact (completing-read "Contact: " - (org-map-entries - (lambda () (nth 4 (org-heading-components))) - nil (list contacts-file))))) - (goto-char (point-min)) - (search-forward contact) - (org-fold-show-entry) - (org-reveal))) + (org-map-entries + (lambda () (nth 4 (org-heading-components))) + nil (list contacts-file))))) + (goto-char (point-min)) + (search-forward contact) + (org-fold-show-entry) + (org-reveal))) (defun cj/org-contacts-new () "Create a new contact." @@ -110,19 +110,6 @@ Added: %U"))) (find-file contacts-file) (org-columns)) -;;; -------------------------- Org-Roam Integration ----------------------------- - -;; (with-eval-after-load 'org-roam -;; (defun cj/org-contacts-link-to-roam () -;; "Link current contact to an org-roam node." -;; (interactive) -;; (when (eq major-mode 'org-mode) -;; (let ((contact-name (org-entry-get (point) "ITEM"))) -;; (org-set-property "ROAM_REFS" -;; (org-roam-node-id -;; (org-roam-node-read nil nil nil nil -;; :initial-input contact-name))))))) - ;;; ----------------------------- Birthday Agenda -------------------------------- (with-eval-after-load 'org-agenda @@ -131,40 +118,48 @@ Added: %U"))) ;; Custom agenda command for upcoming birthdays (add-to-list 'org-agenda-custom-commands - '("b" "Birthdays and Anniversaries" - ((tags-todo "BIRTHDAY|ANNIVERSARY" - ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") - (org-agenda-sorting-strategy '(time-up)))))))) + '("b" "Birthdays and Anniversaries" + ((tags-todo "BIRTHDAY|ANNIVERSARY" + ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") + (org-agenda-sorting-strategy '(time-up)))))))) ;;; ---------------------------- Core Contact Data Functions --------------------------- (defun cj/org-contacts--props-matching (entry pattern) "Return all property values from ENTRY whose keys match PATTERN (a regexp)." (let ((props (nth 2 entry))) - (delq nil - (mapcar (lambda (prop) - (when (string-match-p pattern (car prop)) - (cdr prop))) - props)))) + (delq nil + (mapcar (lambda (prop) + (when (string-match-p pattern (car prop)) + (cdr prop))) + props)))) + +(defun cj/--parse-email-string (name email-string) + "Parse EMAIL-STRING and return formatted entries for NAME. +EMAIL-STRING may contain multiple emails separated by commas, semicolons, or spaces. +Returns a list of strings formatted as 'Name <email>'. +Returns nil if EMAIL-STRING is nil or contains only whitespace." + (when (and email-string (string-match-p "[^[:space:]]" email-string)) + (let ((emails (split-string email-string "[,;[:space:]]+" t))) + (mapcar (lambda (email) + (format "%s <%s>" name (string-trim email))) + emails)))) (defun cj/get-all-contact-emails () "Retrieve all contact emails from org-contacts database. Returns a list of formatted strings like \"Name <email@example.com>\". This is the core function used by the mu4e integration module." (let ((contacts (org-contacts-db))) - (delq nil - (mapcan (lambda (e) - (let* ((name (car e)) - ;; This returns a LIST of email strings - (email-strings (cj/org-contacts--props-matching e "EMAIL"))) - ;; Need mapcan here to handle the list - (mapcan (lambda (email-str) - (when (and email-str (string-match-p "[^[:space:]]" email-str)) - (mapcar (lambda (email) - (format "%s <%s>" name (string-trim email))) - (split-string email-str "[,;[:space:]]+" t)))) - email-strings))) - contacts)))) + (delq nil + (mapcan (lambda (e) + (let* ((name (car e)) + ;; This returns a LIST of email strings + (email-strings (cj/org-contacts--props-matching e "EMAIL"))) + ;; Process each email string using the extracted parser + (mapcan (lambda (email-str) + (cj/--parse-email-string name email-str)) + email-strings))) + contacts)))) ;; Simple insertion function for use outside of mu4e (defun cj/insert-contact-email () @@ -173,8 +168,8 @@ For use outside of mu4e compose buffers. In mu4e, the integration module provides more sophisticated completion." (interactive) (let* ((items (cj/get-all-contact-emails)) - (selected (completing-read "Contact: " items nil t))) - (insert selected))) + (selected (completing-read "Contact: " items nil t))) + (insert selected))) ;;; -------------------------------- Org Contacts -------------------------------- @@ -195,9 +190,9 @@ module provides more sophisticated completion." (setq mu4e-org-contacts-file contacts-file) (add-to-list 'mu4e-headers-actions - '("org-contact-add" . mu4e-action-add-org-contact) t) + '("org-contact-add" . mu4e-action-add-org-contact) t) (add-to-list 'mu4e-view-actions - '("org-contact-add" . mu4e-action-add-org-contact) t) + '("org-contact-add" . mu4e-action-add-org-contact) t) ;; Disable mu4e's built-in completion in favor of our custom solution (setq mu4e-compose-complete-addresses nil)) @@ -207,11 +202,11 @@ module provides more sophisticated completion." ;; Keymap for `org-contacts' commands (defvar cj/org-contacts-map (let ((map (make-sparse-keymap))) - (keymap-set map "f" #'cj/org-contacts-find) ;; find contact - (keymap-set map "n" #'cj/org-contacts-new) ;; new contact - (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact - (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts - map) + (keymap-set map "f" #'cj/org-contacts-find) ;; find contact + (keymap-set map "n" #'cj/org-contacts-new) ;; new contact + (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact + (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts + map) "Keymap for `org-contacts' commands.") ;; Bind the org-contacts map to the C-c C prefix diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 18552b1d..07098743 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -1,7 +1,15 @@ ;;; org-roam-config.el --- Org-Roam Config -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; Currently a work in progress. The initial version of this was taken from David Wilson: +;; Configuration and utilities for org-roam knowledge management. +;; +;; Key features: +;; - Custom capture templates for different node types (v2mom, recipe, topic) +;; - Automatic moving of completed tasks to daily journal +;; - Tag-based node filtering and finding +;; - Branch extraction to new roam nodes (cj/move-org-branch-to-roam) +;; +;; The initial version was adapted from David Wilson: ;; https://systemcrafters.net/build-a-second-brain-in-emacs/5-org-roam-hacks/ ;;; Code: @@ -190,6 +198,51 @@ Otherwise return TEXT unchanged." (or description url)) text)) +(defun cj/--generate-roam-slug (title) + "Convert TITLE to a filename-safe slug. +Converts to lowercase, replaces non-alphanumeric characters with hyphens, +and removes leading/trailing hyphens. +Returns the slugified string." + (let ((slug (replace-regexp-in-string + "[^a-zA-Z0-9]+" "-" + (downcase title)))) + (replace-regexp-in-string "^-\\|-$" "" slug))) + +(defun cj/--demote-org-subtree (content from-level to-level) + "Demote org subtree CONTENT from FROM-LEVEL to TO-LEVEL. +CONTENT is the org-mode text with headings. +FROM-LEVEL is the current level of the top heading (integer). +TO-LEVEL is the desired level for the top heading (integer). +Returns the demoted content as a string. +All headings in the tree are adjusted proportionally." + (if (<= from-level to-level) + ;; No demotion needed + content + (let ((demote-count (- from-level to-level))) + (with-temp-buffer + (insert content) + (goto-char (point-min)) + (while (re-search-forward "^\\(\\*+\\) " nil t) + (let* ((stars (match-string 1)) + (level (length stars)) + (new-level (max 1 (- level demote-count))) + (new-stars (make-string new-level ?*))) + (replace-match (concat new-stars " ")))) + (buffer-string))))) + +(defun cj/--format-roam-node (title node-id content) + "Format org-roam node file CONTENT with TITLE and NODE-ID. +TITLE is the node title string. +NODE-ID is the unique identifier for the node. +CONTENT is the main body content (already demoted if needed). +Returns the complete file content as a string." + (concat ":PROPERTIES:\n" + ":ID: " node-id "\n" + ":END:\n" + "#+TITLE: " title "\n" + "#+CATEGORY: " title "\n" + "#+FILETAGS: Topic\n\n" + content)) (defun cj/move-org-branch-to-roam () "Move the org subtree at point to a new org-roam node. @@ -213,12 +266,7 @@ title." (title (cj/org-link-get-description raw-title)) (timestamp (format-time-string "%Y%m%d%H%M%S")) ;; Convert title to filename-safe format - (title-slug (replace-regexp-in-string - "[^a-zA-Z0-9]+" "-" - (downcase title))) - ;; Remove leading/trailing hyphens - (title-slug (replace-regexp-in-string - "^-\\|-$" "" title-slug)) + (title-slug (cj/--generate-roam-slug title)) (filename (format "%s-%s.org" timestamp title-slug)) (filepath (expand-file-name filename org-roam-directory)) ;; Generate a unique ID for the node @@ -234,33 +282,11 @@ title." (org-cut-subtree) ;; Process the subtree to demote it to level 1 - (with-temp-buffer - (org-mode) - (insert subtree-content) - ;; Demote the entire tree so the top level becomes level 1 - (goto-char (point-min)) - (when (> current-level 1) - (let ((demote-count (- current-level 1))) - (while (re-search-forward "^\\*+ " nil t) - (beginning-of-line) - (dotimes (_ demote-count) - (when (looking-at "^\\*\\*") - (delete-char 1))) - (forward-line)))) - (setq subtree-content (buffer-string))) + (setq subtree-content (cj/--demote-org-subtree subtree-content current-level 1)) ;; Create the new org-roam file (with-temp-file filepath - ;; Insert the org-roam template with ID at file level - (insert ":PROPERTIES:\n") - (insert ":ID: " node-id "\n") - (insert ":END:\n") - (insert "#+TITLE: " title "\n") - (insert "#+CATEGORY: " title "\n") - (insert "#+FILETAGS: Topic\n\n") - - ;; Insert the demoted subtree content - (insert subtree-content)) + (insert (cj/--format-roam-node title node-id subtree-content))) ;; Sync the org-roam database (org-roam-db-sync) diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index e8f2cf23..7b024e43 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -11,6 +11,7 @@ ;; - Automatic conversion to Org format using eww-readable and Pandoc ;; - One-click capture from any web page ;; - Preserves page structure and formatting +;; - Smart heading adjustment (removes page title, demotes remaining headings) ;; ;; Setup: ;; 1. Ensure this file is loaded in your Emacs configuration @@ -30,6 +31,11 @@ ;; The clipped content will be added to the file specified by `webclipped-file` ;; under the "Webclipped Inbox" heading with proper formatting and metadata. ;; +;; Architecture: +;; - cj/--process-webclip-content: Pure function for content processing +;; - cj/org-protocol-webclip-handler: Handles URL fetching and capture +;; - cj/org-webclipper-EWW: Direct capture from EWW/W3M buffers +;; ;; Requirements: ;; - org-web-tools package ;; - Pandoc installed on your system @@ -37,23 +43,6 @@ ;;; Code: -;; Declare functions and variables to avoid warnings -(declare-function org-protocol-protocol-alist "org-protocol") -(declare-function org-capture "org-capture") -(declare-function org-capture-get "org-capture") -(declare-function org-web-tools--url-as-readable-org "org-web-tools") -(declare-function org-w3m-copy-for-org-mode "org-w3m") -(declare-function org-eww-copy-for-org-mode "org-eww") -(declare-function org-at-heading-p "org") -(declare-function org-heading-components "org") -(declare-function org-copy-subtree "org") -(declare-function org-cut-subtree "org") -(declare-function org-id-new "org-id") -(declare-function org-roam-db-sync "org-roam") -(defvar org-capture-templates) -(defvar org-protocol-protocol-alist) -(defvar org-roam-directory) -(defvar webclipped-file) ;; Variables for storing org-protocol data (defvar cj/webclip-current-url nil @@ -66,6 +55,9 @@ (defvar cj/webclipper-initialized nil "Track if webclipper has been initialized.") +(use-package org-web-tools + :defer t) + ;; Lazy initialization function (defun cj/webclipper-ensure-initialized () "Ensure webclipper is initialized when first used." @@ -73,6 +65,7 @@ ;; Load required packages now (require 'org-protocol) (require 'org-capture) + (require 'org-web-tools) (require 'user-constants) ;; for webclipped-file ;; Register the org-protocol handler @@ -102,7 +95,28 @@ (setq cj/webclipper-initialized t))) -;;;###autoload +(defun cj/--process-webclip-content (org-content) + "Process webclip ORG-CONTENT by removing first heading and demoting others. +ORG-CONTENT is the raw org-mode text from the web page conversion. +Returns the processed content as a string with: +- First top-level heading removed +- Initial blank lines removed +- All remaining headings demoted by one level" + (with-temp-buffer + (insert org-content) + (goto-char (point-min)) + ;; Skip the first heading line (we'll use our template's heading) + (when (looking-at "^\\* .*\n") + (delete-region (match-beginning 0) (match-end 0))) + ;; Remove any initial blank lines + (while (looking-at "^[ \t]*\n") + (delete-char 1)) + ;; Demote all remaining headings by one level + ;; since our template already provides the top-level heading + (while (re-search-forward "^\\(\\*+\\) " nil t) + (replace-match (concat (match-string 1) "* ") t t)) + (buffer-string))) + (defun cj/org-protocol-webclip (info) "Process org-protocol webclip requests. INFO is a plist containing :url and :title from the org-protocol call." @@ -135,22 +149,7 @@ It fetches the page content and converts it to Org format." (error "No URL provided for clipping") (condition-case err (let* ((org-content (org-web-tools--url-as-readable-org url)) - ;; Process the content to adjust heading levels - (processed-content - (with-temp-buffer - (insert org-content) - (goto-char (point-min)) - ;; Skip the first heading line (we'll use our template's heading) - (when (looking-at "^\\* .*\n") - (delete-region (match-beginning 0) (match-end 0))) - ;; Remove any initial blank lines - (while (looking-at "^[ \t]*\n") - (delete-char 1)) - ;; Demote all remaining headings by one level - ;; since our template already provides the top-level heading - (while (re-search-forward "^\\(\\*+\\) " nil t) - (replace-match (concat (match-string 1) "* ") t t)) - (buffer-string)))) + (processed-content (cj/--process-webclip-content org-content))) ;; Show success message with the title (require 'user-constants) ;; Ensure webclipped-file is available (message "'%s' added to %s" title webclipped-file) @@ -162,7 +161,7 @@ It fetches the page content and converts it to Org format." ;; ---------------------------- Org Webpage Clipper ---------------------------- -;;;###autoload + (defun cj/org-webclipper-EWW () "Capture the current web page for later viewing in an Org file. Return the yanked content as a string so templates can insert it." @@ -182,13 +181,11 @@ Return the yanked content as a string so templates can insert it." ;; extract the webpage content from the kill ring (car kill-ring))) - ;; ----------------------------- Webclipper Keymap ----------------------------- ;; keymaps shouldn't be required for webclipper -;; TASK Move org-branch to roam functionality under org-roam ;; Setup keymaps -;; ;;;###autoload +;; ;; (defun cj/webclipper-setup-keymaps () ;; "Setup webclipper keymaps." ;; (define-prefix-command 'cj/webclipper-map nil @@ -201,7 +198,6 @@ Return the yanked content as a string so templates can insert it." ;; (cj/webclipper-setup-keymaps)) ;; Register protocol handler early for external calls -;;;###autoload (with-eval-after-load 'org-protocol (unless (assoc "webclip" org-protocol-protocol-alist) (add-to-list 'org-protocol-protocol-alist @@ -210,9 +206,9 @@ Return the yanked content as a string so templates can insert it." :function cj/org-protocol-webclip :kill-client t)))) -(with-eval-after-load 'cj/custom-keymap - (require 'org-webclipper) - (cj/webclipper-setup-keymaps)) +;; (with-eval-after-load 'cj/custom-keymap +;; (require 'org-webclipper) +;; (cj/webclipper-setup-keymaps)) (provide 'org-webclipper) ;;; org-webclipper.el ends here diff --git a/modules/reconcile-open-repos.el b/modules/reconcile-open-repos.el index 648de222..2e48e45d 100644 --- a/modules/reconcile-open-repos.el +++ b/modules/reconcile-open-repos.el @@ -73,7 +73,6 @@ Magit for review." ;; ---------------------------- Check For Open Work ---------------------------- -;;;###autoload (defun cj/check-for-open-work () "Check all project directories for open work." (interactive) diff --git a/modules/test-runner.el b/modules/test-runner.el index b4c40820..125a8d20 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -2,26 +2,75 @@ ;; author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: -;; Provides utilities for running ERT tests with focus/unfocus workflow + +;; This module provides a powerful ERT test runner with focus/unfocus workflow +;; for efficient test-driven development in Emacs Lisp projects. +;; +;; PURPOSE: +;; +;; When working on large Emacs Lisp projects with many test files, you often +;; want to focus on running just the tests relevant to your current work without +;; waiting for the entire suite to run. This module provides a smart test runner +;; that supports both running all tests and focusing on specific test files. +;; +;; WORKFLOW: +;; +;; 1. Run all tests initially to establish baseline (C-; t R) +;; 2. Add test files to focus while working on a feature (C-; t a) +;; 3. Run focused tests repeatedly as you develop (C-; t r) +;; 4. Add more test files as needed (C-; t b from within test buffer) +;; 5. View your focused test list at any time (C-; t v) +;; 6. Clear focus and run all tests before finishing (C-; t c, then C-; t R) +;; +;; PROJECT INTEGRATION: ;; -;; Tests should be located in the Projectile project test directories, -;; typically "test" or "tests" under the project root. -;; Falls back to =~/.emacs.d/tests= if not in a Projectile project. +;; - Automatically discovers test directories in Projectile projects +;; (looks for "test" or "tests" under project root) +;; - Falls back to ~/.emacs.d/tests if not in a Projectile project +;; - Test files must match pattern: test-*.el ;; -;; The default mode is to load and run all tests. +;; SPECIAL BEHAVIORS: ;; -;; To focus on running a specific set of test files: -;; - Toggle the mode to "focus" mode -;; - Add specific test files to the list of tests in "focus" -;; - Running tests (smartly) will now just run those tests +;; - Smart test running: Automatically runs all or focused tests based on mode +;; - Test extraction: Discovers test names via regex to run specific tests +;; - At-point execution: Run individual test at cursor position (C-; t .) +;; - Error handling: Continues loading tests even if individual files fail ;; -;; Don't forget to run all tests again in default mode at least once before finishing. +;; KEYBINDINGS: +;; +;; C-; t L Load all test files +;; C-; t R Run all tests (full suite) +;; C-; t r Run tests smartly (all or focused based on mode) +;; C-; t . Run test at point +;; C-; t a Add test file to focus (with completion) +;; C-; t b Add current buffer's test file to focus +;; C-; t c Clear all focused test files +;; C-; t v View list of focused test files +;; C-; t t Toggle mode between 'all and 'focused +;; +;; RECOMMENDED USAGE: +;; +;; While implementing a feature: +;; - Add the main test file for the feature you're working on +;; - Add any related test files that might be affected +;; - Use C-; t r to repeatedly run just those focused tests +;; - This provides fast feedback during development +;; +;; Before committing: +;; - Clear the focus with C-; t c +;; - Run the full suite with C-; t R to ensure nothing broke +;; - Verify all tests pass before pushing changes ;; ;;; Code: (require 'ert) (require 'cl-lib) +;;; External Variables and Functions + +(defvar cj/custom-keymap) ; Defined in init.el +(declare-function projectile-project-root "projectile" ()) + ;;; Variables (defvar cj/test-global-directory nil @@ -35,19 +84,19 @@ Each element is a filename (without path) to run.") (defvar cj/test-mode 'all "Current test execution mode. -Either 'all (run all tests) or 'focused (run only focused tests).") +Either \\='all (run all tests) or \\='focused (run only focused tests).") (defvar cj/test-last-results nil "Results from the last test run.") ;;; Core Functions -;;;###autoload (defun cj/test--get-test-directory () "Return the test directory path for the current project. -If in a Projectile project, prefers a 'test' or 'tests' directory inside the project root. -Falls back to =cj/test-global-directory= if not found or not in a project." +If in a Projectile project, prefers \\='test or \\='tests directory +inside the project root. Falls back to `cj/test-global-directory' +if not found or not in a project." (require 'projectile) (let ((project-root (ignore-errors (projectile-project-root)))) (if (not (and project-root (file-directory-p project-root))) @@ -60,15 +109,32 @@ Falls back to =cj/test-global-directory= if not found or not in a project." ((file-directory-p tests-dir) tests-dir) (t cj/test-global-directory)))))) -;;;###autoload (defun cj/test--get-test-files () - "Return a list of test file names (without path) in the appropriate test directory." + "Return list of test file names (without path) in test directory." (let ((dir (cj/test--get-test-directory))) (when (file-directory-p dir) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) -;;;###autoload +(defun cj/test--do-load-files (_dir files) + "Load test FILES from DIR. +Returns: (cons \\='success loaded-count) on success, + (cons \\='error (list failed-files errors)) on errors." + (let ((loaded-count 0) + (errors '())) + (dolist (file files) + (condition-case err + (progn + (load-file file) + (setq loaded-count (1+ loaded-count))) + (error + (push (cons (file-name-nondirectory file) + (error-message-string err)) + errors)))) + (if (null errors) + (cons 'success loaded-count) + (cons 'error (list loaded-count (nreverse errors)))))) + (defun cj/test-load-all () "Load all test files from the appropriate test directory." (interactive) @@ -76,21 +142,27 @@ Falls back to =cj/test-global-directory= if not found or not in a project." (let ((dir (cj/test--get-test-directory))) (unless (file-directory-p dir) (user-error "Test directory %s does not exist" dir)) - (let ((test-files (directory-files dir t "^test-.*\\.el$")) - (loaded-count 0)) - (dolist (file test-files) - (condition-case err - (progn - (load-file file) - (setq loaded-count (1+ loaded-count)) - (message "Loaded test file: %s" (file-name-nondirectory file))) - (error - (message "Error loading %s: %s" - (file-name-nondirectory file) - (error-message-string err))))) - (message "Loaded %d test file(s)" loaded-count)))) - -;;;###autoload + (let ((test-files (directory-files dir t "^test-.*\\.el$"))) + (pcase (cj/test--do-load-files dir test-files) + (`(success . ,count) + (message "Loaded %d test file(s)" count)) + (`(error ,count ,errors) + (dolist (err errors) + (message "Error loading %s: %s" (car err) (cdr err))) + (message "Loaded %d test file(s) with %d error(s)" count (length errors))))))) + +(defun cj/test--do-focus-add (filename available-files focused-files) + "Add FILENAME to focused test files. +AVAILABLE-FILES is the list of all available test files. +FOCUSED-FILES is the current list of focused files. +Returns: \\='success if added successfully, + \\='already-focused if file is already focused, + \\='not-available if file is not in available-files." + (cond + ((not (member filename available-files)) 'not-available) + ((member filename focused-files) 'already-focused) + (t 'success))) + (defun cj/test-focus-add () "Select test file(s) to add to the focused list." (interactive) @@ -109,30 +181,64 @@ Falls back to =cj/test-global-directory= if not found or not in a project." unfocused-files nil t) (user-error "All test files are already focused")))) - (push selected cj/test-focused-files) - (message "Added to focus: %s" selected) - (when (called-interactively-p 'interactive) - (cj/test-view-focused)))))) + (pcase (cj/test--do-focus-add selected available-files cj/test-focused-files) + ('success + (push selected cj/test-focused-files) + (message "Added to focus: %s" selected) + (when (called-interactively-p 'interactive) + (cj/test-view-focused))) + ('already-focused + (message "Already focused: %s" selected)) + ('not-available + (user-error "File not available: %s" selected))))))) + +(defun cj/test--do-focus-add-file (filepath testdir focused-files) + "Validate and add FILEPATH to focused list. +TESTDIR is the test directory path. +FOCUSED-FILES is the current list of focused files. +Returns: \\='success if added successfully, + \\='no-file if filepath is nil, + \\='not-in-testdir if file is not inside test directory, + \\='already-focused if file is already focused. +Second value is the relative filename if successful." + (cond + ((null filepath) (cons 'no-file nil)) + ((not (string-prefix-p (file-truename testdir) (file-truename filepath))) + (cons 'not-in-testdir nil)) + (t + (let ((relative (file-relative-name filepath testdir))) + (if (member relative focused-files) + (cons 'already-focused relative) + (cons 'success relative)))))) -;;;###autoload (defun cj/test-focus-add-this-buffer-file () "Add the current buffer's file to the focused test list." (interactive) (let ((file (buffer-file-name)) (dir (cj/test--get-test-directory))) - (unless file - (user-error "Current buffer is not visiting a file")) - (unless (string-prefix-p (file-truename dir) (file-truename file)) - (user-error "File is not inside the test directory: %s" dir)) - (let ((relative (file-relative-name file dir))) - (if (member relative cj/test-focused-files) - (message "Already focused: %s" relative) - (push relative cj/test-focused-files) - (message "Added to focus: %s" relative) - (when (called-interactively-p 'interactive) - (cj/test-view-focused)))))) - -;;;###autoload + (pcase (cj/test--do-focus-add-file file dir cj/test-focused-files) + (`(no-file . ,_) + (user-error "Current buffer is not visiting a file")) + (`(not-in-testdir . ,_) + (user-error "File is not inside the test directory: %s" dir)) + (`(already-focused . ,relative) + (message "Already focused: %s" relative)) + (`(success . ,relative) + (push relative cj/test-focused-files) + (message "Added to focus: %s" relative) + (when (called-interactively-p 'interactive) + (cj/test-view-focused)))))) + +(defun cj/test--do-focus-remove (filename focused-files) + "Remove FILENAME from FOCUSED-FILES. +Returns: \\='success if removed successfully, + \\='empty-list if focused-files is empty, + \\='not-found if filename is not in focused-files." + (cond + ((null focused-files) 'empty-list) + ((not (member filename focused-files)) 'not-found) + (t 'success))) + (defun cj/test-focus-remove () "Remove a test file from the focused list." (interactive) @@ -141,13 +247,18 @@ Falls back to =cj/test-global-directory= if not found or not in a project." (let ((selected (completing-read "Remove from focus: " cj/test-focused-files nil t))) - (setq cj/test-focused-files - (delete selected cj/test-focused-files)) - (message "Removed from focus: %s" selected) - (when (called-interactively-p 'interactive) - (cj/test-view-focused))))) + (pcase (cj/test--do-focus-remove selected cj/test-focused-files) + ('success + (setq cj/test-focused-files + (delete selected cj/test-focused-files)) + (message "Removed from focus: %s" selected) + (when (called-interactively-p 'interactive) + (cj/test-view-focused))) + ('not-found + (message "File not in focused list: %s" selected)) + ('empty-list + (user-error "No focused files to remove")))))) -;;;###autoload (defun cj/test-focus-clear () "Clear all focused test files." (interactive) @@ -168,73 +279,82 @@ Returns a list of test name symbols defined in the file." (push (match-string 1) test-names))) test-names)) -;;;###autoload +(defun cj/test--do-get-focused-tests (focused-files test-dir) + "Get test names from FOCUSED-FILES in TEST-DIR. +Returns: (cons \\='success (list test-names loaded-count)) if successful, + (cons \\='no-tests nil) if no tests found, + (cons \\='empty-list nil) if focused-files is empty." + (if (null focused-files) + (cons 'empty-list nil) + (let ((all-test-names '()) + (loaded-count 0)) + (dolist (file focused-files) + (let ((full-path (expand-file-name file test-dir))) + (when (file-exists-p full-path) + (load-file full-path) + (setq loaded-count (1+ loaded-count)) + (let ((test-names (cj/test--extract-test-names full-path))) + (setq all-test-names (append all-test-names test-names)))))) + (if (null all-test-names) + (cons 'no-tests nil) + (cons 'success (list all-test-names loaded-count)))))) + (defun cj/test-run-focused () "Run only the focused test files." (interactive) - (if (null cj/test-focused-files) - (user-error "No focused files set. Use =cj/test-focus-add' first") - (let ((all-test-names '()) - (loaded-count 0) - (dir (cj/test--get-test-directory))) - ;; Load the focused files and collect their test names - (dolist (file cj/test-focused-files) - (let ((full-path (expand-file-name file dir))) - (when (file-exists-p full-path) - (load-file full-path) - (setq loaded-count (1+ loaded-count)) - ;; Extract test names from this file - (let ((test-names (cj/test--extract-test-names full-path))) - (setq all-test-names (append all-test-names test-names)))))) - (if (null all-test-names) - (message "No tests found in focused files") - ;; Build a regexp that matches any of our test names - (let ((pattern (regexp-opt all-test-names))) - (message "Running %d test(s) from %d focused file(s)" - (length all-test-names) loaded-count) - ;; Run only the tests we found - (ert (concat "^" pattern "$"))))))) + (let ((dir (cj/test--get-test-directory))) + (pcase (cj/test--do-get-focused-tests cj/test-focused-files dir) + (`(empty-list . ,_) + (user-error "No focused files set. Use =cj/test-focus-add' first")) + (`(no-tests . ,_) + (message "No tests found in focused files")) + (`(success ,test-names ,loaded-count) + (let ((pattern (regexp-opt test-names))) + (message "Running %d test(s) from %d focused file(s)" + (length test-names) loaded-count) + (ert (concat "^" pattern "$"))))))) (defun cj/test--ensure-test-dir-in-load-path () - "Ensure the directory returned by cj/test--get-test-directory is in `load-path`." + "Ensure test directory is in `load-path'." (let ((dir (cj/test--get-test-directory))) (when (and dir (file-directory-p dir)) (add-to-list 'load-path dir)))) -;;;###autoload +(defun cj/test--extract-test-at-pos () + "Extract test name at current position. +Returns: test name symbol if found, nil otherwise." + (save-excursion + (beginning-of-defun) + (condition-case nil + (let ((form (read (current-buffer)))) + (when (and (listp form) + (eq (car form) 'ert-deftest) + (symbolp (cadr form))) + (cadr form))) + (error nil)))) + (defun cj/run-test-at-point () "Run the ERT test at point. If point is inside an `ert-deftest` definition, run that test only. Otherwise, message that no test is found." (interactive) - (let ((original-point (point))) - (save-excursion - (beginning-of-defun) - (condition-case nil - (let ((form (read (current-buffer)))) - (if (and (listp form) - (eq (car form) 'ert-deftest) - (symbolp (cadr form))) - (ert (cadr form)) - (message "Not in an ERT test method."))) - (error (message "No ERT test methods found at point.")))) - (goto-char original-point))) - -;;;###autoload + (let ((test-name (cj/test--extract-test-at-pos))) + (if test-name + (ert test-name) + (message "Not in an ERT test method.")))) + (defun cj/test-run-all () "Load and run all tests." (interactive) (cj/test-load-all) (ert t)) -;;;###autoload (defun cj/test-toggle-mode () - "Toggle between 'all and 'focused test execution modes." + "Toggle between \\='all and \\='focused test execution modes." (interactive) (setq cj/test-mode (if (eq cj/test-mode 'all) 'focused 'all)) (message "Test mode: %s" cj/test-mode)) -;;;###autoload (defun cj/test-view-focused () "Display test files in focus." (interactive) @@ -243,7 +363,6 @@ Otherwise, message that no test is found." (message "Focused files: %s" (mapconcat 'identity cj/test-focused-files ", ")))) -;;;###autoload (defun cj/test-run-smart () "Run tests based on current mode (all or focused)." (interactive) @@ -265,8 +384,20 @@ Otherwise, message that no test is found." "t" #'cj/test-toggle-mode) (keymap-set cj/custom-keymap "t" cj/testrunner-map) + +;; which-key integration (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; t" "test runner menu")) + (which-key-add-key-based-replacements + "C-; t" "test runner menu" + "C-; t L" "load all tests" + "C-; t R" "run all tests" + "C-; t r" "run smart" + "C-; t ." "run test at point" + "C-; t a" "add to focus" + "C-; t b" "add buffer to focus" + "C-; t c" "clear focus" + "C-; t v" "view focused" + "C-; t t" "toggle mode")) (provide 'test-runner) ;;; test-runner.el ends here diff --git a/modules/wip.el b/modules/wip.el index 314881d2..80b3295d 100644 --- a/modules/wip.el +++ b/modules/wip.el @@ -35,7 +35,6 @@ (list nil s "command"))) (t (user-error "Error: cj/system-cmd expects a string or a symbol")))) -;;;###autoload (defun cj/system-cmd (cmd) "Run CMD (string or symbol naming a string) detached via the shell. Shell expansions like $(...) are supported. Output is silenced. |