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/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/reconcile-open-repos.el | 1 | ||||
| -rw-r--r-- | modules/test-runner.el | 331 | ||||
| -rw-r--r-- | modules/wip.el | 1 |
10 files changed, 529 insertions, 258 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/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/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. |