diff options
83 files changed, 7849 insertions, 669 deletions
diff --git a/.localrepo/archive-contents b/.localrepo/archive-contents index d6c4f6b4..f56d983c 100644 --- a/.localrepo/archive-contents +++ b/.localrepo/archive-contents @@ -39,7 +39,6 @@ (devdocs . [(0 6 1) ((emacs (27 1))) "Emacs viewer for DevDocs" tar]) (dired-hacks-utils . [(20240629 1906) ((dash (2 5 0)) (emacs (24 3))) "Utilities and helpers for dired-hacks collection." tar]) (dired-hide-dotfiles . [(20240727 1720) ((emacs (25 1))) "Hide dotfiles in dired." tar]) - (dired-sidebar . [(20250212 629) ((emacs (25 1)) (dired-subtree (0 0 1)) (compat (30 0 0 0))) "Tree browser leveraging dired." tar]) (dired-subtree . [(20240629 1859) ((dash (2 5 0)) (dired-hacks-utils (0 0 1)) (emacs (24 3))) "Insert subdirectories in a tree-like fashion." tar]) (dirvish . [(2 3 0) ((emacs (28 1)) (compat (30))) "A modern file manager based on dired mode" tar]) (doom-modeline . [(20250718 1833) ((emacs (25 1)) (compat (30 1 0 0)) (nerd-icons (0 1 0)) (shrink-path (0 3 1))) "A minimal and modern mode-line." tar]) @@ -57,6 +56,8 @@ (emms . [(24) ((cl-lib (0 5)) (nadvice (0 3)) (seq (0))) "The Emacs Multimedia System" tar]) (emojify . [(20210108 1111) ((seq (1 11)) (ht (2 0)) (emacs (24 3))) "Display emojis in Emacs." tar]) (eradio . [(20210327 1000) ((emacs (24 1))) "A simple Internet radio player." tar]) + (erc-image . [(20210604 753) nil "Show received image urls in the ERC buffer." tar]) + (erc-yank . [(20210220 1815) nil "Automagically create a Gist if pasting more than 5 lines." tar]) (eshell-syntax-highlighting . [(20241222 2030) ((emacs (25 1))) "Highlight eshell commands." tar]) (eshell-toggle . [(20250513 1742) ((emacs (25 1)) (dash (2 11 0))) "Show/hide eshell under active window." tar]) (eshell-up . [(20240226 1747) ((emacs (24))) "Quickly go to a specific parent directory in eshell." tar]) @@ -112,7 +113,6 @@ (move-text . [(20231204 1514) nil "Move current line or region with Mdown." tar]) (nerd-icons . [(20250718 355) ((emacs (24 3))) "Emacs Nerd Font Icons Library." tar]) (nerd-icons-completion . [(20250509 1949) ((emacs (25 1)) (nerd-icons (0 0 1)) (compat (30))) "Add icons to completion candidates." tar]) - (nerd-icons-dired . [(20250506 1729) ((emacs (24 4)) (nerd-icons (0 0 1))) "Shows icons for each file in dired mode." tar]) (nerd-icons-ibuffer . [(20250307 958) ((emacs (24 3)) (nerd-icons (0 0 1))) "Display nerd icons in ibuffer." tar]) (noflet . [(20141102 1454) nil "Locally override functions." tar]) (nov . [(20250615 1051) ((esxml (0 3 6)) (emacs (25 1))) "Featureful EPUB reader mode." tar]) @@ -126,6 +126,7 @@ (org-gcal . [(20250624 1628) ((aio (1 0)) (alert (1 2)) (elnode (20190702 1509)) (emacs (26 1)) (oauth2-auto (20240326 2225)) (org (9 3)) (persist (0 4)) (request (20190901)) (request-deferred (20181129))) "Org sync with Google Calendar." tar]) (org-roam . [(20250701 528) ((emacs (26 1)) (dash (2 13)) (org (9 6)) (emacsql (4 1 0)) (magit-section (3 0 0))) "A database abstraction layer for Org-mode." tar]) (org-superstar . [(1 5 1) ((org (9 1 9)) (emacs (26 1))) "Prettify headings and plain lists in Org mode" tar]) + (org-web-tools . [(20231220 1515) ((emacs (27 1)) (org (9 0)) (compat (29 1 4 2)) (dash (2 12)) (esxml (0 3 4)) (s (1 10 0)) (plz (0 7 1)) (request (0 3 0))) "Display and capture web content with Org-mode." tar]) (ox-pandoc . [(20250424 908) ((org (8 2)) (emacs (24 4)) (dash (2 8)) (ht (2 0))) "An Org-mode exporter using pandoc." tar]) (package-build . [(20250708 1908) ((emacs (26 1)) (compat (30 0 0 0))) "Tools for assembling a package archive." tar]) (package-lint . [(0 26) ((emacs (24 4)) (let-alist (1 0 6))) "A linting library for elisp package authors" tar]) @@ -133,6 +134,7 @@ (pdf-tools . [(1 1 0) ((emacs (26 3)) (tablist (1 0)) (let-alist (1 0 4))) "Support library for PDF documents" tar]) (pdf-view-restore . [(20190904 1708) ((pdf-tools (0 90)) (emacs (26 0))) "Support for opening last known pdf position in pdfview mode." tar]) (persist . [(0 6 1) ((emacs (26 1))) "Persist Variables between Emacs Sessions" tar]) + (plz . [(0 9 1) ((emacs (27 1))) "HTTP library" tar]) (poetry . [(20240329 1103) ((transient (0 2 0)) (pyvenv (1 2)) (emacs (25 1))) "Interface to Poetry." tar]) (popper . [(0 4 8) ((emacs (26 1))) "Summon and dismiss buffers as popups" tar]) (popup . [(0 5 9) ((emacs (24 3))) "Visual Popup User Interface" tar]) diff --git a/.localrepo/dired-sidebar-20250212.629.tar b/.localrepo/dired-sidebar-20250212.629.tar Binary files differdeleted file mode 100644 index e6920db9..00000000 --- a/.localrepo/dired-sidebar-20250212.629.tar +++ /dev/null diff --git a/.localrepo/erc-image-20210604.753.tar b/.localrepo/erc-image-20210604.753.tar Binary files differnew file mode 100644 index 00000000..66c998ac --- /dev/null +++ b/.localrepo/erc-image-20210604.753.tar diff --git a/.localrepo/erc-yank-20210220.1815.tar b/.localrepo/erc-yank-20210220.1815.tar Binary files differnew file mode 100644 index 00000000..74c1b960 --- /dev/null +++ b/.localrepo/erc-yank-20210220.1815.tar diff --git a/.localrepo/nerd-icons-dired-20250506.1729.tar b/.localrepo/nerd-icons-dired-20250506.1729.tar Binary files differdeleted file mode 100644 index 5c6d9b5c..00000000 --- a/.localrepo/nerd-icons-dired-20250506.1729.tar +++ /dev/null diff --git a/.localrepo/org-web-tools-20231220.1515.tar b/.localrepo/org-web-tools-20231220.1515.tar Binary files differnew file mode 100644 index 00000000..c7136aa3 --- /dev/null +++ b/.localrepo/org-web-tools-20231220.1515.tar diff --git a/.localrepo/plz-0.9.1.tar b/.localrepo/plz-0.9.1.tar Binary files differnew file mode 100644 index 00000000..2ff4507b --- /dev/null +++ b/.localrepo/plz-0.9.1.tar diff --git a/ai-prompts/quality-engineer.org b/ai-prompts/quality-engineer.org index 4aad0d19..d6bb7ecb 100644 --- a/ai-prompts/quality-engineer.org +++ b/ai-prompts/quality-engineer.org @@ -11,8 +11,32 @@ You are an expert software quality engineer specializing in Emacs Lisp testing a ## Test Organization & Structure *** File Organization -- All tests reside in user-emacs-directory/tests directory -- Tests are broken out by method: test-<filename-tested>-<methodname-tested>.el +- All tests reside in user-emacs-directory/tests directory (or project test/ directory) +- **Unit Tests**: One file per method + - Naming: test-<filename>-<methodname>.el + - Example: test-org-gcal--safe-substring.el + - Tests a single function in isolation with no external dependencies + - Focus: All normal, boundary, and error cases for ONE method +- **Integration Tests**: One file per functional area or workflow + - Naming: test-integration-<area-or-workflow>.el + - Examples: + - test-integration-recurring-events.el (recurring event workflow) + - test-integration-complex-event-formatting.el (multiple formatting functions together) + - test-integration-empty-missing-data.el (edge case handling across functions) + - test-integration-multi-event-sync.el (multiple events interacting) + - test-integration-sync-workflow.el (full fetch → update → push cycle) + - Tests multiple components working together + - May involve file I/O, multiple functions, org-mode buffers, API interactions, etc. + - Focus on workflows, component interactions, and end-to-end scenarios + - Good integration test areas: + - Complete user workflows (sync, create, update, delete) + - Complex features involving multiple functions (recurring events, timezone handling) + - Cross-component interactions (org-mode ↔ API ↔ file system) + - Edge cases that span multiple functions (empty data, conflicts, errors) + - Anti-patterns to avoid: + - test-integration-<single-function>.el (too narrow, that's a unit test) + - test-integration-stuff.el (too vague, not descriptive) + - test-integration-1.el (numbered tests are not discoverable) - Test utilities are in testutil-<category>.el files - Analyze and leverage existing test utilities as appropriate @@ -89,9 +113,160 @@ For each test case, provide: - Handle missing dependencies by mocking them before loading the module *** Test Naming -- Use descriptive names: test-<module>-<function>-<scenario>-<expected-result> -- Examples: test-buffer-kill-undead-buffer-should-bury + +**** Unit Test Naming +- Pattern: test-<module>-<function>-<category>-<scenario>-<expected-result> +- Examples: + - test-org-gcal--safe-substring-normal-full-string-returns-string + - test-org-gcal--alldayp-boundary-leap-year-returns-true + - test-org-gcal--format-iso2org-error-nil-input-returns-nil +- Category: normal, boundary, or error - Make the test name self-documenting +- Expected result clarifies what the test verifies (returns-true, returns-string, throws-error, etc.) +- Focus: Single function behavior in isolation + +**** Integration Test Naming +- Pattern: test-integration-<area>-<scenario>-<expected-outcome> +- Examples: + - test-integration-recurring-events-preserves-old-timestamps + - test-integration-multi-event-updates-dont-affect-others + - test-integration-sync-workflow-fetch-creates-new-entries + - test-integration-complex-formatting-description-escapes-asterisks + - test-integration-empty-missing-minimal-event-succeeds +- Area: Repeat the integration area from filename for clarity +- Scenario: What situation/workflow is being tested +- Outcome: What should happen across the integrated components +- Focus: Multiple components working together, not single function +- Make the name readable as a sentence describing the integration behavior + +**** Integration Test Docstrings +Integration tests should have more detailed docstrings than unit tests: + +Example structure: +#+begin_src elisp +(ert-deftest test-integration-recurring-events-preserves-old-timestamps () + "Test that recurring events preserve original timestamps across updates. + +When a recurring event is updated with a new instance date from Google Calendar, +the timestamp in the org entry should remain the original series start date, not +jump to the current instance date. + +Components integrated: +- org-gcal--format-event-timestamp (timestamp formatting with recurrence) +- org-gcal--determine-headline (headline selection) +- org-gcal--format-description-for-drawer (description escaping) +- org-gcal--update-entry (entry update orchestration) +- org-element-at-point (org-mode property extraction) + +Validates: +- Recurrence parameter triggers old timestamp preservation +- Old-start/old-end passed through update workflow correctly +- Full workflow: JSON event → parsed data → formatted timestamp → org entry" + ...) +#+end_src + +Docstring requirements: +1. **First line**: Brief summary (< 80 chars) - what is being tested +2. **Context paragraph**: Why this matters, user scenario, or problem being solved +3. **Components integrated**: Explicit list of functions/modules working together + - List each component with brief description of its role + - Include external dependencies (org-mode functions, file I/O, etc.) + - Show the integration boundary (what's real vs mocked) +4. **Validates section**: What specific integration behavior is verified + - Data flow between components + - State changes across function calls + - Error propagation through the system +5. **Optional sections**: + - Edge cases being tested + - Known limitations + - Related integration tests + - Performance considerations + +Why detailed docstrings matter for integration tests: +- Integration failures are harder to debug than unit test failures +- Need to understand which component interaction broke +- Documents the integration contract between components +- Helps maintainers understand system architecture +- Makes test intent clear when test name is necessarily brief + +**CRITICAL**: Always list integrated components in docstrings: +- Explicitly enumerate every function/module being tested together +- Include external dependencies (org-mode, file I/O, parsers) +- Distinguish between what's real and what's mocked +- Show the data flow path through components +- Name the integration boundary points + +Bad docstring (insufficient detail): +#+begin_src elisp +(ert-deftest test-integration-sync-workflow-updates-entries () + "Test that sync updates org entries." + ...) +#+end_src + +Good docstring (lists all components): +#+begin_src elisp +(ert-deftest test-integration-sync-workflow-updates-entries () + "Test that calendar sync workflow updates org entries correctly. + +When user runs org-gcal-sync, events from Google Calendar should be +fetched and org entries updated with new data while preserving local edits. + +Components integrated: +- org-gcal-sync (main entry point) +- org-gcal--get-calendar-events (API fetching) +- org-gcal--json-read (JSON parsing) +- org-gcal--update-entry (entry modification) +- org-gcal--format-event-timestamp (timestamp formatting) +- org-element-at-point (org-mode property reading) +- write-file (persisting changes) + +Validates: +- API response flows correctly through parsing → formatting → updating +- Entry properties are updated while preserving manual edits +- File is saved with correct content and encoding +- Error in one event doesn't break processing of others" + ...) +#+end_src + +Component listing best practices: +1. **Order by call flow**: List components in the order they're called +2. **Group by layer**: API → parsing → business logic → persistence +3. **Include return path**: Don't forget callbacks or response handlers +4. **Note side effects**: File writes, cache updates, state changes +5. **Mark test doubles**: Indicate which components are mocked/stubbed +6. **Show boundaries**: Where does your code end and framework begins? + +Examples of component descriptions: +- ~org-gcal--update-entry (entry orchestration)~ - what it does in this test +- ~org-element-at-point (REAL org-mode function)~ - not mocked +- ~request-deferred (MOCKED, returns test data)~ - test double +- ~file-exists-p → find-file → save-buffer (file I/O chain)~ - flow path +- ~org-gcal--format-iso2org (date conversion, TESTED via integration)~ - tested indirectly + +**** Naming Comparison +Unit tests are narrow and specific: +- test-org-gcal--format-iso2org-error-nil-input-returns-nil + - Tests ONE function with ONE input scenario + - Very granular: specific input → specific output + +Integration tests are broader and scenario-focused: +- test-integration-recurring-events-preserves-old-timestamps + - Tests MULTIPLE functions working together + - Workflow-oriented: describes behavior across components + +**** Naming Checklist +For integration test files: +- [ ] Does the name describe a coherent area/workflow? +- [ ] Is it discoverable with glob test-integration-*.el? +- [ ] Could someone guess what's being tested from the name? +- [ ] Is it distinct from other integration test files? + +For integration test methods: +- [ ] Does it start with test-integration-? +- [ ] Does it include the area from the filename? +- [ ] Can you read it as a sentence? +- [ ] Does it describe both scenario AND expected outcome? +- [ ] Is it specific enough to understand what failed if it breaks? *** Code Coverage - Aim for high coverage of critical paths (80%+ for core functionality) @@ -260,6 +435,197 @@ Example timeline: - Generate appropriate integration test cases for the specific implementation - Consider testing interactions between modules +**** When to Write Integration Tests +Write integration tests when: +- Multiple components must work together (API + parser + file I/O) +- Testing complete user workflows (fetch → update → display → save) +- Complex features span multiple functions (recurring events, timezone handling) +- State management across function calls matters +- Real-world scenarios combine multiple edge cases +- Component boundaries and contracts need validation + +Don't write integration tests when: +- Single function behavior can be fully tested in isolation +- No meaningful interaction between components +- Mocking would remove all real integration logic +- Unit tests already cover the integration paths adequately + +**** What Integration Tests Should Cover +Focus on: +- **Complete workflows**: Full user scenarios from start to finish +- **Component interactions**: How functions call each other and pass data +- **State management**: Data persistence, caching, updates across calls +- **Real dependencies**: Actual file I/O, org-mode buffers, data structures +- **Edge case combinations**: Multiple edge cases interacting together +- **Error propagation**: How errors flow through the system +- **Data integrity**: Events don't interfere, state remains consistent + +Avoid: +- Re-testing individual function logic (that's unit tests) +- Testing framework/library behavior (trust it works) +- Over-mocking that removes actual integration + +**** Integration Test Characteristics +- **Slower** than unit tests (acceptable tradeoff) +- **More setup** required (buffers, files, mock data) +- **Broader scope** than unit tests (multiple functions) +- **Higher value** for catching real-world bugs +- **Less granular** in pinpointing exact failures +- **More realistic** scenarios and data + +**** Integration Test Organization +Structure integration tests by: +1. **Workflow**: test-integration-sync-workflow.el (complete sync cycle) +2. **Feature**: test-integration-recurring-events.el (recurring event handling) +3. **Component interaction**: test-integration-multi-event-sync.el (multiple events) +4. **Edge case category**: test-integration-empty-missing-data.el (nil/empty across system) + +Each test file should: +- Focus on one coherent integration area +- Include setup helpers specific to that area +- Test realistic scenarios, not artificial combinations +- Have clear test names describing the integration behavior +- Include detailed docstrings explaining what's being integrated + +**** Integration Test File Structure +Organize tests within each file using comment headers to group related scenarios: + +#+begin_src elisp +;;; test-integration-recurring-events.el --- Integration tests for recurring events + +;;; Commentary: +;; Integration tests covering the complete recurring event workflow: +;; - Creating recurring events from Google Calendar API +;; - Preserving timestamps across updates +;; - Handling different recurrence patterns (WEEKLY, DAILY, etc.) +;; - Managing recurrence metadata in org properties +;; +;; Components integrated: org-gcal--format-event-timestamp, +;; org-gcal--update-entry, org-element-at-point + +;;; Code: + +(require 'org-gcal) +(require 'ert) + +;; Test data constants +(defconst test-integration-recurring-events-weekly-json ...) +(defconst test-integration-recurring-events-daily-json ...) + +;; Helper functions +(defun test-integration-recurring-events--json-read-string (json) ...) + +;;; Normal Cases - Recurring Event Creation + +(ert-deftest test-integration-recurring-events-weekly-creates-with-recurrence () + "Test that weekly recurring event is created with recurrence property. + +Components integrated: +- org-gcal--update-entry +- org-gcal--format-event-timestamp +- org-element-at-point" + ...) + +(ert-deftest test-integration-recurring-events-daily-creates-with-count () + "Test that daily recurring event with COUNT creates correctly. + +Components integrated: +- org-gcal--update-entry +- org-gcal--format-event-timestamp" + ...) + +;;; Boundary Cases - Recurring Event Updates + +(ert-deftest test-integration-recurring-events-update-preserves-recurrence () + "Test that updating recurring event preserves recurrence property. + +Components integrated: +- org-gcal--update-entry (update path) +- org-entry-get (property retrieval)" + ...) + +(ert-deftest test-integration-recurring-events-preserves-old-timestamps () + "Test that recurring events preserve original timestamps across updates. + +This is the KEY test validating the refactored timestamp logic. + +Components integrated: +- org-gcal--format-event-timestamp (with recurrence parameter) +- org-gcal--update-entry (preserving old-start/old-end) +- Full workflow: JSON → parsed data → formatted timestamp → org entry" + ...) + +;;; Edge Cases - Missing or Invalid Recurrence + +(ert-deftest test-integration-recurring-events-no-recurrence-uses-new-timestamps () + "Test that events without recurrence use new timestamps on update. + +Components integrated: +- org-gcal--format-event-timestamp (no recurrence path) +- org-gcal--update-entry" + ...) + +(provide 'test-integration-recurring-events) +;;; test-integration-recurring-events.el ends here +#+end_src + +File structure guidelines: +1. **Commentary section**: High-level overview of what's being integrated + - List the main workflow or feature + - Enumerate key components being tested together + - Explain the integration scope + +2. **Test data section**: Constants and fixtures + - Group related test data together + - Use descriptive constant names + - Document data format if non-obvious + +3. **Helper functions section**: Test utilities + - Functions used by multiple tests in this file + - Setup/teardown helpers + - Data transformation utilities + +4. **Grouped test sections**: Use comment headers to organize tests + - Start with `;;;` (three semicolons) for section headers + - Group by category: "Normal Cases", "Boundary Cases", "Edge Cases", "Error Cases" + - Or group by scenario: "Event Creation", "Event Updates", "Event Deletion" + - Or group by workflow stage: "Fetch Phase", "Update Phase", "Sync Phase" + +5. **Test ordering**: Organize tests logically + - Simple/common cases first + - Complex scenarios build on earlier tests + - Edge cases at the end + - Easier to understand test intent by reading top to bottom + +6. **Section headers should be discoverable**: + - Use grep-friendly patterns: `^;;;.*Cases` or `^;;; Test:` + - Consistent naming: always use "Normal/Boundary/Error Cases" + - Or use workflow stages consistently across files + +Benefits of grouping: +- Easier to find related tests +- Clear structure when file has 20+ tests +- Documents test coverage patterns +- Helps identify gaps (no error cases section? add some!) +- Makes test maintenance easier +- Improves test file readability + +**** Balancing Unit vs Integration Tests +The testing pyramid: +- **Base (most)**: Unit tests - Fast, isolated, granular +- **Middle**: Integration tests - Realistic, component interactions +- **Top (fewest)**: End-to-end tests - Full system, slowest + +For most projects: +- 70-80% unit tests (individual functions) +- 15-25% integration tests (component interactions) +- 5-10% end-to-end tests (full workflows) + +Don't duplicate coverage: +- If unit tests fully cover logic, integration tests focus on interactions +- If integration test covers a workflow, don't repeat every unit test case +- Integration tests validate unit-tested components work together correctly + *** Test Reviews - Review tests with the same rigor as production code - Check for proper assertions and failure messages @@ -31,7 +31,6 @@ (require 'custom-datetime) ;; date/timestamp insertion in various formats (require 'custom-file-buffer) ;; custom buffer and file operations and keymap (require 'custom-line-paragraph) ;; operations on lines and paragraphs -;; <<<< writing tests for custom-misc (require 'custom-misc) ;; miscellaneous functions (require 'custom-ordering) ;; ordering and sorting operations (require 'custom-text-enclose) ;; operations to append, prepend, and surround text @@ -42,10 +41,11 @@ ;; ------------------------- System Level Functionality ------------------------ (require 'auth-config) ;; emacs gnupg integration -(require 'keyboard-macros) ;; tested: keyboard macro management +(require 'keyboard-macros) ;; keyboard macro management (require 'system-utils) ;; timers, process monitor (require 'text-config) ;; text settings and functionality -(require 'undead-buffers) ;; bury rather than kill specific buffers +(require 'undead-buffers) ;; bury rather than kill buffers you choose +(require 'browser-config) ;; browser configuration/integration ;; ------------------------ User Interface Configuration ----------------------- @@ -83,7 +83,6 @@ (require 'markdown-config) (require 'pdf-config) ;; pdf display settings (require 'quick-video-capture) ;; desktop and/or audio recording via ffmpeg -(require 'show-kill-ring) ;; displays and facilitates pasting from history (require 'video-audio-recording) ;; desktop and/or audio recording via ffmpeg (require 'weather-config) ;; utility to display the weather @@ -128,7 +127,7 @@ ;; Filesystem Tools (require 'read_text_file) (require 'write_text_file) -;; (require 'update_text_file) ;; BUG: issues with this tool + ;; (require 'update_text_file) ;; BUG: issues with this tool (require 'list_directory_files) (require 'move_to_trash)) @@ -143,10 +142,10 @@ (require 'games-config) ;; ------------------------------ Modules In Test ------------------------------ -(require 'browser-config) + ;;(require 'wip) -;;(require 'lipsum-generator) -;;(require 'jumper) +(require 'lorem-optimum) +(require 'jumper) ;; ---------------------------------- Wrap Up ---------------------------------- diff --git a/modules/ai-config.el b/modules/ai-config.el index 004750b6..3b89faca 100644 --- a/modules/ai-config.el +++ b/modules/ai-config.el @@ -415,5 +415,22 @@ Works for any buffer, whether it's visiting a file or not." "x" #'cj/gptel-clear-buffer) ;; clears the assistant buffer (keymap-set cj/custom-keymap "a" cj/ai-keymap) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; a" "AI assistant menu" + "C-; a B" "switch backend" + "C-; a M" "gptel menu" + "C-; a d" "delete conversation" + "C-; a ." "add buffer" + "C-; a f" "add file" + "C-; a l" "load conversation" + "C-; a m" "change model" + "C-; a p" "change prompt" + "C-; a &" "rewrite region" + "C-; a r" "clear context" + "C-; a s" "save conversation" + "C-; a t" "toggle window" + "C-; a x" "clear buffer")) + (provide 'ai-config) ;;; ai-config.el ends here. diff --git a/modules/ai-conversations.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/config-utilities.el b/modules/config-utilities.el index ea92f19a..32018371 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -17,12 +17,27 @@ (keymap-global-set "C-c d" cj/debug-config-keymap) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d" "config debugging utils")) + (which-key-add-key-based-replacements + "C-c d" "config debugging utils" + "C-c d p" "profiler menu" + "C-c d p s" "start profiler" + "C-c d p h" "stop profiler" + "C-c d p r" "profiler report" + "C-c d t" "toggle debug-on-error" + "C-c d b" "benchmark method" + "C-c d c" "compilation menu" + "C-c d c h" "compile home" + "C-c d c d" "delete compiled" + "C-c d c ." "compile buffer" + "C-c d i" "info menu" + "C-c d i b" "info build" + "C-c d i p" "info packages" + "C-c d i f" "info features" + "C-c d r" "reload init" + "C-c d a" "reset auth cache")) ;;; --------------------------------- Profiling --------------------------------- -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d p" "profiler menu.")) (keymap-set cj/debug-config-keymap "p s" #'profiler-start) (keymap-set cj/debug-config-keymap "p h" #'profiler-stop) (keymap-set cj/debug-config-keymap "p r" #'profiler-report) @@ -92,8 +107,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (message "Cancelled recompilation of %s" user-emacs-directory)))) (keymap-set cj/debug-config-keymap "c h" 'cj/recompile-emacs-home) -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d c" "config compilation options.")) (defun cj/delete-emacs-home-compiled-files () "Delete all compiled files recursively in \='user-emacs-directory\='." @@ -214,8 +227,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (pop-to-buffer buf))) (keymap-set cj/debug-config-keymap "i b" 'cj/info-emacs-build) -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d i" "info on build/features/packages.")) (defvar cj--loaded-file-paths nil "All file paths that are loaded.") diff --git a/modules/custom-case.el b/modules/custom-case.el index 4fd9ac05..59250ddb 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -118,7 +118,11 @@ short prepositions, and all articles are considered minor words." (keymap-set cj/custom-keymap "c" cj/case-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; c" "case change menu")) + (which-key-add-key-based-replacements + "C-; c" "case change menu" + "C-; c t" "title case" + "C-; c u" "upcase" + "C-; c l" "downcase")) (provide 'custom-case) ;;; custom-case.el ends here. diff --git a/modules/custom-comments.el b/modules/custom-comments.el index b4e51b2c..0d83d31b 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -619,7 +619,18 @@ Leverages cj/comment-inline-border." (keymap-set cj/custom-keymap "C" cj/comment-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; C" "code comment menu")) + (which-key-add-key-based-replacements + "C-; C" "code comment menu" + "C-; C r" "reformat comment" + "C-; C d" "delete comments" + "C-; C c" "inline border" + "C-; C -" "hyphen divider" + "C-; C s" "simple divider" + "C-; C p" "padded divider" + "C-; C b" "box" + "C-; C h" "heavy box" + "C-; C u" "unicode box" + "C-; C n" "block banner")) (provide 'custom-comments) ;;; custom-comments.el ends here. diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index c195ebc2..5b06d81a 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -117,7 +117,14 @@ Use `readable-date-format' for formatting." (keymap-set cj/custom-keymap "d" cj/datetime-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; d" "date/time insertion menu")) + (which-key-add-key-based-replacements + "C-; d" "date/time insertion menu" + "C-; d r" "readable date-time" + "C-; d s" "sortable date-time" + "C-; d t" "sortable time" + "C-; d T" "readable time" + "C-; d d" "sortable date" + "C-; d D" "readable date")) (provide 'custom-datetime) ;;; custom-datetime.el ends here. diff --git a/modules/custom-file-buffer.el b/modules/custom-file-buffer.el index e0224a32..08f974fd 100644 --- a/modules/custom-file-buffer.el +++ b/modules/custom-file-buffer.el @@ -240,7 +240,20 @@ Do not save the deleted text in the kill ring." (keymap-set cj/custom-keymap "b" cj/buffer-and-file-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; b" "buffer and file menu")) + (which-key-add-key-based-replacements + "C-; b" "buffer and file menu" + "C-; b m" "move file" + "C-; b r" "rename file" + "C-; b p" "print to PS" + "C-; b d" "delete file" + "C-; b c" "copy buffer" + "C-; b n" "copy buffer name" + "C-; b t" "clear to top" + "C-; b b" "clear to bottom" + "C-; b x" "erase buffer" + "C-; b s" "save as" + "C-; b l" "copy file link" + "C-; b P" "copy file path")) (provide 'custom-file-buffer) diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index 7f0baef9..32f9aaa1 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -139,8 +139,15 @@ If the line is empty or contains only whitespace, abort with a message." (keymap-set cj/custom-keymap "l" cj/line-and-paragraph-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; l" "line and paragraph menu") - (which-key-add-key-based-replacements "C-; l c" "duplicate and comment")) + (which-key-add-key-based-replacements + "C-; l" "line and paragraph menu" + "C-; l j" "join lines" + "C-; l J" "join paragraph" + "C-; l d" "duplicate" + "C-; l c" "duplicate and comment" + "C-; l R" "remove duplicates" + "C-; l r" "remove matching" + "C-; l u" "underscore line")) (provide 'custom-line-paragraph) ;;; custom-line-paragraph.el ends here. diff --git a/modules/custom-misc.el b/modules/custom-misc.el index 0c6d7ac8..be1f26bb 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,37 +89,49 @@ 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. 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. @@ -124,5 +152,15 @@ to nil." (keymap-set cj/custom-keymap "SPC" #'cj/switch-to-previous-buffer) (keymap-set cj/custom-keymap "|" #'display-fill-column-indicator-mode) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; )" "jump to paren" + "C-; f" "format buffer" + "C-; W" "count words" + "C-; /" "fraction glyphs" + "C-; A" "align regexp" + "C-; SPC" "prev buffer" + "C-; |" "fill column")) + (provide 'custom-misc) ;;; custom-misc.el ends here diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 5d308604..7d906e75 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,12 +242,27 @@ 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 - (which-key-add-key-based-replacements "C-; o" "ordering/sorting menu")) + (which-key-add-key-based-replacements + "C-; o" "ordering/sorting menu" + "C-; o l" "listify" + "C-; o j" "JSON array" + "C-; o p" "Python list" + "C-; o q" "toggle quotes" + "C-; o r" "reverse lines" + "C-; o n" "number lines" + "C-; o A" "alphabetize" + "C-; o L" "comma to lines")) (provide 'custom-ordering) ;;; custom-ordering.el ends here. diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 514419cd..e93e6dea 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -2,82 +2,285 @@ ;;; 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 + "I" #'change-inner + "O" #'change-outer) (keymap-set cj/custom-keymap "s" cj/enclose-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; s" "text enclose menu")) + (which-key-add-key-based-replacements + "C-; s" "text enclose menu" + "C-; s s" "surround text" + "C-; s w" "wrap text" + "C-; s u" "unwrap text" + "C-; s a" "append to lines" + "C-; s p" "prepend to lines" + "C-; s i" "indent lines" + "C-; s d" "dedent lines" + "C-; s I" "change inner" + "C-; s O" "change outer")) (provide 'custom-text-enclose) ;;; custom-text-enclose.el ends here. diff --git a/modules/custom-whitespace.el b/modules/custom-whitespace.el index df93459a..d5f8d80c 100644 --- a/modules/custom-whitespace.el +++ b/modules/custom-whitespace.el @@ -217,7 +217,15 @@ Operate on the active region designated by START and END." (keymap-set cj/custom-keymap "w" cj/whitespace-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; w" "whitespace menu")) + (which-key-add-key-based-replacements + "C-; w" "whitespace menu" + "C-; w c" "collapse whitespace" + "C-; w l" "delete blank lines" + "C-; w 1" "single blank line" + "C-; w d" "delete all whitespace" + "C-; w -" "hyphenate whitespace" + "C-; w t" "untabify" + "C-; w T" "tabify")) (provide 'custom-whitespace) ;;; custom-whitespace.el ends here. diff --git a/modules/diff-config.el b/modules/diff-config.el index 382b2250..45c2a778 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -48,6 +48,14 @@ (add-hook 'ediff-mode-hook #'cj/ediff-hook) (add-hook 'ediff-after-quit-hook-internal #'winner-undo)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c D" "ediff menu" + "C-c D f" "ediff files" + "C-c D b" "ediff buffers" + "C-c D r" "ediff revision" + "C-c D D" "ediff directories")) (provide 'diff-config) ;;; diff-config.el ends here diff --git a/modules/erc-config.el b/modules/erc-config.el index 1c189fa3..e7efb33f 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -183,7 +183,14 @@ Auto-adds # prefix if missing. Offers completion from configured channels." (keymap-set cj/custom-keymap "E" cj/erc-keymap) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; E" "ERC chat menu")) + (which-key-add-key-based-replacements + "C-; E" "ERC chat menu" + "C-; E C" "connect server" + "C-; E c" "join channel" + "C-; E b" "switch buffer" + "C-; E l" "list servers" + "C-; E q" "quit channel" + "C-; E Q" "quit server")) ;; Main ERC configuration (use-package erc diff --git a/modules/external-open.el b/modules/external-open.el index 41d842fb..8c4db810 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -111,6 +111,11 @@ (keymap-global-set "C-c x o" #'cj/open-this-file-with) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c x" "external open menu" + "C-c x o" "open file with")) + ;; -------------------- Open Files With Default File Handler ------------------- (defun cj/find-file-auto (orig-fun &rest args) diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index d7f1ad39..ea19f08f 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -94,5 +94,8 @@ Runs flycheck-prose-on-demand if in an org-buffer." ;; trigger immediate check (flycheck-buffer))) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; ?" "list errors")) + (provide 'flycheck-config) ;;; flycheck-config.el ends here diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index 12e0d348..d12a1794 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. @@ -241,5 +239,11 @@ Press C-' repeatedly to step through misspellings one at a time." ;;;###autoload (keymap-set global-map "C-c f" #'cj/flyspell-toggle) ;;;###autoload (keymap-set global-map "C-'" #'cj/flyspell-then-abbrev) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c f" "flyspell toggle" + "C-'" "flyspell then abbrev")) + (provide 'flyspell-and-abbrev) ;;; flyspell-and-abbrev.el ends here. diff --git a/modules/font-config.el b/modules/font-config.el index 1541f55f..ddd4497f 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) @@ -286,5 +284,12 @@ If FRAME is nil, uses the selected frame." "<~" "<~~" "</" "</>" "~@" "~-" "~>" "~~" "~~>" "%%")) (global-ligature-mode t)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c E" "emojify menu" + "C-c E i" "insert emoji" + "C-c E l" "list emojis")) + (provide 'font-config) ;;; font-config.el ends here 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/keybindings.el b/modules/keybindings.el index 1f8867ef..1eff621c 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -68,12 +68,22 @@ Errors if VAR is unbound, not a non-empty string, or the file does not exist." ;; Bind it under the prefix map. (keymap-set cj/jump-map key fn)))) -;; Bind the prefix globally (user-reserved prefix). -(keymap-global-set "C-c j" cj/jump-map) +;; Bind the prefix to custom keymap +(keymap-set cj/custom-keymap "j" cj/jump-map) -;; nicer prefix label in which-key +;; which-key labels (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c j" "Jump to common files.")) + (which-key-add-key-based-replacements + "C-; j" "jump to files menu" + "C-; j r" "jump to reference" + "C-; j s" "jump to schedule" + "C-; j i" "jump to inbox" + "C-; j c" "jump to contacts" + "C-; j m" "jump to macros" + "C-; j n" "jump to reading notes" + "C-; j w" "jump to webclipped" + "C-; j g" "jump to gcal" + "C-; j I" "jump to emacs init")) ;; ---------------------------- Keybinding Discovery --------------------------- 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/mail-config.el b/modules/mail-config.el index c65e5342..402c2589 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -294,7 +294,10 @@ Prompts user for the action when executing." "d" #'org-msg-attach-delete) (keymap-set cj/custom-keymap "e" cj/email-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; e" "email menu")) + (which-key-add-key-based-replacements + "C-; e" "email menu" + "C-; e a" "attach file" + "C-; e d" "delete attachment")) :bind ;; more intuitive keybinding for attachments (:map org-msg-edit-mode-map @@ -342,5 +345,9 @@ Prompts user for the action when executing." (advice-add #'mu4e-compose-wide-reply :after (lambda (&rest _) (org-msg-edit-mode))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c m" "mu4e email")) + (provide 'mail-config) ;;; mail-config.el ends here diff --git a/modules/mousetrap-mode.el b/modules/mousetrap-mode.el index fa9ee6dd..76c08c79 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -62,5 +62,8 @@ with or without C-, M-, S- modifiers." (keymap-global-set "C-c M" #'mouse-trap-mode) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c M" "mouse trap mode")) + (provide 'mousetrap-mode) ;;; mousetrap-mode.el ends here. diff --git a/modules/music-config.el b/modules/music-config.el index 90feb7eb..902fbd9c 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -366,7 +366,16 @@ Dirs added recursively." (keymap-set cj/custom-keymap "m" cj/music-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; m" "music menu")) + (which-key-add-key-based-replacements + "C-; m" "music menu" + "C-; m m" "toggle playlist" + "C-; m M" "show playlist" + "C-; m a" "add music" + "C-; m r" "create radio" + "C-; m SPC" "pause" + "C-; m s" "stop" + "C-; m p" "playlist mode" + "C-; m x" "shuffle")) (use-package emms :defer t diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index c7aac99b..7b436424 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 @@ -298,6 +296,9 @@ This allows a line to show in an agenda without being scheduled or a deadline." ;; Enable chime-mode automatically (chime-mode 1)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c A" "chime check")) (provide 'org-agenda-config) ;;; org-agenda-config.el ends here diff --git a/modules/org-config.el b/modules/org-config.el index 0249973f..753b1092 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -16,7 +16,7 @@ :init (defvar-keymap cj/org-table-map :doc "org table operations.") - (keymap-global-set "C-c t" cj/org-table-map) + (keymap-set cj/custom-keymap "T" cj/org-table-map) :bind ("C-c c" . org-capture) ("C-c a" . org-agenda) @@ -266,5 +266,20 @@ the current buffer's cache. Useful when encountering parsing errors like (message "Cleared org-element cache for current buffer")) (user-error "Current buffer is not in org-mode")))) +;; which-key labels for org-table-map +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; T" "org table menu" + "C-; T r" "table row" + "C-; T r i" "insert row" + "C-; T r d" "delete row" + "C-; T c" "table column" + "C-; T c i" "insert column" + "C-; T c d" "delete column" + ;; org global bindings + "C-c a" "org agenda" + "C-c c" "org capture" + "C-c l" "org store link")) + (provide 'org-config) ;;; org-config.el ends here diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 706412a2..adb99db4 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,15 +202,24 @@ 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 (keymap-global-set "C-c C" cj/org-contacts-map) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c C" "contacts menu" + "C-c C f" "find contact" + "C-c C n" "new contact" + "C-c C e" "insert email" + "C-c C v" "view all contacts")) + (provide 'org-contacts-config) ;;; org-contacts-config.el ends here diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index f18760c7..08047e3a 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -70,7 +70,13 @@ (keymap-set cj/custom-keymap "D" cj/drill-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; D" "org-drill menu"))) + (which-key-add-key-based-replacements + "C-; D" "org-drill menu" + "C-; D s" "start drill" + "C-; D e" "edit drill file" + "C-; D c" "capture question" + "C-; D r" "refile to drill" + "C-; D R" "resume drill"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-gcal-config.el b/modules/org-gcal-config.el index ed0831b8..cc7cab90 100644 --- a/modules/org-gcal-config.el +++ b/modules/org-gcal-config.el @@ -10,6 +10,9 @@ ;; - Automatic removal of cancelled events, but with TODOs added for visibility ;; - System timezone configuration via functions in host-environment ;; - No notifications on syncing +;; - Events are managed by Org (changes in org file push back to Google Calendar) +;; This is controlled by org-gcal-managed-newly-fetched-mode and +;; org-gcal-managed-update-existing-mode set to "org" ;; - Initial automatic sync post Emacs startup. No auto resync'ing. ;; (my calendar doesn't change hourly and I want fewer distractions and slowdowns). ;; if you need it: https://github.com/kidd/org-gcal.el?tab=readme-ov-file#sync-automatically-at-regular-times @@ -35,6 +38,11 @@ (require 'host-environment) (require 'user-constants) +;; Forward declare org-gcal internal variables and functions +(eval-when-compile + (defvar org-gcal--sync-lock)) +(declare-function org-gcal-reload-client-id-secret "org-gcal") + (defun cj/org-gcal-clear-sync-lock () "Clear the org-gcal sync lock. Useful when a sync fails and leaves the lock in place, preventing future syncs." @@ -42,7 +50,24 @@ Useful when a sync fails and leaves the lock in place, preventing future syncs." (setq org-gcal--sync-lock nil) (message "org-gcal sync lock cleared")) +(defun cj/org-gcal-convert-all-to-org-managed () + "Convert all org-gcal events in current buffer to Org-managed. + +Changes all events with org-gcal-managed property from `gcal' to `org', +enabling bidirectional sync so changes push back to Google Calendar." + (interactive) + (let ((count 0)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^:org-gcal-managed: gcal$" nil t) + (replace-match ":org-gcal-managed: org") + (setq count (1+ count)))) + (when (> count 0) + (save-buffer)) + (message "Converted %d event(s) to Org-managed" count))) + (use-package org-gcal + :vc (:url "https://github.com/cjennings/org-gcal" :rev :newest) :defer t ;; unless idle timer is set below :bind (("C-; g" . org-gcal-sync) ("C-; G" . cj/org-gcal-clear-sync-lock)) @@ -71,11 +96,20 @@ Useful when a sync fails and leaves the lock in place, preventing future syncs." (setq org-gcal-remove-api-cancelled-events t) ;; auto-remove cancelled events (setq org-gcal-update-cancelled-events-with-todo t) ;; todo cancelled events for visibility + ;; Enable bidirectional sync - treat events as Org-managed so changes push back + (setq org-gcal-managed-newly-fetched-mode "org") ;; New events from GCal are Org-managed + (setq org-gcal-managed-update-existing-mode "org") ;; Existing events become Org-managed + :config ;; Enable plstore passphrase caching after org-gcal loads (require 'plstore) (setq plstore-cache-passphrase-for-symmetric-encryption t) + ;; Enable debugging for HTTP requests + (require 'request) + (setq request-log-level 'debug) + (setq request-message-level 'debug) + ;; set org-gcal timezone based on system timezone (setq org-gcal-local-timezone (cj/detect-system-timezone)) @@ -90,5 +124,11 @@ Useful when a sync fails and leaves the lock in place, preventing future syncs." ;; (org-gcal-sync) ;; (error (message "org-gcal: Initial sync failed: %s" err))))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; g" "gcal sync" + "C-; G" "clear sync lock")) + (provide 'org-gcal-config) ;;; org-gcal-config.el ends here diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 18552b1d..f78b68da 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: @@ -77,7 +85,9 @@ (add-to-list 'org-after-todo-state-change-hook (lambda () (when (and (member org-state org-done-keywords) - (not (member org-last-state org-done-keywords))) + (not (member org-last-state org-done-keywords)) + ;; Don't run for gcal.org - it's managed by org-gcal + (not (string= (buffer-file-name) (expand-file-name gcal-file)))) (cj/org-roam-copy-todo-to-today))))) ;; ------------------------- Org Roam Insert Immediate ------------------------- @@ -190,6 +200,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 +268,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 +284,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) @@ -268,5 +296,19 @@ title." ;; Message to user (message "'%s' added as an org-roam node." title))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c n" "org-roam menu" + "C-c n l" "roam buffer toggle" + "C-c n f" "roam find node" + "C-c n p" "roam find project" + "C-c n r" "roam find recipe" + "C-c n t" "roam find topic" + "C-c n i" "roam insert node" + "C-c n w" "roam find webclip" + "C-c n I" "roam insert immediate" + "C-c n d" "roam dailies menu")) + (provide 'org-roam-config) ;;; org-roam-config.el ends here. diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index 67bfa6dd..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 @@ -89,6 +95,28 @@ (setq cj/webclipper-initialized t))) +(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." @@ -121,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) @@ -171,7 +184,6 @@ Return the yanked content as a string so templates can insert it." ;; ----------------------------- Webclipper Keymap ----------------------------- ;; keymaps shouldn't be required for webclipper -;; TASK Move org-branch to roam functionality under org-roam ;; Setup keymaps ;; ;; (defun cj/webclipper-setup-keymaps () diff --git a/modules/prog-general.el b/modules/prog-general.el index f6ebfe09..669922ef 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -400,6 +400,15 @@ If no such file exists there, display a message." "1.5 sec" nil 'delete-windows-on (get-buffer-create "*compilation*")))))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c s" "snippets menu" + "C-c s n" "new snippet" + "C-c s e" "edit snippet" + "C-c s i" "insert snippet" + "C-c p" "projectile menu" + "C-c C-s" "symbol overlay")) (provide 'prog-general) ;;; prog-general.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/selection-framework.el b/modules/selection-framework.el index 66ca1cbd..0bc71f64 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -259,5 +259,9 @@ :config (company-prescient-mode)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c h" "consult history")) + (provide 'selection-framework) ;;; selection-framework.el ends here diff --git a/modules/system-utils.el b/modules/system-utils.el index 6e51c32c..eef20718 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -43,6 +43,9 @@ (message "Error occurred during evaluation: %s" (error-message-string err))))) (keymap-global-set "C-c b" #'cj/eval-buffer-with-confirmation-or-error-message) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c b" "eval buffer")) + ;;; ---------------------------- Edit A File With Sudo ---------------------------- (use-package sudo-edit 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/text-config.el b/modules/text-config.el index 730e36a3..29db9e0b 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -46,8 +46,7 @@ ;; change inner and outer, just like in vim. (use-package change-inner - :bind (("C-c i" . change-inner) - ("C-c o" . change-outer))) + :commands (change-inner change-outer)) ;; ------------------------------ Delete Selection ----------------------------- ;; delete the region on character insertion diff --git a/modules/vc-config.el b/modules/vc-config.el index 3b116cc1..a936e890 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -131,7 +131,16 @@ (keymap-set cj/custom-keymap "v" cj/vc-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; v" "version control menu")) + (which-key-add-key-based-replacements + "C-; v" "version control menu" + "C-; v d" "goto diff hunks" + "C-; v c" "create issue" + "C-; v f" "forge pull" + "C-; v i" "list issues" + "C-; v n" "next hunk" + "C-; v p" "previous hunk" + "C-; v r" "list pull requests" + "C-; v t" "git timemachine")) (provide 'vc-config) ;;; vc-config.el ends here. diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index fa4c2926..73f782f6 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -227,5 +227,14 @@ Otherwise use the default location in `audio-recordings-dir'." (keymap-set cj/custom-keymap "r" cj/record-map) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; r" "recording menu" + "C-; r v" "start video" + "C-; r V" "stop video" + "C-; r a" "start audio" + "C-; r A" "stop audio" + "C-; r l" "adjust levels")) + (provide 'video-audio-recording) ;;; video-audio-recording.el ends here. diff --git a/modules/weather-config.el b/modules/weather-config.el index 526a0b41..31fb1b70 100644 --- a/modules/weather-config.el +++ b/modules/weather-config.el @@ -11,9 +11,8 @@ ;; ----------------------------------- Wttrin ---------------------------------- (use-package wttrin + :vc (:url "https://github.com/cjennings/emacs-wttrin" :rev :newest) :defer t - :load-path ("~/code/wttrin") - :ensure nil ;; local package :preface ;; dependency for wttrin (use-package xterm-color diff --git a/modules/wip.el b/modules/wip.el index 314881d2..db94cdb1 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. @@ -128,6 +127,8 @@ If CONFIRM is non-nil, mark VAR to always require confirmation." (keymap-set cj/custom-keymap "!" #'cj/system-command-menu) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; !" "system commands")) ;; --------------------------- Org Upcoming Modeline --------------------------- diff --git a/tests/test-browser-config.el b/tests/test-browser-config.el new file mode 100644 index 00000000..6ab756dd --- /dev/null +++ b/tests/test-browser-config.el @@ -0,0 +1,277 @@ +;;; test-browser-config.el --- Tests for browser-config.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for browser-config.el - browser selection and configuration. +;; +;; Testing approach: +;; - Tests focus on internal `cj/--do-*` functions (pure business logic) +;; - File I/O tests use temp files +;; - executable-find is stubbed to control available browsers +;; - Each test is isolated with setup/teardown +;; - Tests verify return values, not user messages + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module with temp file to avoid polluting real config +(defvar test-browser--temp-choice-file nil + "Temporary file for browser choice during tests.") + +(defun test-browser-setup () + "Setup test environment before each test." + (setq test-browser--temp-choice-file (make-temp-file "browser-choice-test" nil ".el")) + (setq cj/browser-choice-file test-browser--temp-choice-file)) + +(defun test-browser-teardown () + "Clean up test environment after each test." + (when (and test-browser--temp-choice-file + (file-exists-p test-browser--temp-choice-file)) + (delete-file test-browser--temp-choice-file)) + (setq test-browser--temp-choice-file nil)) + +;; Now require the module +(require 'browser-config) + +;;; Helper Functions + +(defun test-browser-make-plist (name &optional executable path) + "Create a test browser plist with NAME, EXECUTABLE, and PATH." + (list :function 'eww-browse-url + :name name + :executable executable + :path path + :program-var nil)) + +;;; Normal Cases - Discover Browsers + +(ert-deftest test-browser-discover-finds-eww () + "Should always find built-in EWW browser." + (test-browser-setup) + (let ((browsers (cj/discover-browsers))) + (should (cl-find-if (lambda (b) (string= (plist-get b :name) "EWW (Emacs Browser)")) + browsers))) + (test-browser-teardown)) + +(ert-deftest test-browser-discover-deduplicates-names () + "Should not return duplicate browser names." + (test-browser-setup) + (let ((browsers (cj/discover-browsers)) + (names (mapcar (lambda (b) (plist-get b :name)) (cj/discover-browsers)))) + (should (= (length names) (length (cl-remove-duplicates names :test 'string=))))) + (test-browser-teardown)) + +;;; Normal Cases - Apply Browser Choice + +(ert-deftest test-browser-apply-valid-browser () + "Should successfully apply a valid browser configuration." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Test Browser"))) + (let ((result (cj/--do-apply-browser-choice browser))) + (should (eq result 'success)) + (should (eq browse-url-browser-function 'eww-browse-url)))) + (test-browser-teardown)) + +(ert-deftest test-browser-apply-sets-program-var () + "Should set browser program variable if specified." + (test-browser-setup) + (let ((browser (list :function 'browse-url-chrome + :name "Chrome" + :executable "chrome" + :path "/usr/bin/chrome" + :program-var 'browse-url-chrome-program))) + (cj/--do-apply-browser-choice browser) + (should (string= browse-url-chrome-program "/usr/bin/chrome"))) + (test-browser-teardown)) + +;;; Normal Cases - Save and Load + +(ert-deftest test-browser-save-and-load-choice () + "Should save and load browser choice correctly." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Saved Browser" "firefox" "/usr/bin/firefox"))) + (cj/save-browser-choice browser) + (let ((loaded (cj/load-browser-choice))) + (should loaded) + (should (string= (plist-get loaded :name) "Saved Browser")) + (should (string= (plist-get loaded :executable) "firefox")))) + (test-browser-teardown)) + +;;; Normal Cases - Choose Browser + +(ert-deftest test-browser-choose-saves-and-applies () + "Should save and apply browser choice." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Test"))) + (let ((result (cj/--do-choose-browser browser))) + (should (eq result 'success)) + ;; Verify it was saved + (let ((loaded (cj/load-browser-choice))) + (should (string= (plist-get loaded :name) "Test"))))) + (test-browser-teardown)) + +;;; Normal Cases - Initialize Browser + +(ert-deftest test-browser-initialize-with-saved-choice () + "Should load and use saved browser choice." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Saved"))) + (cj/save-browser-choice browser) + (let ((result (cj/--do-initialize-browser))) + (should (eq (car result) 'loaded)) + (should (plist-get (cdr result) :name)) + (should (string= (plist-get (cdr result) :name) "Saved")))) + (test-browser-teardown)) + +(ert-deftest test-browser-initialize-without-saved-choice () + "Should use first available browser when no saved choice." + (test-browser-setup) + ;; Delete any saved choice + (when (file-exists-p cj/browser-choice-file) + (delete-file cj/browser-choice-file)) + (let ((result (cj/--do-initialize-browser))) + (should (eq (car result) 'first-available)) + (should (plist-get (cdr result) :name))) + (test-browser-teardown)) + +;;; Boundary Cases - Apply Browser + +(ert-deftest test-browser-apply-nil-plist () + "Should return 'invalid-plist for nil browser." + (test-browser-setup) + (let ((result (cj/--do-apply-browser-choice nil))) + (should (eq result 'invalid-plist))) + (test-browser-teardown)) + +(ert-deftest test-browser-apply-missing-function () + "Should return 'invalid-plist when :function is missing." + (test-browser-setup) + (let ((browser (list :name "Bad Browser" :function nil))) + (let ((result (cj/--do-apply-browser-choice browser))) + (should (eq result 'invalid-plist)))) + (test-browser-teardown)) + +(ert-deftest test-browser-apply-with-nil-path () + "Should handle nil path for built-in browser." + (test-browser-setup) + (let ((browser (test-browser-make-plist "EWW" nil nil))) + (let ((result (cj/--do-apply-browser-choice browser))) + (should (eq result 'success)))) + (test-browser-teardown)) + +;;; Boundary Cases - Save and Load + +(ert-deftest test-browser-load-nonexistent-file () + "Should return nil when loading from nonexistent file." + (test-browser-setup) + (when (file-exists-p cj/browser-choice-file) + (delete-file cj/browser-choice-file)) + (let ((result (cj/load-browser-choice))) + (should (null result))) + (test-browser-teardown)) + +(ert-deftest test-browser-load-corrupt-file () + "Should return nil when loading corrupt file." + (test-browser-setup) + (with-temp-file cj/browser-choice-file + (insert "this is not valid elisp {{{")) + (let ((result (cj/load-browser-choice))) + (should (null result))) + (test-browser-teardown)) + +(ert-deftest test-browser-load-file-without-variable () + "Should return nil when file doesn't define expected variable." + (test-browser-setup) + (with-temp-file cj/browser-choice-file + (insert "(setq some-other-variable 'foo)")) + ;; Unset any previously loaded variable + (makunbound 'cj/saved-browser-choice) + (let ((result (cj/load-browser-choice))) + (should (null result))) + (test-browser-teardown)) + +;;; Boundary Cases - Choose Browser + +(ert-deftest test-browser-choose-empty-plist () + "Should handle empty plist gracefully." + (test-browser-setup) + (let ((result (cj/--do-choose-browser nil))) + (should (eq result 'invalid-plist))) + (test-browser-teardown)) + +;;; Error Cases - File Operations + +(ert-deftest test-browser-save-to-readonly-location () + "Should return 'save-failed when cannot write file." + (test-browser-setup) + ;; Make file read-only + (with-temp-file cj/browser-choice-file + (insert ";; test")) + (set-file-modes cj/browser-choice-file #o444) + (let ((browser (test-browser-make-plist "Test")) + (result nil)) + (setq result (cj/--do-choose-browser browser)) + ;; Restore permissions before teardown + (set-file-modes cj/browser-choice-file #o644) + (should (eq result 'save-failed))) + (test-browser-teardown)) + +;;; Browser Discovery Tests + +(ert-deftest test-browser-discover-returns-plists () + "Should return properly formatted browser plists." + (test-browser-setup) + (let ((browsers (cj/discover-browsers))) + (should (> (length browsers) 0)) + (dolist (browser browsers) + (should (plist-member browser :function)) + (should (plist-member browser :name)) + (should (plist-member browser :executable)) + (should (plist-member browser :path)))) + (test-browser-teardown)) + +(ert-deftest test-browser-format-location-keys () + "Should have all required keys in browser plist." + (test-browser-setup) + (let ((browsers (cj/discover-browsers))) + (when browsers + (let ((browser (car browsers))) + (should (plist-get browser :function)) + (should (plist-get browser :name))))) + (test-browser-teardown)) + +;;; Integration Tests + +(ert-deftest test-browser-full-cycle () + "Should handle full save-load-apply cycle." + (test-browser-setup) + (let ((browser (test-browser-make-plist "Cycle Test" "test-browser" "/usr/bin/test"))) + ;; Choose (save and apply) + (should (eq (cj/--do-choose-browser browser) 'success)) + ;; Verify it was saved + (let ((loaded (cj/load-browser-choice))) + (should loaded) + (should (string= (plist-get loaded :name) "Cycle Test"))) + ;; Initialize should load the saved choice + (let ((result (cj/--do-initialize-browser))) + (should (eq (car result) 'loaded)) + (should (string= (plist-get (cdr result) :name) "Cycle Test")))) + (test-browser-teardown)) + +(ert-deftest test-browser-overwrite-choice () + "Should overwrite previous browser choice." + (test-browser-setup) + (let ((browser1 (test-browser-make-plist "First")) + (browser2 (test-browser-make-plist "Second"))) + (cj/--do-choose-browser browser1) + (cj/--do-choose-browser browser2) + (let ((loaded (cj/load-browser-choice))) + (should (string= (plist-get loaded :name) "Second")))) + (test-browser-teardown)) + +(provide 'test-browser-config) +;;; test-browser-config.el ends here diff --git a/tests/test-custom-misc-count-words.el b/tests/test-custom-misc-count-words.el new file mode 100644 index 00000000..f2bf793f --- /dev/null +++ b/tests/test-custom-misc-count-words.el @@ -0,0 +1,148 @@ +;;; test-custom-misc-count-words.el --- Tests for cj/--count-words -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--count-words function from custom-misc.el +;; +;; This function counts words in a region using Emacs's built-in count-words. +;; A word is defined by Emacs's word boundaries, which generally means +;; sequences of word-constituent characters separated by whitespace or punctuation. +;; +;; We test the NON-INTERACTIVE implementation (cj/--count-words) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-count-words (input-text) + "Test cj/--count-words on INPUT-TEXT. +Returns the word count." + (with-temp-buffer + (insert input-text) + (cj/--count-words (point-min) (point-max)))) + +;;; Normal Cases + +(ert-deftest test-count-words-multiple-words () + "Should count multiple words." + (should (= 5 (test-count-words "The quick brown fox jumps")))) + +(ert-deftest test-count-words-single-word () + "Should count single word." + (should (= 1 (test-count-words "hello")))) + +(ert-deftest test-count-words-with-punctuation () + "Should count words with punctuation." + (should (= 5 (test-count-words "Hello, world! How are you?")))) + +(ert-deftest test-count-words-multiple-spaces () + "Should count words separated by multiple spaces." + (should (= 3 (test-count-words "hello world test")))) + +(ert-deftest test-count-words-with-newlines () + "Should count words across newlines." + (should (= 6 (test-count-words "line one\nline two\nline three")))) + +(ert-deftest test-count-words-with-tabs () + "Should count words separated by tabs." + (should (= 3 (test-count-words "hello\tworld\ttest")))) + +(ert-deftest test-count-words-mixed-whitespace () + "Should count words with mixed whitespace." + (should (= 4 (test-count-words "hello \t world\n\ntest end")))) + +(ert-deftest test-count-words-hyphenated () + "Should count hyphenated words." + ;; Emacs treats hyphens as word separators in count-words + (should (= 7 (test-count-words "This is state-of-the-art technology")))) + +(ert-deftest test-count-words-contractions () + "Should count contractions." + ;; Emacs treats apostrophes as word separators in count-words + (should (= 6 (test-count-words "don't can't won't")))) + +(ert-deftest test-count-words-numbers () + "Should count numbers as words." + (should (= 6 (test-count-words "The year 2024 has 365 days")))) + +;;; Boundary Cases + +(ert-deftest test-count-words-empty-string () + "Should return 0 for empty string." + (should (= 0 (test-count-words "")))) + +(ert-deftest test-count-words-only-whitespace () + "Should return 0 for whitespace-only text." + (should (= 0 (test-count-words " \t\n\n ")))) + +(ert-deftest test-count-words-only-punctuation () + "Should count punctuation-only text." + ;; Emacs may count consecutive punctuation as a word + (should (= 1 (test-count-words "!@#$%^&*()")))) + +(ert-deftest test-count-words-leading-trailing-spaces () + "Should count words ignoring leading/trailing spaces." + (should (= 3 (test-count-words " hello world test ")))) + +(ert-deftest test-count-words-unicode () + "Should count Unicode words." + (should (= 3 (test-count-words "café résumé naïve")))) + +(ert-deftest test-count-words-very-long-text () + "Should handle very long text." + (let ((long-text (mapconcat (lambda (_) "word") (make-list 1000 nil) " "))) + (should (= 1000 (test-count-words long-text))))) + +(ert-deftest test-count-words-multiline-paragraph () + "Should count words in multi-line paragraph." + (let ((text "This is a paragraph +that spans multiple +lines with various +words in it.")) + (should (= 13 (test-count-words text))))) + +;;; Error Cases + +(ert-deftest test-count-words-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--count-words (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-count-words-empty-region () + "Should return 0 for empty region (start == end)." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (= 0 (cj/--count-words pos pos)))))) + +(ert-deftest test-count-words-partial-region () + "Should count words only in specified region." + (with-temp-buffer + (insert "one two three four five") + ;; Count only "two three four" (positions roughly in middle) + (goto-char (point-min)) + (search-forward "two") + (let ((start (match-beginning 0))) + (search-forward "four") + (let ((end (match-end 0))) + (should (= 3 (cj/--count-words start end))))))) + +(provide 'test-custom-misc-count-words) +;;; test-custom-misc-count-words.el ends here diff --git a/tests/test-custom-misc-format-region.el b/tests/test-custom-misc-format-region.el new file mode 100644 index 00000000..c40a8898 --- /dev/null +++ b/tests/test-custom-misc-format-region.el @@ -0,0 +1,161 @@ +;;; test-custom-misc-format-region.el --- Tests for cj/--format-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--format-region function from custom-misc.el +;; +;; This function reformats text by applying three operations: +;; 1. untabify - converts tabs to spaces +;; 2. indent-region - reindents according to major mode +;; 3. delete-trailing-whitespace - removes trailing whitespace +;; +;; Note: indent-region behavior is major-mode dependent. We test in +;; emacs-lisp-mode and fundamental-mode for predictable results. +;; +;; We test the NON-INTERACTIVE implementation (cj/--format-region) +;; to avoid mocking region selection. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-format-region (input-text &optional mode) + "Test cj/--format-region on INPUT-TEXT. +MODE is the major mode to use (defaults to fundamental-mode). +Returns the buffer string after operation." + (with-temp-buffer + (funcall (or mode #'fundamental-mode)) + (insert input-text) + (cj/--format-region (point-min) (point-max)) + (buffer-string))) + +;;; Normal Cases - Tab Conversion + +(ert-deftest test-format-region-converts-tabs () + "Should convert tabs to spaces." + (let ((result (test-format-region "hello\tworld"))) + (should-not (string-match-p "\t" result)) + (should (string-match-p " " result)))) + +(ert-deftest test-format-region-multiple-tabs () + "Should convert multiple tabs." + (let ((result (test-format-region "\t\thello\t\tworld\t\t"))) + (should-not (string-match-p "\t" result)))) + +;;; Normal Cases - Trailing Whitespace + +(ert-deftest test-format-region-removes-trailing-spaces () + "Should remove trailing spaces." + (let ((result (test-format-region "hello world "))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-removes-trailing-tabs () + "Should remove trailing tabs." + (let ((result (test-format-region "hello world\t\t"))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-removes-trailing-mixed () + "Should remove trailing mixed whitespace." + (let ((result (test-format-region "hello world \t \t "))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-multiline-trailing () + "Should remove trailing whitespace from multiple lines." + (let ((result (test-format-region "line1 \nline2\t\t\nline3 \t "))) + (should (string= result "line1\nline2\nline3")))) + +;;; Normal Cases - Combined Operations + +(ert-deftest test-format-region-tabs-and-trailing () + "Should handle both tabs and trailing whitespace." + (let ((result (test-format-region "\thello\tworld\t\t"))) + (should-not (string-match-p "\t" result)) + ;; Should not end with whitespace + (should-not (string-match-p "[ \t]+$" result)))) + +(ert-deftest test-format-region-preserves-interior-spaces () + "Should preserve interior spaces while fixing edges." + (let ((result (test-format-region "\thello world\t"))) + (should (string-match-p "hello world" result)) + (should-not (string-match-p "\t" result)))) + +;;; Normal Cases - Indentation (Mode-Specific) + +(ert-deftest test-format-region-elisp-indentation () + "Should reindent Elisp code." + (let* ((input "(defun foo ()\n(+ 1 2))") + (result (test-format-region input #'emacs-lisp-mode)) + (lines (split-string result "\n"))) + ;; The inner form should be indented - second line should start with 2 spaces + (should (= 2 (length lines))) + (should (string-prefix-p "(defun foo ()" (car lines))) + (should (string-prefix-p " " (cadr lines))))) + +;;; Boundary Cases + +(ert-deftest test-format-region-empty-string () + "Should handle empty string." + (let ((result (test-format-region ""))) + (should (string= result "")))) + +(ert-deftest test-format-region-no-issues () + "Should handle text with no formatting issues (no-op)." + (let ((result (test-format-region "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-format-region-only-whitespace () + "Should handle text with only whitespace." + (let ((result (test-format-region "\t \t "))) + ;; Should become empty or just spaces, no tabs + (should-not (string-match-p "\t" result)))) + +(ert-deftest test-format-region-single-line () + "Should handle single line." + (let ((result (test-format-region "\thello\t"))) + (should-not (string-match-p "\t" result)))) + +(ert-deftest test-format-region-very-long-text () + "Should handle very long text." + (let* ((long-text (mapconcat (lambda (_) "\thello\t") (make-list 100 nil) "\n")) + (result (test-format-region long-text))) + (should-not (string-match-p "\t" result)))) + +(ert-deftest test-format-region-newlines-preserved () + "Should preserve newlines while fixing formatting." + (let ((result (test-format-region "line1\t \nline2\t \nline3\t "))) + (should (= 2 (cl-count ?\n result))))) + +;;; Error Cases + +(ert-deftest test-format-region-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--format-region (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-format-region-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--format-region pos pos) + ;; Should complete without error + (should (string= (buffer-string) "hello world"))))) + +(provide 'test-custom-misc-format-region) +;;; test-custom-misc-format-region.el ends here diff --git a/tests/test-custom-misc-jump-to-matching-paren.el b/tests/test-custom-misc-jump-to-matching-paren.el new file mode 100644 index 00000000..973b6dfa --- /dev/null +++ b/tests/test-custom-misc-jump-to-matching-paren.el @@ -0,0 +1,197 @@ +;;; test-custom-misc-jump-to-matching-paren.el --- Tests for cj/jump-to-matching-paren -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/jump-to-matching-paren function from custom-misc.el +;; +;; This function jumps to matching delimiters using Emacs's sexp navigation. +;; It works with any delimiter that has matching syntax according to the +;; current syntax table (parentheses, brackets, braces, etc.). +;; +;; Unlike other functions in this test suite, this is an INTERACTIVE function +;; that moves point and displays messages. We test it as an integration test +;; by setting up buffers, positioning point, calling the function, and +;; verifying where point ends up. +;; +;; Key behaviors: +;; - When on opening delimiter: jump forward to matching closing delimiter +;; - When on closing delimiter: jump backward to matching opening delimiter +;; - When just after closing delimiter: jump backward to matching opening +;; - When not on delimiter: display message, don't move +;; - When no matching delimiter: display error message, don't move + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-jump-to-matching-paren (text point-position) + "Test cj/jump-to-matching-paren with TEXT and point at POINT-POSITION. +Returns the new point position after calling the function. +POINT-POSITION is 1-indexed (1 = first character)." + (with-temp-buffer + (emacs-lisp-mode) ; Use elisp mode for proper syntax table + (insert text) + (goto-char point-position) + (cj/jump-to-matching-paren) + (point))) + +;;; Normal Cases - Forward Jump (Opening to Closing) + +(ert-deftest test-jump-paren-forward-simple () + "Should jump forward from opening paren to closing paren." + ;; Text: "(hello)" + ;; Start at position 1 (on opening paren) + ;; Should end at position 8 (after closing paren) + (should (= 8 (test-jump-to-matching-paren "(hello)" 1)))) + +(ert-deftest test-jump-paren-forward-nested () + "Should jump forward over nested parens." + ;; Text: "(foo (bar))" + ;; Start at position 1 (on outer opening paren) + ;; Should end at position 12 (after outer closing paren) + (should (= 12 (test-jump-to-matching-paren "(foo (bar))" 1)))) + +(ert-deftest test-jump-paren-forward-inner-nested () + "Should jump forward from inner opening paren." + ;; Text: "(foo (bar))" + ;; Start at position 6 (on inner opening paren) + ;; Should end at position 11 (after inner closing paren) + (should (= 11 (test-jump-to-matching-paren "(foo (bar))" 6)))) + +(ert-deftest test-jump-bracket-forward () + "Should jump forward from opening bracket." + ;; Text: "[1 2 3]" + ;; Start at position 1 + ;; Should end at position 8 + (should (= 8 (test-jump-to-matching-paren "[1 2 3]" 1)))) + +;; Note: Braces are not treated as matching delimiters in emacs-lisp-mode +;; so we don't test them here + +;;; Normal Cases - Backward Jump (Closing to Opening) + +(ert-deftest test-jump-paren-backward-simple () + "Should jump backward from closing paren to opening paren." + ;; Text: "(hello)" + ;; Start at position 7 (on closing paren) + ;; Should end at position 2 (after opening paren) + (should (= 2 (test-jump-to-matching-paren "(hello)" 7)))) + +(ert-deftest test-jump-paren-backward-nested () + "Should jump backward over nested parens from after outer closing." + ;; Text: "(foo (bar))" + ;; Start at position 12 (after outer closing paren) + ;; backward-sexp goes back to before opening paren + (should (= 1 (test-jump-to-matching-paren "(foo (bar))" 12)))) + +(ert-deftest test-jump-paren-backward-inner-nested () + "Should jump backward from inner closing paren." + ;; Text: "(foo (bar))" + ;; Start at position 10 (on inner closing paren) + ;; Should end at position 7 (after inner opening paren) + (should (= 7 (test-jump-to-matching-paren "(foo (bar))" 10)))) + +(ert-deftest test-jump-bracket-backward () + "Should jump backward from after closing bracket." + ;; Text: "[1 2 3]" + ;; Start at position 8 (after ]) + ;; backward-sexp goes back one sexp + (should (= 1 (test-jump-to-matching-paren "[1 2 3]" 8)))) + +;;; Normal Cases - Jump from After Closing Delimiter + +(ert-deftest test-jump-paren-after-closing () + "Should jump backward when just after closing paren." + ;; Text: "(hello)" + ;; Start at position 8 (after closing paren) + ;; backward-sexp goes back one sexp, ending before the opening paren + (should (= 1 (test-jump-to-matching-paren "(hello)" 8)))) + +;;; Boundary Cases - No Movement + +(ert-deftest test-jump-paren-not-on-delimiter () + "Should not move when not on delimiter." + ;; Text: "(hello world)" + ;; Start at position 3 (on 'e' in hello) + ;; Should stay at position 3 + (should (= 3 (test-jump-to-matching-paren "(hello world)" 3)))) + +(ert-deftest test-jump-paren-on-whitespace () + "Should not move when on whitespace." + ;; Text: "(hello world)" + ;; Start at position 7 (on space) + ;; Should stay at position 7 + (should (= 7 (test-jump-to-matching-paren "(hello world)" 7)))) + +;;; Boundary Cases - Unmatched Delimiters + +(ert-deftest test-jump-paren-unmatched-opening () + "Should not move from unmatched opening paren." + ;; Text: "(hello" + ;; Start at position 1 (on opening paren with no closing) + ;; Should stay at position 1 + (should (= 1 (test-jump-to-matching-paren "(hello" 1)))) + +(ert-deftest test-jump-paren-unmatched-closing () + "Should move to beginning from unmatched closing paren." + ;; Text: "hello)" + ;; Start at position 6 (on closing paren with no opening) + ;; backward-sexp with unmatched closing paren goes to beginning + (should (= 1 (test-jump-to-matching-paren "hello)" 6)))) + +;;; Boundary Cases - Empty Delimiters + +(ert-deftest test-jump-paren-empty () + "Should jump over empty parens." + ;; Text: "()" + ;; Start at position 1 + ;; Should end at position 3 + (should (= 3 (test-jump-to-matching-paren "()" 1)))) + +(ert-deftest test-jump-paren-empty-backward () + "Should stay put when on closing paren of empty parens." + ;; Text: "()" + ;; Start at position 2 (on closing paren) + ;; backward-sexp from closing of empty parens gives an error, so stays at 2 + (should (= 2 (test-jump-to-matching-paren "()" 2)))) + +;;; Boundary Cases - Multiple Delimiter Types + +(ert-deftest test-jump-paren-mixed-delimiters () + "Should jump over mixed delimiter types." + ;; Text: "(foo [bar {baz}])" + ;; Start at position 1 (on opening paren) + ;; Should end at position 18 (after closing paren) + (should (= 18 (test-jump-to-matching-paren "(foo [bar {baz}])" 1)))) + +(ert-deftest test-jump-bracket-in-parens () + "Should jump from bracket inside parens." + ;; Text: "(foo [bar])" + ;; Start at position 6 (on opening bracket) + ;; Should end at position 11 (after closing bracket) + (should (= 11 (test-jump-to-matching-paren "(foo [bar])" 6)))) + +;;; Complex Cases - Strings and Comments + +(ert-deftest test-jump-paren-over-string () + "Should jump over parens containing strings." + ;; Text: "(\"hello (world)\")" + ;; Start at position 1 (on opening paren) + ;; Should end at position 18 (after closing paren) + ;; The parens in the string should be ignored + (should (= 18 (test-jump-to-matching-paren "(\"hello (world)\")" 1)))) + +(provide 'test-custom-misc-jump-to-matching-paren) +;;; test-custom-misc-jump-to-matching-paren.el ends here diff --git a/tests/test-custom-misc-replace-fraction-glyphs.el b/tests/test-custom-misc-replace-fraction-glyphs.el new file mode 100644 index 00000000..81d1546e --- /dev/null +++ b/tests/test-custom-misc-replace-fraction-glyphs.el @@ -0,0 +1,185 @@ +;;; test-custom-misc-replace-fraction-glyphs.el --- Tests for cj/--replace-fraction-glyphs -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--replace-fraction-glyphs function from custom-misc.el +;; +;; This function bidirectionally converts between text fractions (1/4) and +;; Unicode fraction glyphs (¼). It supports 5 common fractions: +;; - 1/4 ↔ ¼ +;; - 1/2 ↔ ½ +;; - 3/4 ↔ ¾ +;; - 1/3 ↔ ⅓ +;; - 2/3 ↔ ⅔ +;; +;; We test the NON-INTERACTIVE implementation (cj/--replace-fraction-glyphs) +;; to avoid mocking prefix arguments. This follows our testing best practice +;; of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-misc) + +;;; Test Helpers + +(defun test-replace-fraction-glyphs (input-text to-glyphs) + "Test cj/--replace-fraction-glyphs on INPUT-TEXT. +TO-GLYPHS determines conversion direction. +Returns the buffer string after operation." + (with-temp-buffer + (insert input-text) + (cj/--replace-fraction-glyphs (point-min) (point-max) to-glyphs) + (buffer-string))) + +;;; Normal Cases - Text to Glyphs + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-quarter () + "Should convert 1/4 to ¼." + (let ((result (test-replace-fraction-glyphs "1/4" t))) + (should (string= result "¼")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-half () + "Should convert 1/2 to ½." + (let ((result (test-replace-fraction-glyphs "1/2" t))) + (should (string= result "½")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-three-quarters () + "Should convert 3/4 to ¾." + (let ((result (test-replace-fraction-glyphs "3/4" t))) + (should (string= result "¾")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-third () + "Should convert 1/3 to ⅓." + (let ((result (test-replace-fraction-glyphs "1/3" t))) + (should (string= result "⅓")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-two-thirds () + "Should convert 2/3 to ⅔." + (let ((result (test-replace-fraction-glyphs "2/3" t))) + (should (string= result "⅔")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-multiple () + "Should convert multiple fractions in text." + (let ((result (test-replace-fraction-glyphs "Use 1/4 cup and 1/2 teaspoon" t))) + (should (string= result "Use ¼ cup and ½ teaspoon")))) + +(ert-deftest test-replace-fraction-glyphs-text-to-glyph-all-types () + "Should convert all fraction types." + (let ((result (test-replace-fraction-glyphs "1/4 1/2 3/4 1/3 2/3" t))) + (should (string= result "¼ ½ ¾ ⅓ ⅔")))) + +;;; Normal Cases - Glyphs to Text + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-quarter () + "Should convert ¼ to 1/4." + (let ((result (test-replace-fraction-glyphs "¼" nil))) + (should (string= result "1/4")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-half () + "Should convert ½ to 1/2." + (let ((result (test-replace-fraction-glyphs "½" nil))) + (should (string= result "1/2")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-three-quarters () + "Should convert ¾ to 3/4." + (let ((result (test-replace-fraction-glyphs "¾" nil))) + (should (string= result "3/4")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-third () + "Should convert ⅓ to 1/3." + (let ((result (test-replace-fraction-glyphs "⅓" nil))) + (should (string= result "1/3")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-two-thirds () + "Should convert ⅔ to 2/3." + (let ((result (test-replace-fraction-glyphs "⅔" nil))) + (should (string= result "2/3")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-multiple () + "Should convert multiple glyphs in text." + (let ((result (test-replace-fraction-glyphs "Use ¼ cup and ½ teaspoon" nil))) + (should (string= result "Use 1/4 cup and 1/2 teaspoon")))) + +(ert-deftest test-replace-fraction-glyphs-glyph-to-text-all-types () + "Should convert all glyph types." + (let ((result (test-replace-fraction-glyphs "¼ ½ ¾ ⅓ ⅔" nil))) + (should (string= result "1/4 1/2 3/4 1/3 2/3")))) + +;;; Boundary Cases + +(ert-deftest test-replace-fraction-glyphs-empty-string () + "Should handle empty string." + (let ((result (test-replace-fraction-glyphs "" t))) + (should (string= result "")))) + +(ert-deftest test-replace-fraction-glyphs-no-fractions-to-glyphs () + "Should handle text with no fractions (no-op) when converting to glyphs." + (let ((result (test-replace-fraction-glyphs "hello world" t))) + (should (string= result "hello world")))) + +(ert-deftest test-replace-fraction-glyphs-no-fractions-to-text () + "Should handle text with no glyphs (no-op) when converting to text." + (let ((result (test-replace-fraction-glyphs "hello world" nil))) + (should (string= result "hello world")))) + +(ert-deftest test-replace-fraction-glyphs-at-start () + "Should handle fraction at start of text." + (let ((result (test-replace-fraction-glyphs "1/2 of the total" t))) + (should (string= result "½ of the total")))) + +(ert-deftest test-replace-fraction-glyphs-at-end () + "Should handle fraction at end of text." + (let ((result (test-replace-fraction-glyphs "Reduce by 1/4" t))) + (should (string= result "Reduce by ¼")))) + +(ert-deftest test-replace-fraction-glyphs-repeated () + "Should handle repeated fractions." + (let ((result (test-replace-fraction-glyphs "1/4 and 1/4 and 1/4" t))) + (should (string= result "¼ and ¼ and ¼")))) + +(ert-deftest test-replace-fraction-glyphs-very-long-text () + "Should handle very long text with many fractions." + (let* ((long-text (mapconcat (lambda (_) "1/4") (make-list 50 nil) " ")) + (result (test-replace-fraction-glyphs long-text t))) + (should (string-match-p "¼" result)) + (should-not (string-match-p "1/4" result)))) + +(ert-deftest test-replace-fraction-glyphs-bidirectional () + "Should correctly convert back and forth." + (let* ((original "Use 1/4 cup") + (to-glyph (test-replace-fraction-glyphs original t)) + (back-to-text (test-replace-fraction-glyphs to-glyph nil))) + (should (string= to-glyph "Use ¼ cup")) + (should (string= back-to-text original)))) + +;;; Error Cases + +(ert-deftest test-replace-fraction-glyphs-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "1/4") + (cj/--replace-fraction-glyphs (point-max) (point-min) t)) + :type 'error)) + +(ert-deftest test-replace-fraction-glyphs-empty-region () + "Should handle empty region (start == end) without error." + (with-temp-buffer + (insert "1/4") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (cj/--replace-fraction-glyphs pos pos t) + ;; Should complete without error + (should (string= (buffer-string) "1/4"))))) + +(provide 'test-custom-misc-replace-fraction-glyphs) +;;; test-custom-misc-replace-fraction-glyphs.el ends here diff --git a/tests/test-custom-ordering-alphabetize.el b/tests/test-custom-ordering-alphabetize.el new file mode 100644 index 00000000..c609e324 --- /dev/null +++ b/tests/test-custom-ordering-alphabetize.el @@ -0,0 +1,176 @@ +;;; test-custom-ordering-alphabetize.el --- Tests for cj/--alphabetize-region -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--alphabetize-region function from custom-ordering.el +;; +;; This function alphabetically sorts words in a region. +;; It splits by whitespace and commas, sorts alphabetically, and joins with ", ". +;; +;; Examples: +;; Input: "zebra apple banana" +;; Output: "apple, banana, zebra" +;; +;; Input: "dog, cat, bird" +;; Output: "bird, cat, dog" +;; +;; We test the NON-INTERACTIVE implementation (cj/--alphabetize-region) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-alphabetize (input-text) + "Test cj/--alphabetize-region on INPUT-TEXT. +Returns the sorted, comma-separated string." + (with-temp-buffer + (insert input-text) + (cj/--alphabetize-region (point-min) (point-max)))) + +;;; Normal Cases - Simple Words + +(ert-deftest test-alphabetize-simple-words () + "Should alphabetize simple words." + (let ((result (test-alphabetize "zebra apple banana"))) + (should (string= result "apple, banana, zebra")))) + +(ert-deftest test-alphabetize-already-sorted () + "Should handle already sorted words." + (let ((result (test-alphabetize "apple banana cherry"))) + (should (string= result "apple, banana, cherry")))) + +(ert-deftest test-alphabetize-reverse-order () + "Should alphabetize reverse-ordered words." + (let ((result (test-alphabetize "zebra yankee xray"))) + (should (string= result "xray, yankee, zebra")))) + +(ert-deftest test-alphabetize-two-words () + "Should alphabetize two words." + (let ((result (test-alphabetize "world hello"))) + (should (string= result "hello, world")))) + +;;; Normal Cases - With Commas + +(ert-deftest test-alphabetize-comma-separated () + "Should alphabetize comma-separated words." + (let ((result (test-alphabetize "dog, cat, bird"))) + (should (string= result "bird, cat, dog")))) + +(ert-deftest test-alphabetize-comma-separated-with-spaces () + "Should handle comma-separated with various spacing." + (let ((result (test-alphabetize "dog,cat,bird"))) + (should (string= result "bird, cat, dog")))) + +;;; Normal Cases - With Newlines + +(ert-deftest test-alphabetize-multiline () + "Should alphabetize words across multiple lines." + (let ((result (test-alphabetize "zebra\napple\nbanana"))) + (should (string= result "apple, banana, zebra")))) + +(ert-deftest test-alphabetize-mixed-separators () + "Should alphabetize with mixed separators (spaces, commas, newlines)." + (let ((result (test-alphabetize "zebra, apple\nbanana cherry"))) + (should (string= result "apple, banana, cherry, zebra")))) + +;;; Normal Cases - Case Sensitivity + +(ert-deftest test-alphabetize-case-sensitive () + "Should sort case-sensitively (uppercase before lowercase)." + (let ((result (test-alphabetize "zebra Apple banana"))) + ;; string-lessp sorts uppercase before lowercase + (should (string= result "Apple, banana, zebra")))) + +(ert-deftest test-alphabetize-mixed-case () + "Should handle mixed case words." + (let ((result (test-alphabetize "ZEBRA apple BANANA"))) + (should (string= result "BANANA, ZEBRA, apple")))) + +;;; Normal Cases - Numbers and Special Characters + +(ert-deftest test-alphabetize-with-numbers () + "Should alphabetize numbers as strings." + (let ((result (test-alphabetize "10 2 1 20"))) + ;; Alphabetic sort: "1", "10", "2", "20" + (should (string= result "1, 10, 2, 20")))) + +(ert-deftest test-alphabetize-mixed-alphanumeric () + "Should alphabetize mixed alphanumeric content." + (let ((result (test-alphabetize "item2 item1 item10"))) + (should (string= result "item1, item10, item2")))) + +(ert-deftest test-alphabetize-with-punctuation () + "Should alphabetize words with punctuation." + (let ((result (test-alphabetize "world! hello? test."))) + (should (string= result "hello?, test., world!")))) + +;;; Boundary Cases + +(ert-deftest test-alphabetize-empty-string () + "Should handle empty string." + (let ((result (test-alphabetize ""))) + (should (string= result "")))) + +(ert-deftest test-alphabetize-single-word () + "Should handle single word." + (let ((result (test-alphabetize "hello"))) + (should (string= result "hello")))) + +(ert-deftest test-alphabetize-only-whitespace () + "Should handle whitespace-only text." + (let ((result (test-alphabetize " \n\n\t\t "))) + (should (string= result "")))) + +(ert-deftest test-alphabetize-duplicates () + "Should handle duplicate words." + (let ((result (test-alphabetize "apple banana apple cherry"))) + (should (string= result "apple, apple, banana, cherry")))) + +(ert-deftest test-alphabetize-many-commas () + "Should handle multiple consecutive commas." + (let ((result (test-alphabetize "apple,,,banana,,,cherry"))) + (should (string= result "apple, banana, cherry")))) + +(ert-deftest test-alphabetize-very-long-list () + "Should handle very long list." + (let* ((words (mapcar (lambda (i) (format "word%03d" i)) (number-sequence 100 1 -1))) + (input (mapconcat #'identity words " ")) + (result (test-alphabetize input)) + (sorted-words (split-string result ", "))) + (should (= 100 (length sorted-words))) + (should (string= "word001" (car sorted-words))) + (should (string= "word100" (car (last sorted-words)))))) + +;;; Error Cases + +(ert-deftest test-alphabetize-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--alphabetize-region (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-alphabetize-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--alphabetize-region pos pos)))))) + +(provide 'test-custom-ordering-alphabetize) +;;; test-custom-ordering-alphabetize.el ends here diff --git a/tests/test-custom-ordering-arrayify.el b/tests/test-custom-ordering-arrayify.el new file mode 100644 index 00000000..9aedbc46 --- /dev/null +++ b/tests/test-custom-ordering-arrayify.el @@ -0,0 +1,215 @@ +;;; test-custom-ordering-arrayify.el --- Tests for cj/--arrayify -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--arrayify function from custom-ordering.el +;; +;; This function converts lines of text into a quoted, comma-separated array format. +;; It splits input by whitespace, wraps each element in quotes, and joins with ", ". +;; +;; Examples: +;; Input: "apple\nbanana\ncherry" +;; Output: "\"apple\", \"banana\", \"cherry\"" +;; +;; Input: "one two three" (with single quotes) +;; Output: "'one', 'two', 'three'" +;; +;; We test the NON-INTERACTIVE implementation (cj/--arrayify) to avoid +;; mocking user input for quote characters. This follows our testing best +;; practice of separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-arrayify (input-text quote) + "Test cj/--arrayify on INPUT-TEXT with QUOTE character. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--arrayify (point-min) (point-max) quote))) + +(defun test-arrayify-with-prefix-suffix (input-text quote prefix suffix) + "Test cj/--arrayify with PREFIX and SUFFIX on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--arrayify (point-min) (point-max) quote prefix suffix))) + +;;; Normal Cases - Double Quotes + +(ert-deftest test-arrayify-single-line-double-quotes () + "Should arrayify single line with double quotes." + (let ((result (test-arrayify "apple banana cherry" "\""))) + (should (string= result "\"apple\", \"banana\", \"cherry\"")))) + +(ert-deftest test-arrayify-multiple-lines-double-quotes () + "Should arrayify multiple lines with double quotes." + (let ((result (test-arrayify "apple\nbanana\ncherry" "\""))) + (should (string= result "\"apple\", \"banana\", \"cherry\"")))) + +(ert-deftest test-arrayify-mixed-whitespace-double-quotes () + "Should arrayify text with mixed whitespace using double quotes." + (let ((result (test-arrayify "apple \n\n banana\t\tcherry" "\""))) + (should (string= result "\"apple\", \"banana\", \"cherry\"")))) + +;;; Normal Cases - Single Quotes + +(ert-deftest test-arrayify-single-line-single-quotes () + "Should arrayify single line with single quotes." + (let ((result (test-arrayify "one two three" "'"))) + (should (string= result "'one', 'two', 'three'")))) + +(ert-deftest test-arrayify-multiple-lines-single-quotes () + "Should arrayify multiple lines with single quotes." + (let ((result (test-arrayify "one\ntwo\nthree" "'"))) + (should (string= result "'one', 'two', 'three'")))) + +;;; Normal Cases - Various Quote Types + +(ert-deftest test-arrayify-backticks () + "Should arrayify with backticks." + (let ((result (test-arrayify "foo bar baz" "`"))) + (should (string= result "`foo`, `bar`, `baz`")))) + +(ert-deftest test-arrayify-no-quotes () + "Should arrayify with empty quote string." + (let ((result (test-arrayify "alpha beta gamma" ""))) + (should (string= result "alpha, beta, gamma")))) + +(ert-deftest test-arrayify-square-brackets () + "Should arrayify with square brackets as quotes." + (let ((result (test-arrayify "x y z" "[]"))) + (should (string= result "[]x[], []y[], []z[]")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-arrayify-with-numbers () + "Should arrayify numbers." + (let ((result (test-arrayify "1 2 3 4 5" "\""))) + (should (string= result "\"1\", \"2\", \"3\", \"4\", \"5\"")))) + +(ert-deftest test-arrayify-with-punctuation () + "Should arrayify words with punctuation." + (let ((result (test-arrayify "hello! world? test." "\""))) + (should (string= result "\"hello!\", \"world?\", \"test.\"")))) + +(ert-deftest test-arrayify-mixed-content () + "Should arrayify mixed alphanumeric content." + (let ((result (test-arrayify "item1 item2 item3" "\""))) + (should (string= result "\"item1\", \"item2\", \"item3\"")))) + +;;; Boundary Cases + +(ert-deftest test-arrayify-empty-string () + "Should handle empty string." + (let ((result (test-arrayify "" "\""))) + (should (string= result "")))) + +(ert-deftest test-arrayify-single-word () + "Should arrayify single word." + (let ((result (test-arrayify "hello" "\""))) + (should (string= result "\"hello\"")))) + +(ert-deftest test-arrayify-only-whitespace () + "Should handle whitespace-only text." + (let ((result (test-arrayify " \n\n\t\t " "\""))) + (should (string= result "")))) + +(ert-deftest test-arrayify-leading-trailing-whitespace () + "Should ignore leading and trailing whitespace." + (let ((result (test-arrayify " apple banana " "\""))) + (should (string= result "\"apple\", \"banana\"")))) + +(ert-deftest test-arrayify-very-long-list () + "Should handle very long list." + (let* ((words (make-list 100 "word")) + (input (mapconcat #'identity words " ")) + (result (test-arrayify input "\""))) + (should (= 100 (length (split-string result ", ")))))) + +(ert-deftest test-arrayify-two-words () + "Should arrayify two words." + (let ((result (test-arrayify "hello world" "\""))) + (should (string= result "\"hello\", \"world\"")))) + +;;; Normal Cases - Prefix/Suffix + +(ert-deftest test-arrayify-with-square-brackets () + "Should arrayify with square brackets prefix/suffix." + (let ((result (test-arrayify-with-prefix-suffix "apple banana cherry" "\"" "[" "]"))) + (should (string= result "[\"apple\", \"banana\", \"cherry\"]")))) + +(ert-deftest test-arrayify-with-parens () + "Should arrayify with parentheses prefix/suffix." + (let ((result (test-arrayify-with-prefix-suffix "one two three" "\"" "(" ")"))) + (should (string= result "(\"one\", \"two\", \"three\")")))) + +(ert-deftest test-arrayify-unquoted-with-brackets () + "Should create unquoted list with brackets." + (let ((result (test-arrayify-with-prefix-suffix "a b c" "" "[" "]"))) + (should (string= result "[a, b, c]")))) + +(ert-deftest test-arrayify-single-quotes-with-brackets () + "Should create single-quoted array with brackets." + (let ((result (test-arrayify-with-prefix-suffix "x y z" "'" "[" "]"))) + (should (string= result "['x', 'y', 'z']")))) + +(ert-deftest test-arrayify-only-prefix () + "Should handle only prefix, no suffix." + (let ((result (test-arrayify-with-prefix-suffix "foo bar" "\"" "[" nil))) + (should (string= result "[\"foo\", \"bar\"")))) + +(ert-deftest test-arrayify-only-suffix () + "Should handle only suffix, no prefix." + (let ((result (test-arrayify-with-prefix-suffix "foo bar" "\"" nil "]"))) + (should (string= result "\"foo\", \"bar\"]")))) + +(ert-deftest test-arrayify-multichar-prefix-suffix () + "Should handle multi-character prefix/suffix." + (let ((result (test-arrayify-with-prefix-suffix "a b" "\"" "Array(" ")"))) + (should (string= result "Array(\"a\", \"b\")")))) + +(ert-deftest test-arrayify-json-style () + "Should create JSON-style array." + (let ((result (test-arrayify-with-prefix-suffix "apple banana" "\"" "[" "]"))) + (should (string= result "[\"apple\", \"banana\"]")))) + +;;; Error Cases + +(ert-deftest test-arrayify-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "hello world") + (cj/--arrayify (point-max) (point-min) "\"")) + :type 'error)) + +(ert-deftest test-arrayify-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--arrayify pos pos "\"")))))) + +(ert-deftest test-arrayify-empty-region-with-brackets () + "Should handle empty region with brackets." + (with-temp-buffer + (insert "hello world") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "[]" (cj/--arrayify pos pos "\"" "[" "]")))))) + +(provide 'test-custom-ordering-arrayify) +;;; test-custom-ordering-arrayify.el ends here diff --git a/tests/test-custom-ordering-comma-to-lines.el b/tests/test-custom-ordering-comma-to-lines.el new file mode 100644 index 00000000..93e37ec6 --- /dev/null +++ b/tests/test-custom-ordering-comma-to-lines.el @@ -0,0 +1,159 @@ +;;; test-custom-ordering-comma-to-lines.el --- Tests for cj/--comma-separated-text-to-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--comma-separated-text-to-lines function from custom-ordering.el +;; +;; This function converts comma-separated text to separate lines. +;; It replaces commas with newlines and removes trailing whitespace from each line. +;; +;; Examples: +;; Input: "apple, banana, cherry" +;; Output: "apple\nbanana\ncherry" +;; +;; Input: "one,two,three" +;; Output: "one\ntwo\nthree" +;; +;; We test the NON-INTERACTIVE implementation (cj/--comma-separated-text-to-lines) +;; to avoid mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-comma-to-lines (input-text) + "Test cj/--comma-separated-text-to-lines on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--comma-separated-text-to-lines (point-min) (point-max)))) + +;;; Normal Cases - Simple Comma-Separated + +(ert-deftest test-comma-to-lines-simple () + "Should convert simple comma-separated text to lines." + (let ((result (test-comma-to-lines "apple, banana, cherry"))) + (should (string= result "apple\n banana\n cherry")))) + +(ert-deftest test-comma-to-lines-no-spaces () + "Should convert comma-separated text without spaces." + (let ((result (test-comma-to-lines "one,two,three"))) + (should (string= result "one\ntwo\nthree")))) + +(ert-deftest test-comma-to-lines-two-elements () + "Should convert two comma-separated elements." + (let ((result (test-comma-to-lines "hello,world"))) + (should (string= result "hello\nworld")))) + +(ert-deftest test-comma-to-lines-with-varied-spacing () + "Should preserve leading spaces after commas." + (let ((result (test-comma-to-lines "alpha, beta, gamma"))) + (should (string= result "alpha\n beta\n gamma")))) + +;;; Normal Cases - Trailing Whitespace + +(ert-deftest test-comma-to-lines-trailing-spaces () + "Should remove trailing spaces but preserve leading spaces." + (let ((result (test-comma-to-lines "apple , banana , cherry "))) + (should (string= result "apple\n banana\n cherry")))) + +(ert-deftest test-comma-to-lines-trailing-tabs () + "Should remove trailing tabs after conversion." + (let ((result (test-comma-to-lines "apple\t,banana\t,cherry\t"))) + (should (string= result "apple\nbanana\ncherry")))) + +;;; Boundary Cases + +(ert-deftest test-comma-to-lines-empty-string () + "Should handle empty string." + (let ((result (test-comma-to-lines ""))) + (should (string= result "")))) + +(ert-deftest test-comma-to-lines-single-element () + "Should handle single element with no comma." + (let ((result (test-comma-to-lines "hello"))) + (should (string= result "hello")))) + +(ert-deftest test-comma-to-lines-single-element-with-trailing-comma () + "Should handle single element with trailing comma." + (let ((result (test-comma-to-lines "hello,"))) + (should (string= result "hello\n")))) + +(ert-deftest test-comma-to-lines-leading-comma () + "Should handle leading comma." + (let ((result (test-comma-to-lines ",apple,banana"))) + (should (string= result "\napple\nbanana")))) + +(ert-deftest test-comma-to-lines-consecutive-commas () + "Should handle consecutive commas." + (let ((result (test-comma-to-lines "apple,,banana"))) + (should (string= result "apple\n\nbanana")))) + +(ert-deftest test-comma-to-lines-many-consecutive-commas () + "Should handle many consecutive commas." + (let ((result (test-comma-to-lines "apple,,,banana"))) + (should (string= result "apple\n\n\nbanana")))) + +(ert-deftest test-comma-to-lines-only-commas () + "Should handle string with only commas (trailing blank lines removed)." + (let ((result (test-comma-to-lines ",,,"))) + ;; delete-trailing-whitespace removes trailing blank lines + (should (string= result "\n")))) + +;;; Normal Cases - With Spaces Around Elements + +(ert-deftest test-comma-to-lines-leading-spaces () + "Should preserve leading spaces within elements." + (let ((result (test-comma-to-lines " apple, banana, cherry"))) + (should (string= result " apple\n banana\n cherry")))) + +(ert-deftest test-comma-to-lines-mixed-content () + "Should handle mixed alphanumeric content." + (let ((result (test-comma-to-lines "item1,item2,item3"))) + (should (string= result "item1\nitem2\nitem3")))) + +(ert-deftest test-comma-to-lines-with-numbers () + "Should handle numbers." + (let ((result (test-comma-to-lines "1,2,3,4,5"))) + (should (string= result "1\n2\n3\n4\n5")))) + +(ert-deftest test-comma-to-lines-very-long-list () + "Should handle very long list." + (let* ((elements (mapcar #'number-to-string (number-sequence 1 100))) + (input (mapconcat #'identity elements ",")) + (result (test-comma-to-lines input)) + (lines (split-string result "\n"))) + (should (= 100 (length lines))))) + +;;; Error Cases + +(ert-deftest test-comma-to-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "a,b,c") + (cj/--comma-separated-text-to-lines (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-comma-to-lines-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "a,b,c") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--comma-separated-text-to-lines pos pos)))))) + +(provide 'test-custom-ordering-comma-to-lines) +;;; test-custom-ordering-comma-to-lines.el ends here diff --git a/tests/test-custom-ordering-number-lines.el b/tests/test-custom-ordering-number-lines.el new file mode 100644 index 00000000..adda84f0 --- /dev/null +++ b/tests/test-custom-ordering-number-lines.el @@ -0,0 +1,181 @@ +;;; test-custom-ordering-number-lines.el --- Tests for cj/--number-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--number-lines function from custom-ordering.el +;; +;; This function numbers lines in a region with a customizable format. +;; The format string uses "N" as a placeholder for the line number. +;; Optionally supports zero-padding for alignment. +;; +;; Examples: +;; Input: "apple\nbanana\ncherry" +;; Format: "N. " +;; Output: "1. apple\n2. banana\n3. cherry" +;; +;; With zero-padding and 100 lines: +;; "001. line\n002. line\n...\n100. line" +;; +;; We test the NON-INTERACTIVE implementation (cj/--number-lines) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) +(require 'cl-lib) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-number-lines (input-text format-string zero-pad) + "Test cj/--number-lines on INPUT-TEXT. +FORMAT-STRING is the format template. +ZERO-PAD enables zero-padding. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--number-lines (point-min) (point-max) format-string zero-pad))) + +;;; Normal Cases - Standard Format "N. " + +(ert-deftest test-number-lines-standard-format () + "Should number lines with standard format." + (let ((result (test-number-lines "apple\nbanana\ncherry" "N. " nil))) + (should (string= result "1. apple\n2. banana\n3. cherry")))) + +(ert-deftest test-number-lines-two-lines () + "Should number two lines." + (let ((result (test-number-lines "first\nsecond" "N. " nil))) + (should (string= result "1. first\n2. second")))) + +(ert-deftest test-number-lines-single-line () + "Should number single line." + (let ((result (test-number-lines "only" "N. " nil))) + (should (string= result "1. only")))) + +;;; Normal Cases - Alternative Formats + +(ert-deftest test-number-lines-parenthesis-format () + "Should number with parenthesis format." + (let ((result (test-number-lines "a\nb\nc" "N) " nil))) + (should (string= result "1) a\n2) b\n3) c")))) + +(ert-deftest test-number-lines-bracket-format () + "Should number with bracket format." + (let ((result (test-number-lines "x\ny\nz" "[N] " nil))) + (should (string= result "[1] x\n[2] y\n[3] z")))) + +(ert-deftest test-number-lines-no-space-format () + "Should number without space." + (let ((result (test-number-lines "a\nb" "N." nil))) + (should (string= result "1.a\n2.b")))) + +(ert-deftest test-number-lines-custom-format () + "Should number with custom format." + (let ((result (test-number-lines "foo\nbar" "Item N: " nil))) + (should (string= result "Item 1: foo\nItem 2: bar")))) + +;;; Normal Cases - Zero Padding + +(ert-deftest test-number-lines-zero-pad-single-digit () + "Should not pad when max is single digit." + (let ((result (test-number-lines "a\nb\nc" "N. " t))) + (should (string= result "1. a\n2. b\n3. c")))) + +(ert-deftest test-number-lines-zero-pad-double-digit () + "Should pad to 2 digits when max is 10-99." + (let* ((lines (make-list 12 "line")) + (input (mapconcat #'identity lines "\n")) + (result (test-number-lines input "N. " t)) + (result-lines (split-string result "\n"))) + (should (string-prefix-p "01. " (nth 0 result-lines))) + (should (string-prefix-p "09. " (nth 8 result-lines))) + (should (string-prefix-p "10. " (nth 9 result-lines))) + (should (string-prefix-p "12. " (nth 11 result-lines))))) + +(ert-deftest test-number-lines-zero-pad-triple-digit () + "Should pad to 3 digits when max is 100+." + (let* ((lines (make-list 105 "x")) + (input (mapconcat #'identity lines "\n")) + (result (test-number-lines input "N. " t)) + (result-lines (split-string result "\n"))) + (should (string-prefix-p "001. " (nth 0 result-lines))) + (should (string-prefix-p "099. " (nth 98 result-lines))) + (should (string-prefix-p "100. " (nth 99 result-lines))) + (should (string-prefix-p "105. " (nth 104 result-lines))))) + +;;; Boundary Cases + +(ert-deftest test-number-lines-empty-string () + "Should handle empty string." + (let ((result (test-number-lines "" "N. " nil))) + (should (string= result "1. ")))) + +(ert-deftest test-number-lines-empty-lines () + "Should number empty lines." + (let ((result (test-number-lines "\n\n" "N. " nil))) + (should (string= result "1. \n2. \n3. ")))) + +(ert-deftest test-number-lines-with-existing-numbers () + "Should number lines that already have content." + (let ((result (test-number-lines "1. old\n2. old" "N. " nil))) + (should (string= result "1. 1. old\n2. 2. old")))) + +(ert-deftest test-number-lines-multiple-N-in-format () + "Should replace multiple N occurrences." + (let ((result (test-number-lines "a\nb" "N-N. " nil))) + (should (string= result "1-1. a\n2-2. b")))) + +(ert-deftest test-number-lines-long-content () + "Should number lines with long content." + (let* ((long-line (make-string 100 ?x)) + (input (format "%s\n%s" long-line long-line)) + (result (test-number-lines input "N. " nil))) + (should (string-prefix-p "1. " result)) + (should (string-match "2\\. " result)))) + +;;; Normal Cases - No Zero Padding vs Zero Padding + +(ert-deftest test-number-lines-comparison-no-pad-vs-pad () + "Should show difference between no padding and padding." + (let* ((input "a\nb\nc\nd\ne\nf\ng\nh\ni\nj") + (no-pad (test-number-lines input "N. " nil)) + (with-pad (test-number-lines input "N. " t)) + (no-pad-lines (split-string no-pad "\n")) + (with-pad-lines (split-string with-pad "\n"))) + ;; Without padding: "1. ", "10. " + (should (string-prefix-p "1. " (nth 0 no-pad-lines))) + (should (string-prefix-p "10. " (nth 9 no-pad-lines))) + ;; With padding: "01. ", "10. " + (should (string-prefix-p "01. " (nth 0 with-pad-lines))) + (should (string-prefix-p "10. " (nth 9 with-pad-lines))))) + +;;; Error Cases + +(ert-deftest test-number-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "line1\nline2") + (cj/--number-lines (point-max) (point-min) "N. " nil)) + :type 'error)) + +(ert-deftest test-number-lines-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "line1\nline2") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "1. " (cj/--number-lines pos pos "N. " nil)))))) + +(provide 'test-custom-ordering-number-lines) +;;; test-custom-ordering-number-lines.el ends here diff --git a/tests/test-custom-ordering-reverse-lines.el b/tests/test-custom-ordering-reverse-lines.el new file mode 100644 index 00000000..3c71362d --- /dev/null +++ b/tests/test-custom-ordering-reverse-lines.el @@ -0,0 +1,131 @@ +;;; test-custom-ordering-reverse-lines.el --- Tests for cj/--reverse-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--reverse-lines function from custom-ordering.el +;; +;; This function reverses the order of lines in a region. +;; The first line becomes last, last becomes first, etc. +;; +;; Examples: +;; Input: "line1\nline2\nline3" +;; Output: "line3\nline2\nline1" +;; +;; We test the NON-INTERACTIVE implementation (cj/--reverse-lines) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-reverse-lines (input-text) + "Test cj/--reverse-lines on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--reverse-lines (point-min) (point-max)))) + +;;; Normal Cases + +(ert-deftest test-reverse-lines-three-lines () + "Should reverse three lines." + (let ((result (test-reverse-lines "line1\nline2\nline3"))) + (should (string= result "line3\nline2\nline1")))) + +(ert-deftest test-reverse-lines-two-lines () + "Should reverse two lines." + (let ((result (test-reverse-lines "first\nsecond"))) + (should (string= result "second\nfirst")))) + +(ert-deftest test-reverse-lines-many-lines () + "Should reverse many lines." + (let ((result (test-reverse-lines "a\nb\nc\nd\ne"))) + (should (string= result "e\nd\nc\nb\na")))) + +(ert-deftest test-reverse-lines-with-content () + "Should reverse lines with actual content." + (let ((result (test-reverse-lines "apple banana\ncherry date\negg fig"))) + (should (string= result "egg fig\ncherry date\napple banana")))) + +(ert-deftest test-reverse-lines-bidirectional () + "Should reverse back and forth correctly." + (let* ((original "line1\nline2\nline3") + (reversed (test-reverse-lines original)) + (back (test-reverse-lines reversed))) + (should (string= reversed "line3\nline2\nline1")) + (should (string= back original)))) + +;;; Boundary Cases + +(ert-deftest test-reverse-lines-empty-string () + "Should handle empty string." + (let ((result (test-reverse-lines ""))) + (should (string= result "")))) + +(ert-deftest test-reverse-lines-single-line () + "Should handle single line (no change)." + (let ((result (test-reverse-lines "single line"))) + (should (string= result "single line")))) + +(ert-deftest test-reverse-lines-empty-lines () + "Should reverse including empty lines." + (let ((result (test-reverse-lines "a\n\nb"))) + (should (string= result "b\n\na")))) + +(ert-deftest test-reverse-lines-trailing-newline () + "Should handle trailing newline." + (let ((result (test-reverse-lines "line1\nline2\n"))) + (should (string= result "\nline2\nline1")))) + +(ert-deftest test-reverse-lines-only-newlines () + "Should reverse lines that are only newlines." + (let ((result (test-reverse-lines "\n\n\n"))) + (should (string= result "\n\n\n")))) + +(ert-deftest test-reverse-lines-numbers () + "Should reverse numbered lines." + (let ((result (test-reverse-lines "1\n2\n3\n4\n5"))) + (should (string= result "5\n4\n3\n2\n1")))) + +(ert-deftest test-reverse-lines-very-long () + "Should reverse very long list." + (let* ((lines (mapcar #'number-to-string (number-sequence 1 100))) + (input (mapconcat #'identity lines "\n")) + (result (test-reverse-lines input)) + (result-lines (split-string result "\n"))) + (should (= 100 (length result-lines))) + (should (string= "100" (car result-lines))) + (should (string= "1" (car (last result-lines)))))) + +;;; Error Cases + +(ert-deftest test-reverse-lines-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "line1\nline2") + (cj/--reverse-lines (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-reverse-lines-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "line1\nline2") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--reverse-lines pos pos)))))) + +(provide 'test-custom-ordering-reverse-lines) +;;; test-custom-ordering-reverse-lines.el ends here diff --git a/tests/test-custom-ordering-toggle-quotes.el b/tests/test-custom-ordering-toggle-quotes.el new file mode 100644 index 00000000..e11305ee --- /dev/null +++ b/tests/test-custom-ordering-toggle-quotes.el @@ -0,0 +1,155 @@ +;;; test-custom-ordering-toggle-quotes.el --- Tests for cj/--toggle-quotes -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--toggle-quotes function from custom-ordering.el +;; +;; This function toggles between double quotes and single quotes. +;; All " become ' and all ' become ". +;; +;; Examples: +;; Input: "apple", "banana" +;; Output: 'apple', 'banana' +;; +;; Input: 'hello', 'world' +;; Output: "hello", "world" +;; +;; We test the NON-INTERACTIVE implementation (cj/--toggle-quotes) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-toggle-quotes (input-text) + "Test cj/--toggle-quotes on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--toggle-quotes (point-min) (point-max)))) + +;;; Normal Cases - Double to Single + +(ert-deftest test-toggle-quotes-double-to-single () + "Should convert double quotes to single quotes." + (let ((result (test-toggle-quotes "\"apple\", \"banana\""))) + (should (string= result "'apple', 'banana'")))) + +(ert-deftest test-toggle-quotes-single-double-quote () + "Should convert single double quote." + (let ((result (test-toggle-quotes "\""))) + (should (string= result "'")))) + +(ert-deftest test-toggle-quotes-multiple-double-quotes () + "Should convert multiple double quotes." + (let ((result (test-toggle-quotes "\"hello\" \"world\" \"test\""))) + (should (string= result "'hello' 'world' 'test'")))) + +;;; Normal Cases - Single to Double + +(ert-deftest test-toggle-quotes-single-to-double () + "Should convert single quotes to double quotes." + (let ((result (test-toggle-quotes "'apple', 'banana'"))) + (should (string= result "\"apple\", \"banana\"")))) + +(ert-deftest test-toggle-quotes-single-single-quote () + "Should convert single single quote." + (let ((result (test-toggle-quotes "'"))) + (should (string= result "\"")))) + +(ert-deftest test-toggle-quotes-multiple-single-quotes () + "Should convert multiple single quotes." + (let ((result (test-toggle-quotes "'hello' 'world' 'test'"))) + (should (string= result "\"hello\" \"world\" \"test\"")))) + +;;; Normal Cases - Mixed Quotes + +(ert-deftest test-toggle-quotes-mixed () + "Should toggle mixed quotes." + (let ((result (test-toggle-quotes "\"double\" 'single'"))) + (should (string= result "'double' \"single\"")))) + +(ert-deftest test-toggle-quotes-bidirectional () + "Should toggle back and forth correctly." + (let* ((original "\"apple\", \"banana\"") + (toggled (test-toggle-quotes original)) + (back (test-toggle-quotes toggled))) + (should (string= toggled "'apple', 'banana'")) + (should (string= back original)))) + +;;; Normal Cases - With Text Content + +(ert-deftest test-toggle-quotes-preserves-content () + "Should preserve content while toggling quotes." + (let ((result (test-toggle-quotes "var x = \"hello world\";"))) + (should (string= result "var x = 'hello world';")))) + +(ert-deftest test-toggle-quotes-sql-style () + "Should toggle SQL-style quotes." + (let ((result (test-toggle-quotes "SELECT * FROM users WHERE name='John'"))) + (should (string= result "SELECT * FROM users WHERE name=\"John\"")))) + +(ert-deftest test-toggle-quotes-multiline () + "Should toggle quotes across multiple lines." + (let ((result (test-toggle-quotes "\"line1\"\n\"line2\"\n\"line3\""))) + (should (string= result "'line1'\n'line2'\n'line3'")))) + +;;; Boundary Cases + +(ert-deftest test-toggle-quotes-empty-string () + "Should handle empty string." + (let ((result (test-toggle-quotes ""))) + (should (string= result "")))) + +(ert-deftest test-toggle-quotes-no-quotes () + "Should handle text with no quotes." + (let ((result (test-toggle-quotes "hello world"))) + (should (string= result "hello world")))) + +(ert-deftest test-toggle-quotes-only-double-quotes () + "Should handle string with only double quotes." + (let ((result (test-toggle-quotes "\"\"\"\""))) + (should (string= result "''''")))) + +(ert-deftest test-toggle-quotes-only-single-quotes () + "Should handle string with only single quotes." + (let ((result (test-toggle-quotes "''''"))) + (should (string= result "\"\"\"\"")))) + +(ert-deftest test-toggle-quotes-adjacent-quotes () + "Should handle adjacent quotes." + (let ((result (test-toggle-quotes "\"\"''"))) + (should (string= result "''\"\"")))) + +;;; Error Cases + +(ert-deftest test-toggle-quotes-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "\"hello\"") + (cj/--toggle-quotes (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-toggle-quotes-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "\"hello\"") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--toggle-quotes pos pos)))))) + +(provide 'test-custom-ordering-toggle-quotes) +;;; test-custom-ordering-toggle-quotes.el ends here diff --git a/tests/test-custom-ordering-unarrayify.el b/tests/test-custom-ordering-unarrayify.el new file mode 100644 index 00000000..a778f419 --- /dev/null +++ b/tests/test-custom-ordering-unarrayify.el @@ -0,0 +1,159 @@ +;;; test-custom-ordering-unarrayify.el --- Tests for cj/--unarrayify -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--unarrayify function from custom-ordering.el +;; +;; This function converts comma-separated array format back to separate lines. +;; It splits by ", " (comma-space), removes quotes (both " and '), and joins with newlines. +;; +;; Examples: +;; Input: "\"apple\", \"banana\", \"cherry\"" +;; Output: "apple\nbanana\ncherry" +;; +;; Input: "'one', 'two', 'three'" +;; Output: "one\ntwo\nthree" +;; +;; We test the NON-INTERACTIVE implementation (cj/--unarrayify) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-ordering) + +;;; Test Helpers + +(defun test-unarrayify (input-text) + "Test cj/--unarrayify on INPUT-TEXT. +Returns the transformed string." + (with-temp-buffer + (insert input-text) + (cj/--unarrayify (point-min) (point-max)))) + +;;; Normal Cases - Double Quotes + +(ert-deftest test-unarrayify-double-quotes-simple () + "Should unarrayify double-quoted elements." + (let ((result (test-unarrayify "\"apple\", \"banana\", \"cherry\""))) + (should (string= result "apple\nbanana\ncherry")))) + +(ert-deftest test-unarrayify-double-quotes-single-element () + "Should unarrayify single double-quoted element." + (let ((result (test-unarrayify "\"hello\""))) + (should (string= result "hello")))) + +(ert-deftest test-unarrayify-double-quotes-two-elements () + "Should unarrayify two double-quoted elements." + (let ((result (test-unarrayify "\"one\", \"two\""))) + (should (string= result "one\ntwo")))) + +;;; Normal Cases - Single Quotes + +(ert-deftest test-unarrayify-single-quotes-simple () + "Should unarrayify single-quoted elements." + (let ((result (test-unarrayify "'alpha', 'beta', 'gamma'"))) + (should (string= result "alpha\nbeta\ngamma")))) + +(ert-deftest test-unarrayify-single-quotes-single-element () + "Should unarrayify single single-quoted element." + (let ((result (test-unarrayify "'hello'"))) + (should (string= result "hello")))) + +;;; Normal Cases - Mixed Quotes + +(ert-deftest test-unarrayify-mixed-quotes () + "Should unarrayify mixed quote types." + (let ((result (test-unarrayify "\"apple\", 'banana', \"cherry\""))) + (should (string= result "apple\nbanana\ncherry")))) + +;;; Normal Cases - No Quotes + +(ert-deftest test-unarrayify-no-quotes () + "Should unarrayify unquoted elements." + (let ((result (test-unarrayify "foo, bar, baz"))) + (should (string= result "foo\nbar\nbaz")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-unarrayify-with-numbers () + "Should unarrayify numbers." + (let ((result (test-unarrayify "\"1\", \"2\", \"3\""))) + (should (string= result "1\n2\n3")))) + +(ert-deftest test-unarrayify-with-spaces-in-elements () + "Should preserve spaces within elements." + (let ((result (test-unarrayify "\"hello world\", \"foo bar\""))) + (should (string= result "hello world\nfoo bar")))) + +(ert-deftest test-unarrayify-mixed-content () + "Should unarrayify mixed alphanumeric content." + (let ((result (test-unarrayify "\"item1\", \"item2\", \"item3\""))) + (should (string= result "item1\nitem2\nitem3")))) + +;;; Boundary Cases + +(ert-deftest test-unarrayify-empty-string () + "Should handle empty string." + (let ((result (test-unarrayify ""))) + (should (string= result "")))) + +(ert-deftest test-unarrayify-only-quotes () + "Should remove quotes from quote-only string." + (let ((result (test-unarrayify "\"\""))) + (should (string= result "")))) + +(ert-deftest test-unarrayify-very-long-list () + "Should handle very long list." + (let* ((elements (mapcar (lambda (i) (format "\"%d\"" i)) (number-sequence 1 100))) + (input (mapconcat #'identity elements ", ")) + (result (test-unarrayify input)) + (lines (split-string result "\n"))) + (should (= 100 (length lines))))) + +(ert-deftest test-unarrayify-with-empty-elements () + "Should handle empty quoted elements." + (let ((result (test-unarrayify "\"\", \"test\", \"\""))) + (should (string= result "\ntest\n")))) + +;;; Edge Cases - Nested or Mismatched Quotes + +(ert-deftest test-unarrayify-double-quotes-in-single () + "Should handle double quotes inside single-quoted strings." + (let ((result (test-unarrayify "'he said \"hello\"', 'world'"))) + (should (string= result "he said hello\nworld")))) + +(ert-deftest test-unarrayify-only-opening-quotes () + "Should remove all quote characters even if mismatched." + (let ((result (test-unarrayify "\"apple, \"banana, \"cherry"))) + (should (string= result "apple\nbanana\ncherry")))) + +;;; Error Cases + +(ert-deftest test-unarrayify-start-greater-than-end () + "Should error when start > end." + (should-error + (with-temp-buffer + (insert "\"a\", \"b\"") + (cj/--unarrayify (point-max) (point-min))) + :type 'error)) + +(ert-deftest test-unarrayify-empty-region () + "Should handle empty region (start == end)." + (with-temp-buffer + (insert "\"a\", \"b\"") + (let ((pos (/ (+ (point-min) (point-max)) 2))) + (should (string= "" (cj/--unarrayify pos pos)))))) + +(provide 'test-custom-ordering-unarrayify) +;;; test-custom-ordering-unarrayify.el ends here diff --git a/tests/test-custom-org-agenda-functions.el.disabled b/tests/test-custom-org-agenda-functions.el.disabled deleted file mode 100644 index 44f9f43d..00000000 --- a/tests/test-custom-org-agenda-functions.el.disabled +++ /dev/null @@ -1,94 +0,0 @@ -;;; test-custom-org-agenda-functions.el --- Tests for custom functions in org-agenda -*- lexical-binding: t; -*- - -;;; Commentary: -;; This tests the custom functions created to build the main agenda in org-agenda-config.el - -;;; Code: - -(add-to-list 'load-path (concat user-emacs-directory "modules")) -(require 'org-agenda-config) - -(ert-deftest test-cj/org-skip-subtree-if-habit-positive () - (with-temp-buffer - (insert "* TODO [#A] Test task\n") - (insert ":PROPERTIES:\n") - (insert ":STYLE: habit\n") - (insert ":RESET_CHECK_BOXES: t\n") - (insert ":END:\n") - (org-mode) - (goto-char (point-min)) - (should (not (eq nil (cj/org-skip-subtree-if-habit)))))) - -(ert-deftest test-cj/org-skip-subtree-if-habit-negative () - (with-temp-buffer - (insert "* TODO [#A] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-habit))))) - -(ert-deftest test-cj/org-skip-subtree-if-priority-positive () - (with-temp-buffer - (insert "* TODO [#A] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (not (eq nil (cj/org-skip-subtree-if-priority ?A)))))) - -(ert-deftest test-cj/org-skip-subtree-if-priority-negative () - (erase-buffer) - (insert "* TODO [#B] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-priority ?A)))) - -(ert-deftest test-cj/org-skip-subtree-if-priority-boundary0 () - (erase-buffer) - (insert "* TODO Test task\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-priority ?A)))) - -(ert-deftest test-cj/org-skip-subtree-if-priority-boundary1 () - (erase-buffer) - (insert "* Test entry\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-priority ?A)))) - -(ert-deftest test-cj/org-skip-subtree-if-keyword-positive () - (with-temp-buffer - (insert "* TODO [#A] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (not (eq nil (cj/org-skip-subtree-if-keyword '("TODO"))))))) - -(ert-deftest test-cj/org-skip-subtree-if-keyword-positive-multiple () - (with-temp-buffer - (insert "* PROJECT Test entry\n") - (org-mode) - (goto-char (point-min)) - (should (not (eq nil (cj/org-skip-subtree-if-keyword '("TODO" "PROJECT"))))))) - -(ert-deftest test-cj/org-skip-subtree-if-keyword-negative () - (erase-buffer) - (insert "* PROJECT [#A] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-keyword '("TODO"))))) - -(ert-deftest test-cj/org-skip-subtree-if-keyword-negative-superset () - (erase-buffer) - (insert "* PROJECT [#A] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-keyword '("TODOTODO"))))) - -(ert-deftest test-cj/org-skip-subtree-if-keyword-negative-multiple () - (erase-buffer) - (insert "* PROJECT [#A] Test task\n") - (org-mode) - (goto-char (point-min)) - (should (eq nil (cj/org-skip-subtree-if-keyword '("TODO" "DONE"))))) - - -(provide 'test-custom-org-agenda-functions) -;;; test-custom-org-agenda-functions.el ends here. diff --git a/tests/test-custom-text-enclose-append.el b/tests/test-custom-text-enclose-append.el new file mode 100644 index 00000000..3593a7f5 --- /dev/null +++ b/tests/test-custom-text-enclose-append.el @@ -0,0 +1,190 @@ +;;; test-custom-text-enclose-append.el --- Tests for cj/--append-to-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--append-to-lines function from custom-text-enclose.el +;; +;; This function appends a suffix string to the end of each line in text. +;; It preserves the structure of lines and handles trailing newlines correctly. +;; +;; Examples: +;; Input: "line1\nline2", suffix: ";" +;; Output: "line1;\nline2;" +;; +;; Input: "single", suffix: "!" +;; Output: "single!" +;; +;; We test the NON-INTERACTIVE implementation (cj/--append-to-lines) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-append-to-lines (text suffix) + "Test cj/--append-to-lines on TEXT with SUFFIX. +Returns the transformed string." + (cj/--append-to-lines text suffix)) + +;;; Normal Cases - Single Line + +(ert-deftest test-append-single-line () + "Should append to single line." + (let ((result (test-append-to-lines "hello" ";"))) + (should (string= result "hello;")))) + +(ert-deftest test-append-single-line-semicolon () + "Should append semicolon to single line." + (let ((result (test-append-to-lines "var x = 5" ";"))) + (should (string= result "var x = 5;")))) + +(ert-deftest test-append-single-line-exclamation () + "Should append exclamation mark to single line." + (let ((result (test-append-to-lines "Hello world" "!"))) + (should (string= result "Hello world!")))) + +;;; Normal Cases - Multiple Lines + +(ert-deftest test-append-two-lines () + "Should append to two lines." + (let ((result (test-append-to-lines "line1\nline2" ";"))) + (should (string= result "line1;\nline2;")))) + +(ert-deftest test-append-three-lines () + "Should append to three lines." + (let ((result (test-append-to-lines "a\nb\nc" "."))) + (should (string= result "a.\nb.\nc.")))) + +(ert-deftest test-append-many-lines () + "Should append to many lines." + (let* ((lines (make-list 10 "line")) + (input (mapconcat #'identity lines "\n")) + (result (test-append-to-lines input ";")) + (result-lines (split-string result "\n"))) + (should (= 10 (length result-lines))) + (should (cl-every (lambda (line) (string-suffix-p ";" line)) result-lines)))) + +;;; Normal Cases - Various Suffixes + +(ert-deftest test-append-comma () + "Should append comma to lines." + (let ((result (test-append-to-lines "apple\nbanana" ","))) + (should (string= result "apple,\nbanana,")))) + +(ert-deftest test-append-multi-char () + "Should append multi-character suffix." + (let ((result (test-append-to-lines "line" " // comment"))) + (should (string= result "line // comment")))) + +(ert-deftest test-append-pipe () + "Should append pipe character." + (let ((result (test-append-to-lines "col1\ncol2" " |"))) + (should (string= result "col1 |\ncol2 |")))) + +(ert-deftest test-append-empty-suffix () + "Should handle empty suffix." + (let ((result (test-append-to-lines "line1\nline2" ""))) + (should (string= result "line1\nline2")))) + +;;; Boundary Cases - Trailing Newlines + +(ert-deftest test-append-with-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-append-to-lines "line1\nline2\n" ";"))) + (should (string= result "line1;\nline2;\n")))) + +(ert-deftest test-append-no-trailing-newline () + "Should work without trailing newline." + (let ((result (test-append-to-lines "line1\nline2" ";"))) + (should (string= result "line1;\nline2;")))) + +(ert-deftest test-append-single-line-with-newline () + "Should preserve trailing newline on single line." + (let ((result (test-append-to-lines "line\n" ";"))) + (should (string= result "line;\n")))) + +;;; Boundary Cases - Empty Lines + +(ert-deftest test-append-empty-line-between () + "Should append to empty line between other lines." + (let ((result (test-append-to-lines "line1\n\nline3" ";"))) + (should (string= result "line1;\n;\nline3;")))) + +(ert-deftest test-append-only-empty-lines () + "Should append to only empty lines." + (let ((result (test-append-to-lines "\n\n" ";"))) + (should (string= result ";\n;\n")))) + +(ert-deftest test-append-empty-first-line () + "Should append to empty first line." + (let ((result (test-append-to-lines "\nline2\nline3" ";"))) + (should (string= result ";\nline2;\nline3;")))) + +;;; Boundary Cases - Whitespace + +(ert-deftest test-append-preserves-leading-whitespace () + "Should preserve leading whitespace." + (let ((result (test-append-to-lines " line1\n line2" ";"))) + (should (string= result " line1;\n line2;")))) + +(ert-deftest test-append-preserves-trailing-whitespace () + "Should preserve trailing whitespace on line." + (let ((result (test-append-to-lines "line1 \nline2 " ";"))) + (should (string= result "line1 ;\nline2 ;")))) + +(ert-deftest test-append-whitespace-only-line () + "Should append to whitespace-only line." + (let ((result (test-append-to-lines "line1\n \nline3" ";"))) + (should (string= result "line1;\n ;\nline3;")))) + +;;; Boundary Cases - Special Cases + +(ert-deftest test-append-empty-string () + "Should handle empty string." + (let ((result (test-append-to-lines "" ";"))) + (should (string= result ";")))) + +(ert-deftest test-append-very-long-line () + "Should append to very long line." + (let* ((long-line (make-string 1000 ?a)) + (result (test-append-to-lines long-line ";"))) + (should (string-suffix-p ";" result)) + (should (= (length result) 1001)))) + +(ert-deftest test-append-with-existing-suffix () + "Should append even if line already has the suffix." + (let ((result (test-append-to-lines "line;" ";"))) + (should (string= result "line;;")))) + +;;; Edge Cases - Special Characters in Suffix + +(ert-deftest test-append-newline-suffix () + "Should append newline as suffix." + (let ((result (test-append-to-lines "line1\nline2" "\n"))) + (should (string= result "line1\n\nline2\n")))) + +(ert-deftest test-append-tab-suffix () + "Should append tab as suffix." + (let ((result (test-append-to-lines "col1\ncol2" "\t"))) + (should (string= result "col1\t\ncol2\t")))) + +(ert-deftest test-append-quote-suffix () + "Should append quote as suffix." + (let ((result (test-append-to-lines "value1\nvalue2" "\""))) + (should (string= result "value1\"\nvalue2\"")))) + +(provide 'test-custom-text-enclose-append) +;;; test-custom-text-enclose-append.el ends here diff --git a/tests/test-custom-text-enclose-indent.el b/tests/test-custom-text-enclose-indent.el new file mode 100644 index 00000000..e9042d35 --- /dev/null +++ b/tests/test-custom-text-enclose-indent.el @@ -0,0 +1,241 @@ +;;; test-custom-text-enclose-indent.el --- Tests for cj/--indent-lines and cj/--dedent-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--indent-lines and cj/--dedent-lines functions from custom-text-enclose.el +;; +;; cj/--indent-lines adds leading whitespace (spaces or tabs) to each line. +;; cj/--dedent-lines removes up to COUNT leading whitespace characters from each line. +;; +;; Examples (indent): +;; Input: "line1\nline2", count: 4, use-tabs: nil +;; Output: " line1\n line2" +;; +;; Examples (dedent): +;; Input: " line1\n line2", count: 4 +;; Output: "line1\nline2" +;; +;; We test the NON-INTERACTIVE implementations to avoid mocking user input. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-indent (text count use-tabs) + "Test cj/--indent-lines on TEXT with COUNT and USE-TABS. +Returns the transformed string." + (cj/--indent-lines text count use-tabs)) + +(defun test-dedent (text count) + "Test cj/--dedent-lines on TEXT with COUNT. +Returns the transformed string." + (cj/--dedent-lines text count)) + +;;; Indent Tests - Normal Cases with Spaces + +(ert-deftest test-indent-single-line-4-spaces () + "Should indent single line with 4 spaces." + (let ((result (test-indent "line" 4 nil))) + (should (string= result " line")))) + +(ert-deftest test-indent-two-lines-4-spaces () + "Should indent two lines with 4 spaces." + (let ((result (test-indent "line1\nline2" 4 nil))) + (should (string= result " line1\n line2")))) + +(ert-deftest test-indent-three-lines-2-spaces () + "Should indent three lines with 2 spaces." + (let ((result (test-indent "a\nb\nc" 2 nil))) + (should (string= result " a\n b\n c")))) + +(ert-deftest test-indent-many-lines () + "Should indent many lines." + (let ((result (test-indent "1\n2\n3\n4\n5" 4 nil))) + (should (string= result " 1\n 2\n 3\n 4\n 5")))) + +;;; Indent Tests - Normal Cases with Tabs + +(ert-deftest test-indent-single-line-1-tab () + "Should indent single line with 1 tab." + (let ((result (test-indent "line" 1 t))) + (should (string= result "\tline")))) + +(ert-deftest test-indent-two-lines-1-tab () + "Should indent two lines with 1 tab." + (let ((result (test-indent "line1\nline2" 1 t))) + (should (string= result "\tline1\n\tline2")))) + +(ert-deftest test-indent-with-2-tabs () + "Should indent with 2 tabs." + (let ((result (test-indent "code" 2 t))) + (should (string= result "\t\tcode")))) + +;;; Indent Tests - Boundary Cases + +(ert-deftest test-indent-empty-string () + "Should indent empty string." + (let ((result (test-indent "" 4 nil))) + (should (string= result " ")))) + +(ert-deftest test-indent-zero-count () + "Should not indent with count 0." + (let ((result (test-indent "line" 0 nil))) + (should (string= result "line")))) + +(ert-deftest test-indent-already-indented () + "Should add more indentation to already indented lines." + (let ((result (test-indent " line1\n line2" 2 nil))) + (should (string= result " line1\n line2")))) + +(ert-deftest test-indent-empty-lines () + "Should indent empty lines." + (let ((result (test-indent "line1\n\nline3" 4 nil))) + (should (string= result " line1\n \n line3")))) + +(ert-deftest test-indent-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-indent "line1\nline2\n" 4 nil))) + (should (string= result " line1\n line2\n")))) + +(ert-deftest test-indent-no-trailing-newline () + "Should work without trailing newline." + (let ((result (test-indent "line1\nline2" 4 nil))) + (should (string= result " line1\n line2")))) + +;;; Dedent Tests - Normal Cases + +(ert-deftest test-dedent-single-line-4-spaces () + "Should dedent single line with 4 spaces." + (let ((result (test-dedent " line" 4))) + (should (string= result "line")))) + +(ert-deftest test-dedent-two-lines-4-spaces () + "Should dedent two lines with 4 spaces." + (let ((result (test-dedent " line1\n line2" 4))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-dedent-three-lines-2-spaces () + "Should dedent three lines with 2 spaces." + (let ((result (test-dedent " a\n b\n c" 2))) + (should (string= result "a\nb\nc")))) + +(ert-deftest test-dedent-with-tabs () + "Should dedent lines with tabs." + (let ((result (test-dedent "\tline1\n\tline2" 1))) + (should (string= result "line1\nline2")))) + +(ert-deftest test-dedent-mixed-spaces-tabs () + "Should dedent mixed spaces and tabs." + (let ((result (test-dedent " \tline" 3))) + (should (string= result "line")))) + +;;; Dedent Tests - Partial Dedent + +(ert-deftest test-dedent-partial () + "Should dedent only COUNT characters." + (let ((result (test-dedent " line" 2))) + (should (string= result " line")))) + +(ert-deftest test-dedent-less-than-count () + "Should dedent all available spaces when less than COUNT." + (let ((result (test-dedent " line" 4))) + (should (string= result "line")))) + +(ert-deftest test-dedent-no-leading-space () + "Should not affect lines with no leading whitespace." + (let ((result (test-dedent "line" 4))) + (should (string= result "line")))) + +(ert-deftest test-dedent-varying-indentation () + "Should dedent each line independently." + (let ((result (test-dedent " line1\n line2\nline3" 2))) + (should (string= result " line1\nline2\nline3")))) + +;;; Dedent Tests - Boundary Cases + +(ert-deftest test-dedent-empty-string () + "Should handle empty string." + (let ((result (test-dedent "" 4))) + (should (string= result "")))) + +(ert-deftest test-dedent-zero-count () + "Should not dedent with count 0." + (let ((result (test-dedent " line" 0))) + (should (string= result " line")))) + +(ert-deftest test-dedent-empty-lines () + "Should handle empty lines." + (let ((result (test-dedent " line1\n \n line3" 4))) + (should (string= result "line1\n\nline3")))) + +(ert-deftest test-dedent-only-whitespace () + "Should dedent whitespace-only lines." + (let ((result (test-dedent " " 4))) + (should (string= result "")))) + +(ert-deftest test-dedent-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-dedent " line1\n line2\n" 4))) + (should (string= result "line1\nline2\n")))) + +(ert-deftest test-dedent-preserves-internal-spaces () + "Should not affect internal whitespace." + (let ((result (test-dedent " hello world" 4))) + (should (string= result "hello world")))) + +;;; Round-trip Tests + +(ert-deftest test-indent-dedent-roundtrip () + "Should be able to indent then dedent back to original." + (let* ((original "line1\nline2") + (indented (test-indent original 4 nil)) + (dedented (test-dedent indented 4))) + (should (string= dedented original)))) + +(ert-deftest test-dedent-indent-roundtrip () + "Should be able to dedent then indent back to original." + (let* ((original " line1\n line2") + (dedented (test-dedent original 4)) + (indented (test-indent dedented 4 nil))) + (should (string= indented original)))) + +;;; Edge Cases + +(ert-deftest test-indent-very-long-line () + "Should indent very long line." + (let* ((long-line (make-string 1000 ?a)) + (result (test-indent long-line 4 nil))) + (should (string-prefix-p " " result)) + (should (= (length result) 1004)))) + +(ert-deftest test-dedent-very-indented () + "Should dedent very indented line." + (let* ((many-spaces (make-string 100 ?\s)) + (text (concat many-spaces "text")) + (result (test-dedent text 50))) + (should (string-prefix-p (make-string 50 ?\s) result)))) + +(ert-deftest test-indent-with-existing-tabs () + "Should indent lines that already have tabs." + (let ((result (test-indent "\tcode" 4 nil))) + (should (string= result " \tcode")))) + +(ert-deftest test-dedent-stops-at-non-whitespace () + "Should stop dedenting at first non-whitespace character." + (let ((result (test-dedent " a b" 4))) + (should (string= result "a b")))) + +(provide 'test-custom-text-enclose-indent) +;;; test-custom-text-enclose-indent.el ends here diff --git a/tests/test-custom-text-enclose-prepend.el b/tests/test-custom-text-enclose-prepend.el new file mode 100644 index 00000000..e03375ff --- /dev/null +++ b/tests/test-custom-text-enclose-prepend.el @@ -0,0 +1,207 @@ +;;; test-custom-text-enclose-prepend.el --- Tests for cj/--prepend-to-lines -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--prepend-to-lines function from custom-text-enclose.el +;; +;; This function prepends a prefix string to the beginning of each line in text. +;; It preserves the structure of lines and handles trailing newlines correctly. +;; +;; Examples: +;; Input: "line1\nline2", prefix: "// " +;; Output: "// line1\n// line2" +;; +;; Input: "single", prefix: "> " +;; Output: "> single" +;; +;; We test the NON-INTERACTIVE implementation (cj/--prepend-to-lines) to avoid +;; mocking region selection. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-prepend-to-lines (text prefix) + "Test cj/--prepend-to-lines on TEXT with PREFIX. +Returns the transformed string." + (cj/--prepend-to-lines text prefix)) + +;;; Normal Cases - Single Line + +(ert-deftest test-prepend-single-line () + "Should prepend to single line." + (let ((result (test-prepend-to-lines "hello" "> "))) + (should (string= result "> hello")))) + +(ert-deftest test-prepend-single-line-comment () + "Should prepend comment marker to single line." + (let ((result (test-prepend-to-lines "code here" "// "))) + (should (string= result "// code here")))) + +(ert-deftest test-prepend-single-line-bullet () + "Should prepend bullet to single line." + (let ((result (test-prepend-to-lines "item" "- "))) + (should (string= result "- item")))) + +;;; Normal Cases - Multiple Lines + +(ert-deftest test-prepend-two-lines () + "Should prepend to two lines." + (let ((result (test-prepend-to-lines "line1\nline2" "> "))) + (should (string= result "> line1\n> line2")))) + +(ert-deftest test-prepend-three-lines () + "Should prepend to three lines." + (let ((result (test-prepend-to-lines "a\nb\nc" "* "))) + (should (string= result "* a\n* b\n* c")))) + +(ert-deftest test-prepend-many-lines () + "Should prepend to many lines." + (let* ((lines (make-list 10 "line")) + (input (mapconcat #'identity lines "\n")) + (result (test-prepend-to-lines input "# ")) + (result-lines (split-string result "\n"))) + (should (= 10 (length result-lines))) + (should (cl-every (lambda (line) (string-prefix-p "# " line)) result-lines)))) + +;;; Normal Cases - Various Prefixes + +(ert-deftest test-prepend-comment-marker () + "Should prepend comment marker." + (let ((result (test-prepend-to-lines "line1\nline2" "// "))) + (should (string= result "// line1\n// line2")))) + +(ert-deftest test-prepend-hash-comment () + "Should prepend hash comment." + (let ((result (test-prepend-to-lines "line1\nline2" "# "))) + (should (string= result "# line1\n# line2")))) + +(ert-deftest test-prepend-multi-char () + "Should prepend multi-character prefix." + (let ((result (test-prepend-to-lines "line" "TODO: "))) + (should (string= result "TODO: line")))) + +(ert-deftest test-prepend-empty-prefix () + "Should handle empty prefix." + (let ((result (test-prepend-to-lines "line1\nline2" ""))) + (should (string= result "line1\nline2")))) + +;;; Boundary Cases - Trailing Newlines + +(ert-deftest test-prepend-with-trailing-newline () + "Should preserve trailing newline." + (let ((result (test-prepend-to-lines "line1\nline2\n" "> "))) + (should (string= result "> line1\n> line2\n")))) + +(ert-deftest test-prepend-no-trailing-newline () + "Should work without trailing newline." + (let ((result (test-prepend-to-lines "line1\nline2" "> "))) + (should (string= result "> line1\n> line2")))) + +(ert-deftest test-prepend-single-line-with-newline () + "Should preserve trailing newline on single line." + (let ((result (test-prepend-to-lines "line\n" "> "))) + (should (string= result "> line\n")))) + +;;; Boundary Cases - Empty Lines + +(ert-deftest test-prepend-empty-line-between () + "Should prepend to empty line between other lines." + (let ((result (test-prepend-to-lines "line1\n\nline3" "> "))) + (should (string= result "> line1\n> \n> line3")))) + +(ert-deftest test-prepend-only-empty-lines () + "Should prepend to only empty lines." + (let ((result (test-prepend-to-lines "\n\n" "> "))) + (should (string= result "> \n> \n")))) + +(ert-deftest test-prepend-empty-first-line () + "Should prepend to empty first line." + (let ((result (test-prepend-to-lines "\nline2\nline3" "> "))) + (should (string= result "> \n> line2\n> line3")))) + +;;; Boundary Cases - Whitespace + +(ert-deftest test-prepend-preserves-leading-whitespace () + "Should preserve leading whitespace after prefix." + (let ((result (test-prepend-to-lines " line1\n line2" "// "))) + (should (string= result "// line1\n// line2")))) + +(ert-deftest test-prepend-preserves-trailing-whitespace () + "Should preserve trailing whitespace on line." + (let ((result (test-prepend-to-lines "line1 \nline2 " "> "))) + (should (string= result "> line1 \n> line2 ")))) + +(ert-deftest test-prepend-whitespace-only-line () + "Should prepend to whitespace-only line." + (let ((result (test-prepend-to-lines "line1\n \nline3" "> "))) + (should (string= result "> line1\n> \n> line3")))) + +;;; Boundary Cases - Special Cases + +(ert-deftest test-prepend-empty-string () + "Should handle empty string." + (let ((result (test-prepend-to-lines "" "> "))) + (should (string= result "> ")))) + +(ert-deftest test-prepend-very-long-line () + "Should prepend to very long line." + (let* ((long-line (make-string 1000 ?a)) + (result (test-prepend-to-lines long-line "> "))) + (should (string-prefix-p "> " result)) + (should (= (length result) 1002)))) + +(ert-deftest test-prepend-with-existing-prefix () + "Should prepend even if line already has the prefix." + (let ((result (test-prepend-to-lines "> line" "> "))) + (should (string= result "> > line")))) + +;;; Edge Cases - Special Characters in Prefix + +(ert-deftest test-prepend-newline-prefix () + "Should prepend newline as prefix." + (let ((result (test-prepend-to-lines "line1\nline2" "\n"))) + (should (string= result "\nline1\n\nline2")))) + +(ert-deftest test-prepend-tab-prefix () + "Should prepend tab as prefix." + (let ((result (test-prepend-to-lines "line1\nline2" "\t"))) + (should (string= result "\tline1\n\tline2")))) + +(ert-deftest test-prepend-quote-prefix () + "Should prepend quote as prefix." + (let ((result (test-prepend-to-lines "line1\nline2" "\""))) + (should (string= result "\"line1\n\"line2")))) + +;;; Edge Cases - Common Use Cases + +(ert-deftest test-prepend-markdown-quote () + "Should prepend markdown quote marker." + (let ((result (test-prepend-to-lines "quote text\nmore text" "> "))) + (should (string= result "> quote text\n> more text")))) + +(ert-deftest test-prepend-numbered-list () + "Should prepend numbers (though simpler uses would vary the prefix)." + (let ((result (test-prepend-to-lines "item" "1. "))) + (should (string= result "1. item")))) + +(ert-deftest test-prepend-indentation () + "Should prepend indentation spaces." + (let ((result (test-prepend-to-lines "code\nmore" " "))) + (should (string= result " code\n more")))) + +(provide 'test-custom-text-enclose-prepend) +;;; test-custom-text-enclose-prepend.el ends here diff --git a/tests/test-custom-text-enclose-surround.el b/tests/test-custom-text-enclose-surround.el new file mode 100644 index 00000000..dfed20a7 --- /dev/null +++ b/tests/test-custom-text-enclose-surround.el @@ -0,0 +1,200 @@ +;;; test-custom-text-enclose-surround.el --- Tests for cj/--surround -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--surround function from custom-text-enclose.el +;; +;; This function surrounds text with a given string. +;; The surround string is both prepended and appended to the text. +;; +;; Examples: +;; Input: "hello", surround: "\"" +;; Output: "\"hello\"" +;; +;; Input: "world", surround: "**" +;; Output: "**world**" +;; +;; We test the NON-INTERACTIVE implementation (cj/--surround) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-surround (text surround-string) + "Test cj/--surround on TEXT with SURROUND-STRING. +Returns the transformed string." + (cj/--surround text surround-string)) + +;;; Normal Cases - Common Surround Strings + +(ert-deftest test-surround-double-quotes () + "Should surround text with double quotes." + (let ((result (test-surround "hello" "\""))) + (should (string= result "\"hello\"")))) + +(ert-deftest test-surround-single-quotes () + "Should surround text with single quotes." + (let ((result (test-surround "world" "'"))) + (should (string= result "'world'")))) + +(ert-deftest test-surround-parentheses () + "Should surround text with parentheses." + (let ((result (test-surround "text" "("))) + (should (string= result "(text(")))) + +(ert-deftest test-surround-square-brackets () + "Should surround text with square brackets." + (let ((result (test-surround "item" "["))) + (should (string= result "[item[")))) + +(ert-deftest test-surround-asterisks () + "Should surround text with asterisks for markdown." + (let ((result (test-surround "bold" "*"))) + (should (string= result "*bold*")))) + +(ert-deftest test-surround-double-asterisks () + "Should surround text with double asterisks." + (let ((result (test-surround "bold" "**"))) + (should (string= result "**bold**")))) + +;;; Normal Cases - Multi-Character Surround Strings + +(ert-deftest test-surround-html-tag () + "Should surround text with HTML-like tags." + (let ((result (test-surround "content" "<tag>"))) + (should (string= result "<tag>content<tag>")))) + +(ert-deftest test-surround-backticks () + "Should surround text with backticks for code." + (let ((result (test-surround "code" "`"))) + (should (string= result "`code`")))) + +(ert-deftest test-surround-triple-backticks () + "Should surround text with triple backticks." + (let ((result (test-surround "code block" "```"))) + (should (string= result "```code block```")))) + +(ert-deftest test-surround-custom-delimiter () + "Should surround text with custom delimiter." + (let ((result (test-surround "data" "||"))) + (should (string= result "||data||")))) + +;;; Normal Cases - Various Text Content + +(ert-deftest test-surround-single-word () + "Should surround single word." + (let ((result (test-surround "word" "\""))) + (should (string= result "\"word\"")))) + +(ert-deftest test-surround-multiple-words () + "Should surround multiple words." + (let ((result (test-surround "hello world" "\""))) + (should (string= result "\"hello world\"")))) + +(ert-deftest test-surround-sentence () + "Should surround full sentence." + (let ((result (test-surround "This is a sentence." "\""))) + (should (string= result "\"This is a sentence.\"")))) + +(ert-deftest test-surround-with-numbers () + "Should surround text with numbers." + (let ((result (test-surround "123" "'"))) + (should (string= result "'123'")))) + +(ert-deftest test-surround-with-special-chars () + "Should surround text with special characters." + (let ((result (test-surround "hello@world.com" "\""))) + (should (string= result "\"hello@world.com\"")))) + +;;; Normal Cases - Multiline Text + +(ert-deftest test-surround-multiline () + "Should surround multiline text." + (let ((result (test-surround "line1\nline2\nline3" "\""))) + (should (string= result "\"line1\nline2\nline3\"")))) + +(ert-deftest test-surround-text-with-newlines () + "Should surround text containing newlines." + (let ((result (test-surround "first\nsecond" "**"))) + (should (string= result "**first\nsecond**")))) + +;;; Boundary Cases + +(ert-deftest test-surround-empty-string () + "Should surround empty string." + (let ((result (test-surround "" "\""))) + (should (string= result "\"\"")))) + +(ert-deftest test-surround-single-character () + "Should surround single character." + (let ((result (test-surround "x" "\""))) + (should (string= result "\"x\"")))) + +(ert-deftest test-surround-empty-surround-string () + "Should handle empty surround string." + (let ((result (test-surround "hello" ""))) + (should (string= result "hello")))) + +(ert-deftest test-surround-very-long-text () + "Should surround very long text." + (let* ((long-text (make-string 1000 ?a)) + (result (test-surround long-text "\""))) + (should (string-prefix-p "\"" result)) + (should (string-suffix-p "\"" result)) + (should (= (length result) 1002)))) + +(ert-deftest test-surround-whitespace-only () + "Should surround whitespace-only text." + (let ((result (test-surround " " "\""))) + (should (string= result "\" \"")))) + +(ert-deftest test-surround-tabs () + "Should surround text with tabs." + (let ((result (test-surround "\t\ttext\t\t" "\""))) + (should (string= result "\"\t\ttext\t\t\"")))) + +;;; Edge Cases - Already Surrounded + +(ert-deftest test-surround-already-quoted () + "Should surround text that is already quoted." + (let ((result (test-surround "\"hello\"" "\""))) + (should (string= result "\"\"hello\"\"")))) + +(ert-deftest test-surround-nested () + "Should surround text creating nested delimiters." + (let ((result (test-surround "'inner'" "\""))) + (should (string= result "\"'inner'\"")))) + +;;; Edge Cases - Special Surround Strings + +(ert-deftest test-surround-space () + "Should surround text with spaces." + (let ((result (test-surround "text" " "))) + (should (string= result " text ")))) + +(ert-deftest test-surround-newline () + "Should surround text with newlines." + (let ((result (test-surround "text" "\n"))) + (should (string= result "\ntext\n")))) + +(ert-deftest test-surround-mixed-delimiters () + "Should surround with mixed delimiter string." + (let ((result (test-surround "content" "<>"))) + (should (string= result "<>content<>")))) + +(provide 'test-custom-text-enclose-surround) +;;; test-custom-text-enclose-surround.el ends here diff --git a/tests/test-custom-text-enclose-unwrap.el b/tests/test-custom-text-enclose-unwrap.el new file mode 100644 index 00000000..a308b644 --- /dev/null +++ b/tests/test-custom-text-enclose-unwrap.el @@ -0,0 +1,266 @@ +;;; test-custom-text-enclose-unwrap.el --- Tests for cj/--unwrap -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--unwrap function from custom-text-enclose.el +;; +;; This function removes surrounding delimiters from text. +;; It checks if text starts with opening and ends with closing, +;; and if so, removes them. +;; +;; Examples: +;; Input: "(text)", opening: "(", closing: ")" +;; Output: "text" +;; +;; Input: "<div>content</div>", opening: "<div>", closing: "</div>" +;; Output: "content" +;; +;; We test the NON-INTERACTIVE implementation (cj/--unwrap) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-unwrap (text opening closing) + "Test cj/--unwrap on TEXT with OPENING and CLOSING. +Returns the transformed string." + (cj/--unwrap text opening closing)) + +;;; Normal Cases - Common Bracket Types + +(ert-deftest test-unwrap-parentheses () + "Should unwrap text with parentheses." + (let ((result (test-unwrap "(text)" "(" ")"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-square-brackets () + "Should unwrap text with square brackets." + (let ((result (test-unwrap "[item]" "[" "]"))) + (should (string= result "item")))) + +(ert-deftest test-unwrap-curly-braces () + "Should unwrap text with curly braces." + (let ((result (test-unwrap "{code}" "{" "}"))) + (should (string= result "code")))) + +(ert-deftest test-unwrap-angle-brackets () + "Should unwrap text with angle brackets." + (let ((result (test-unwrap "<tag>" "<" ">"))) + (should (string= result "tag")))) + +;;; Normal Cases - HTML/XML Tags + +(ert-deftest test-unwrap-html-div () + "Should unwrap HTML div tags." + (let ((result (test-unwrap "<div>content</div>" "<div>" "</div>"))) + (should (string= result "content")))) + +(ert-deftest test-unwrap-html-span () + "Should unwrap HTML span tags." + (let ((result (test-unwrap "<span>text</span>" "<span>" "</span>"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-xml-tag () + "Should unwrap XML tags." + (let ((result (test-unwrap "<item>data</item>" "<item>" "</item>"))) + (should (string= result "data")))) + +(ert-deftest test-unwrap-html-with-attributes () + "Should unwrap HTML tag containing attributes." + (let ((result (test-unwrap "<a href=\"url\">link</a>" "<a href=\"url\">" "</a>"))) + (should (string= result "link")))) + +;;; Normal Cases - Markdown Syntax + +(ert-deftest test-unwrap-markdown-bold () + "Should unwrap markdown bold syntax." + (let ((result (test-unwrap "**bold**" "**" "**"))) + (should (string= result "bold")))) + +(ert-deftest test-unwrap-markdown-italic () + "Should unwrap markdown italic syntax." + (let ((result (test-unwrap "*italic*" "*" "*"))) + (should (string= result "italic")))) + +(ert-deftest test-unwrap-markdown-code () + "Should unwrap markdown code syntax." + (let ((result (test-unwrap "`code`" "`" "`"))) + (should (string= result "code")))) + +(ert-deftest test-unwrap-quotes () + "Should unwrap double quotes." + (let ((result (test-unwrap "\"text\"" "\"" "\""))) + (should (string= result "text")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-unwrap-single-word () + "Should unwrap single word." + (let ((result (test-unwrap "(word)" "(" ")"))) + (should (string= result "word")))) + +(ert-deftest test-unwrap-multiple-words () + "Should unwrap multiple words." + (let ((result (test-unwrap "(hello world)" "(" ")"))) + (should (string= result "hello world")))) + +(ert-deftest test-unwrap-sentence () + "Should unwrap full sentence." + (let ((result (test-unwrap "(This is a sentence.)" "(" ")"))) + (should (string= result "This is a sentence.")))) + +(ert-deftest test-unwrap-with-numbers () + "Should unwrap text with numbers." + (let ((result (test-unwrap "[123]" "[" "]"))) + (should (string= result "123")))) + +(ert-deftest test-unwrap-with-special-chars () + "Should unwrap text with special characters." + (let ((result (test-unwrap "<hello@world.com>" "<" ">"))) + (should (string= result "hello@world.com")))) + +;;; Normal Cases - Multiline Text + +(ert-deftest test-unwrap-multiline () + "Should unwrap multiline text." + (let ((result (test-unwrap "<div>line1\nline2\nline3</div>" "<div>" "</div>"))) + (should (string= result "line1\nline2\nline3")))) + +(ert-deftest test-unwrap-text-with-newlines () + "Should unwrap text containing newlines." + (let ((result (test-unwrap "(first\nsecond)" "(" ")"))) + (should (string= result "first\nsecond")))) + +;;; Boundary Cases - No Match + +(ert-deftest test-unwrap-no-opening () + "Should not unwrap when opening is missing." + (let ((result (test-unwrap "text)" "(" ")"))) + (should (string= result "text)")))) + +(ert-deftest test-unwrap-no-closing () + "Should not unwrap when closing is missing." + (let ((result (test-unwrap "(text" "(" ")"))) + (should (string= result "(text")))) + +(ert-deftest test-unwrap-neither-delimiter () + "Should not unwrap when neither delimiter is present." + (let ((result (test-unwrap "text" "(" ")"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-wrong-opening () + "Should not unwrap with wrong opening delimiter." + (let ((result (test-unwrap "[text)" "(" ")"))) + (should (string= result "[text)")))) + +(ert-deftest test-unwrap-wrong-closing () + "Should not unwrap with wrong closing delimiter." + (let ((result (test-unwrap "(text]" "(" ")"))) + (should (string= result "(text]")))) + +;;; Boundary Cases - Empty + +(ert-deftest test-unwrap-empty-content () + "Should unwrap to empty string." + (let ((result (test-unwrap "()" "(" ")"))) + (should (string= result "")))) + +(ert-deftest test-unwrap-just-delimiters () + "Should unwrap when only delimiters present." + (let ((result (test-unwrap "[]" "[" "]"))) + (should (string= result "")))) + +(ert-deftest test-unwrap-empty-string () + "Should return empty string unchanged." + (let ((result (test-unwrap "" "(" ")"))) + (should (string= result "")))) + +(ert-deftest test-unwrap-too-short () + "Should not unwrap when text is shorter than delimiters." + (let ((result (test-unwrap "x" "<div>" "</div>"))) + (should (string= result "x")))) + +;;; Boundary Cases - Nested/Multiple + +(ert-deftest test-unwrap-nested-same () + "Should unwrap only outer layer of nested delimiters." + (let ((result (test-unwrap "((text))" "(" ")"))) + (should (string= result "(text)")))) + +(ert-deftest test-unwrap-nested-different () + "Should unwrap outer layer with different inner delimiters." + (let ((result (test-unwrap "([text])" "(" ")"))) + (should (string= result "[text]")))) + +(ert-deftest test-unwrap-multiple-in-content () + "Should not unwrap when delimiters appear in content." + (let ((result (test-unwrap "(a)b(c)" "(" ")"))) + (should (string= result "a)b(c")))) + +;;; Edge Cases - Special Delimiters + +(ert-deftest test-unwrap-asymmetric-length () + "Should unwrap with different length delimiters." + (let ((result (test-unwrap "<<text>>>" "<<" ">>>"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-multi-char-delimiters () + "Should unwrap with multi-character delimiters." + (let ((result (test-unwrap "BEGINdataEND" "BEGIN" "END"))) + (should (string= result "data")))) + +(ert-deftest test-unwrap-space-delimiters () + "Should unwrap with space delimiters." + (let ((result (test-unwrap " text " " " " "))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-newline-delimiters () + "Should unwrap with newline delimiters." + (let ((result (test-unwrap "\ntext\n" "\n" "\n"))) + (should (string= result "text")))) + +;;; Edge Cases - Same Opening and Closing + +(ert-deftest test-unwrap-same-delimiters () + "Should unwrap when opening and closing are the same." + (let ((result (test-unwrap "*text*" "*" "*"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-same-multi-char () + "Should unwrap same multi-char delimiters." + (let ((result (test-unwrap "***text***" "***" "***"))) + (should (string= result "text")))) + +;;; Edge Cases - Empty Delimiters + +(ert-deftest test-unwrap-empty-opening () + "Should handle empty opening delimiter." + (let ((result (test-unwrap "text)" "" ")"))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-empty-closing () + "Should handle empty closing delimiter." + (let ((result (test-unwrap "(text" "(" ""))) + (should (string= result "text")))) + +(ert-deftest test-unwrap-both-delimiters-empty () + "Should return text unchanged when both delimiters empty." + (let ((result (test-unwrap "text" "" ""))) + (should (string= result "text")))) + +(provide 'test-custom-text-enclose-unwrap) +;;; test-custom-text-enclose-unwrap.el ends here diff --git a/tests/test-custom-text-enclose-wrap.el b/tests/test-custom-text-enclose-wrap.el new file mode 100644 index 00000000..f68a0668 --- /dev/null +++ b/tests/test-custom-text-enclose-wrap.el @@ -0,0 +1,240 @@ +;;; test-custom-text-enclose-wrap.el --- Tests for cj/--wrap -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--wrap function from custom-text-enclose.el +;; +;; This function wraps text with different opening and closing strings. +;; Unlike surround which uses the same string on both sides, wrap allows +;; asymmetric delimiters. +;; +;; Examples: +;; Input: "content", opening: "<div>", closing: "</div>" +;; Output: "<div>content</div>" +;; +;; Input: "text", opening: "(", closing: ")" +;; Output: "(text)" +;; +;; We test the NON-INTERACTIVE implementation (cj/--wrap) to avoid +;; mocking user input. This follows our testing best practice of +;; separating business logic from UI interaction. + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Stub dependencies before loading the module +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +;; Now load the actual production module +(require 'custom-text-enclose) + +;;; Test Helpers + +(defun test-wrap (text opening closing) + "Test cj/--wrap on TEXT with OPENING and CLOSING. +Returns the transformed string." + (cj/--wrap text opening closing)) + +;;; Normal Cases - Common Bracket Types + +(ert-deftest test-wrap-parentheses () + "Should wrap text with parentheses." + (let ((result (test-wrap "text" "(" ")"))) + (should (string= result "(text)")))) + +(ert-deftest test-wrap-square-brackets () + "Should wrap text with square brackets." + (let ((result (test-wrap "item" "[" "]"))) + (should (string= result "[item]")))) + +(ert-deftest test-wrap-curly-braces () + "Should wrap text with curly braces." + (let ((result (test-wrap "code" "{" "}"))) + (should (string= result "{code}")))) + +(ert-deftest test-wrap-angle-brackets () + "Should wrap text with angle brackets." + (let ((result (test-wrap "tag" "<" ">"))) + (should (string= result "<tag>")))) + +;;; Normal Cases - HTML/XML Tags + +(ert-deftest test-wrap-html-div () + "Should wrap text with HTML div tags." + (let ((result (test-wrap "content" "<div>" "</div>"))) + (should (string= result "<div>content</div>")))) + +(ert-deftest test-wrap-html-span () + "Should wrap text with HTML span tags." + (let ((result (test-wrap "text" "<span>" "</span>"))) + (should (string= result "<span>text</span>")))) + +(ert-deftest test-wrap-xml-tag () + "Should wrap text with XML tags." + (let ((result (test-wrap "data" "<item>" "</item>"))) + (should (string= result "<item>data</item>")))) + +(ert-deftest test-wrap-html-with-attributes () + "Should wrap text with HTML tag containing attributes." + (let ((result (test-wrap "link" "<a href=\"url\">" "</a>"))) + (should (string= result "<a href=\"url\">link</a>")))) + +;;; Normal Cases - Markdown Syntax + +(ert-deftest test-wrap-markdown-bold () + "Should wrap text with markdown bold syntax." + (let ((result (test-wrap "bold" "**" "**"))) + (should (string= result "**bold**")))) + +(ert-deftest test-wrap-markdown-italic () + "Should wrap text with markdown italic syntax." + (let ((result (test-wrap "italic" "*" "*"))) + (should (string= result "*italic*")))) + +(ert-deftest test-wrap-markdown-code () + "Should wrap text with markdown code syntax." + (let ((result (test-wrap "code" "`" "`"))) + (should (string= result "`code`")))) + +(ert-deftest test-wrap-markdown-link () + "Should wrap text with markdown link syntax." + (let ((result (test-wrap "text" "[" "](url)"))) + (should (string= result "[text](url)")))) + +;;; Normal Cases - Various Content + +(ert-deftest test-wrap-single-word () + "Should wrap single word." + (let ((result (test-wrap "word" "(" ")"))) + (should (string= result "(word)")))) + +(ert-deftest test-wrap-multiple-words () + "Should wrap multiple words." + (let ((result (test-wrap "hello world" "(" ")"))) + (should (string= result "(hello world)")))) + +(ert-deftest test-wrap-sentence () + "Should wrap full sentence." + (let ((result (test-wrap "This is a sentence." "(" ")"))) + (should (string= result "(This is a sentence.)")))) + +(ert-deftest test-wrap-with-numbers () + "Should wrap text with numbers." + (let ((result (test-wrap "123" "[" "]"))) + (should (string= result "[123]")))) + +(ert-deftest test-wrap-with-special-chars () + "Should wrap text with special characters." + (let ((result (test-wrap "hello@world.com" "<" ">"))) + (should (string= result "<hello@world.com>")))) + +;;; Normal Cases - Multiline Text + +(ert-deftest test-wrap-multiline () + "Should wrap multiline text." + (let ((result (test-wrap "line1\nline2\nline3" "<div>" "</div>"))) + (should (string= result "<div>line1\nline2\nline3</div>")))) + +(ert-deftest test-wrap-text-with-newlines () + "Should wrap text containing newlines." + (let ((result (test-wrap "first\nsecond" "(" ")"))) + (should (string= result "(first\nsecond)")))) + +;;; Boundary Cases + +(ert-deftest test-wrap-empty-string () + "Should wrap empty string." + (let ((result (test-wrap "" "(" ")"))) + (should (string= result "()")))) + +(ert-deftest test-wrap-single-character () + "Should wrap single character." + (let ((result (test-wrap "x" "[" "]"))) + (should (string= result "[x]")))) + +(ert-deftest test-wrap-empty-opening () + "Should handle empty opening delimiter." + (let ((result (test-wrap "text" "" ")"))) + (should (string= result "text)")))) + +(ert-deftest test-wrap-empty-closing () + "Should handle empty closing delimiter." + (let ((result (test-wrap "text" "(" ""))) + (should (string= result "(text")))) + +(ert-deftest test-wrap-both-empty () + "Should handle both delimiters empty." + (let ((result (test-wrap "text" "" ""))) + (should (string= result "text")))) + +(ert-deftest test-wrap-very-long-text () + "Should wrap very long text." + (let* ((long-text (make-string 1000 ?a)) + (result (test-wrap long-text "(" ")"))) + (should (string-prefix-p "(" result)) + (should (string-suffix-p ")" result)) + (should (= (length result) 1002)))) + +(ert-deftest test-wrap-whitespace-only () + "Should wrap whitespace-only text." + (let ((result (test-wrap " " "(" ")"))) + (should (string= result "( )")))) + +(ert-deftest test-wrap-tabs () + "Should wrap text with tabs." + (let ((result (test-wrap "\t\ttext\t\t" "[" "]"))) + (should (string= result "[\t\ttext\t\t]")))) + +;;; Edge Cases - Already Wrapped + +(ert-deftest test-wrap-already-wrapped () + "Should wrap text that is already wrapped." + (let ((result (test-wrap "(hello)" "[" "]"))) + (should (string= result "[(hello)]")))) + +(ert-deftest test-wrap-nested () + "Should wrap text creating nested delimiters." + (let ((result (test-wrap "[inner]" "(" ")"))) + (should (string= result "([inner])")))) + +;;; Edge Cases - Special Delimiters + +(ert-deftest test-wrap-asymmetric-length () + "Should wrap with different length delimiters." + (let ((result (test-wrap "text" "<<" ">>>"))) + (should (string= result "<<text>>>")))) + +(ert-deftest test-wrap-multi-char-delimiters () + "Should wrap with multi-character delimiters." + (let ((result (test-wrap "data" "BEGIN" "END"))) + (should (string= result "BEGINdataEND")))) + +(ert-deftest test-wrap-space-delimiters () + "Should wrap with space delimiters." + (let ((result (test-wrap "text" " " " "))) + (should (string= result " text ")))) + +(ert-deftest test-wrap-newline-delimiters () + "Should wrap with newline delimiters." + (let ((result (test-wrap "text" "\n" "\n"))) + (should (string= result "\ntext\n")))) + +(ert-deftest test-wrap-quote-delimiters () + "Should wrap with quote delimiters." + (let ((result (test-wrap "text" "\"" "\""))) + (should (string= result "\"text\"")))) + +;;; Edge Cases - Same Opening and Closing + +(ert-deftest test-wrap-same-delimiters () + "Should work like surround when delimiters are the same." + (let ((result (test-wrap "text" "*" "*"))) + (should (string= result "*text*")))) + +(provide 'test-custom-text-enclose-wrap) +;;; test-custom-text-enclose-wrap.el ends here diff --git a/tests/test-jumper.el b/tests/test-jumper.el new file mode 100644 index 00000000..fa65d3f4 --- /dev/null +++ b/tests/test-jumper.el @@ -0,0 +1,352 @@ +;;; test-jumper.el --- Tests for jumper.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for jumper.el - location navigation using registers. +;; +;; Testing approach: +;; - Tests focus on internal `jumper--do-*` functions (pure business logic) +;; - Interactive wrappers are thin UI layers and tested minimally +;; - Each test is isolated with setup/teardown to reset global state +;; - Tests verify return values, not user messages + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module +(require 'jumper) + +;;; Test Utilities + +(defvar test-jumper--original-registers nil + "Backup of jumper registers before test.") + +(defvar test-jumper--original-index nil + "Backup of jumper index before test.") + +(defun test-jumper-setup () + "Reset jumper state before each test." + ;; Backup current state + (setq test-jumper--original-registers jumper--registers) + (setq test-jumper--original-index jumper--next-index) + ;; Reset to clean state + (setq jumper--registers (make-vector jumper-max-locations nil)) + (setq jumper--next-index 0)) + +(defun test-jumper-teardown () + "Restore jumper state after each test." + (setq jumper--registers test-jumper--original-registers) + (setq jumper--next-index test-jumper--original-index)) + +;;; Normal Cases - Store Location + +(ert-deftest test-jumper-store-first-location () + "Should store first location and return register character." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + (let ((result (jumper--do-store-location))) + (should (= result ?0)) + (should (= jumper--next-index 1)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-multiple-locations () + "Should store multiple locations in sequence." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?0)) + (forward-line 1) + (should (= (jumper--do-store-location) ?1)) + (forward-line 1) + (should (= (jumper--do-store-location) ?2)) + (should (= jumper--next-index 3))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-duplicate-location () + "Should detect and reject duplicate locations." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?0)) + (should (eq (jumper--do-store-location) 'already-exists)) + (should (= jumper--next-index 1))) + (test-jumper-teardown)) + +;;; Normal Cases - Jump to Location + +(ert-deftest test-jumper-jump-to-stored-location () + "Should jump to a previously stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + (goto-char (point-max)) + (let ((result (jumper--do-jump-to-location 0))) + (should (eq result 'jumped)) + (should (= (point) (point-min))))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-toggle-with-single-location () + "Should toggle between current and stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + ;; Move away + (goto-char (point-max)) + ;; Toggle should jump back + (let ((result (jumper--do-jump-to-location nil))) + (should (eq result 'jumped)) + (should (= (point) (point-min))))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-already-at-location () + "Should detect when already at the only stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + ;; Try to toggle while at the location + (let ((result (jumper--do-jump-to-location nil))) + (should (eq result 'already-there)))) + (test-jumper-teardown)) + +;;; Normal Cases - Remove Location + +(ert-deftest test-jumper-remove-location () + "Should remove a stored location." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((result (jumper--do-remove-location 0))) + (should (eq result t)) + (should (= jumper--next-index 0)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-remove-reorders-registers () + "Should reorder registers after removal from middle." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) ; Register 0 + (forward-line 1) + (jumper--do-store-location) ; Register 1 + (forward-line 1) + (jumper--do-store-location) ; Register 2 + ;; Remove middle (index 1) + (jumper--do-remove-location 1) + (should (= jumper--next-index 2)) + ;; What was at index 2 should now be at index 1 + (should (= (aref jumper--registers 1) ?2))) + (test-jumper-teardown)) + +;;; Boundary Cases - Store Location + +(ert-deftest test-jumper-store-at-capacity () + "Should successfully store location at maximum capacity." + (test-jumper-setup) + (with-temp-buffer + (insert "test content") + (goto-char (point-min)) + ;; Fill to capacity + (dotimes (i jumper-max-locations) + (forward-char 1) + (should (= (jumper--do-store-location) (+ ?0 i)))) + (should (= jumper--next-index jumper-max-locations))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-when-full () + "Should return 'no-space when all registers are full." + (test-jumper-setup) + (with-temp-buffer + (insert "01234567890123456789") + (goto-char (point-min)) + ;; Fill to capacity + (dotimes (i jumper-max-locations) + (forward-char 1) + (jumper--do-store-location)) + ;; Try to store one more + (forward-char 1) + (should (eq (jumper--do-store-location) 'no-space)) + (should (= jumper--next-index jumper-max-locations))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-store-in-different-buffers () + "Should store locations across different buffers." + (test-jumper-setup) + (with-temp-buffer + (insert "buffer 1") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?0)) + (with-temp-buffer + (insert "buffer 2") + (goto-char (point-min)) + (should (= (jumper--do-store-location) ?1)) + (should (= jumper--next-index 2)))) + (test-jumper-teardown)) + +;;; Boundary Cases - Jump to Location + +(ert-deftest test-jumper-jump-with-no-locations () + "Should return 'no-locations when nothing is stored." + (test-jumper-setup) + (with-temp-buffer + (insert "test") + (let ((result (jumper--do-jump-to-location 0))) + (should (eq result 'no-locations)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-to-first-location () + "Should jump to location at index 0." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (goto-char (point-max)) + (jumper--do-jump-to-location 0) + (should (= (point) (point-min)))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-to-last-location () + "Should jump to last location (register 'z)." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((line2-pos (line-beginning-position 2))) + (goto-char line2-pos) + ;; Jump to location 0 (this stores current location in 'z) + (jumper--do-jump-to-location 0) + (should (= (point) (point-min))) + ;; Jump to last location should go back to line 2 + (let ((result (jumper--do-jump-to-location -1))) + (should (eq result 'jumped)) + (should (= (point) line2-pos))))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-jump-to-max-index () + "Should jump to location at maximum index." + (test-jumper-setup) + (with-temp-buffer + (insert "0123456789012345678") + (goto-char (point-min)) + ;; Store at all positions + (dotimes (i jumper-max-locations) + (forward-char 1) + (jumper--do-store-location)) + (goto-char (point-min)) + ;; Jump to last one (index 9, which is at position 10) + (jumper--do-jump-to-location (1- jumper-max-locations)) + (should (= (point) (1+ jumper-max-locations)))) + (test-jumper-teardown)) + +;;; Boundary Cases - Remove Location + +(ert-deftest test-jumper-remove-first-location () + "Should remove location at index 0." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (jumper--do-remove-location 0) + (should (= jumper--next-index 1)) + ;; What was at index 1 should now be at index 0 + (should (= (aref jumper--registers 0) ?1))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-remove-last-location () + "Should remove location at last index." + (test-jumper-setup) + (with-temp-buffer + (insert "line 1\nline 2\nline 3") + (goto-char (point-min)) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (forward-line 1) + (jumper--do-store-location) + (jumper--do-remove-location 2) + (should (= jumper--next-index 2))) + (test-jumper-teardown)) + +(ert-deftest test-jumper-remove-with-cancel () + "Should return 'cancelled when index is -1." + (test-jumper-setup) + (with-temp-buffer + (insert "test") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((result (jumper--do-remove-location -1))) + (should (eq result 'cancelled)) + (should (= jumper--next-index 1)))) + (test-jumper-teardown)) + +;;; Error Cases + +(ert-deftest test-jumper-remove-when-empty () + "Should return 'no-locations when removing from empty list." + (test-jumper-setup) + (let ((result (jumper--do-remove-location 0))) + (should (eq result 'no-locations))) + (test-jumper-teardown)) + +;;; Helper Function Tests + +(ert-deftest test-jumper-location-key-format () + "Should generate unique location keys." + (with-temp-buffer + (insert "line 1\nline 2") + (goto-char (point-min)) + (let ((key1 (jumper--location-key))) + (forward-line 1) + (let ((key2 (jumper--location-key))) + (should-not (string= key1 key2)) + ;; Keys should contain buffer name and position info + (should (string-match-p ":" key1)) + (should (string-match-p ":" key2)))))) + +(ert-deftest test-jumper-register-available-p () + "Should correctly report register availability." + (test-jumper-setup) + (should (jumper--register-available-p)) + ;; Fill to capacity + (setq jumper--next-index jumper-max-locations) + (should-not (jumper--register-available-p)) + (test-jumper-teardown)) + +(ert-deftest test-jumper-format-location () + "Should format location for display." + (test-jumper-setup) + (with-temp-buffer + (insert "test line with some content") + (goto-char (point-min)) + (jumper--do-store-location) + (let ((formatted (jumper--format-location 0))) + (should formatted) + (should (string-match-p "\\[0\\]" formatted)) + (should (string-match-p "test line" formatted)))) + (test-jumper-teardown)) + +(provide 'test-jumper) +;;; test-jumper.el ends here diff --git a/tests/test-lorem-optimum-benchmark.el b/tests/test-lorem-optimum-benchmark.el new file mode 100644 index 00000000..d3ca2873 --- /dev/null +++ b/tests/test-lorem-optimum-benchmark.el @@ -0,0 +1,227 @@ +;;; test-lorem-optimum-benchmark.el --- Performance tests for lorem-optimum.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Benchmark and performance tests for the Markov chain implementation. +;; +;; These tests measure: +;; - Learning time scaling with input size +;; - Multiple learning operations (exposes key rebuild overhead) +;; - Generation time scaling +;; - Memory usage (hash table growth) +;; +;; Performance baseline targets (on modern hardware): +;; - Learn 1000 words: < 10ms +;; - Learn 10,000 words: < 100ms +;; - 100 learn operations of 100 words each: < 500ms (current bottleneck!) +;; - Generate 100 words: < 5ms + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module +(require 'lorem-optimum) + +;;; Benchmark Helpers + +(defun benchmark-time (func) + "Time execution of FUNC and return milliseconds." + (let ((start (current-time))) + (funcall func) + (let ((end (current-time))) + (* 1000.0 (float-time (time-subtract end start)))))) + +(defun generate-test-text (word-count) + "Generate WORD-COUNT words of test text with some repetition." + (let ((words '("lorem" "ipsum" "dolor" "sit" "amet" "consectetur" + "adipiscing" "elit" "sed" "do" "eiusmod" "tempor" + "incididunt" "ut" "labore" "et" "dolore" "magna" "aliqua")) + (result '())) + (dotimes (i word-count) + (push (nth (mod i (length words)) words) result) + (when (zerop (mod i 10)) + (push "." result))) + (mapconcat #'identity (nreverse result) " "))) + +(defun benchmark-report (name time-ms) + "Report benchmark NAME with TIME-MS." + (message "BENCHMARK [%s]: %.2f ms" name time-ms)) + +;;; Learning Performance Tests + +(ert-deftest benchmark-learn-1k-words () + "Benchmark learning 1000 words." + (let* ((text (generate-test-text 1000)) + (chain (cj/markov-chain-create)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Learn 1K words" time) + (should (< time 50.0)))) ; Should be < 50ms + +(ert-deftest benchmark-learn-10k-words () + "Benchmark learning 10,000 words." + (let* ((text (generate-test-text 10000)) + (chain (cj/markov-chain-create)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Learn 10K words" time) + (should (< time 500.0)))) ; Should be < 500ms + +(ert-deftest benchmark-learn-100k-words () + "Benchmark learning 100,000 words (stress test)." + :tags '(:slow) + (let* ((text (generate-test-text 100000)) + (chain (cj/markov-chain-create)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Learn 100K words" time) + ;; This may be slow due to key rebuild + (message "Hash table size: %d bigrams" + (hash-table-count (cj/markov-chain-map chain))))) + +;;; Multiple Learning Operations (Exposes Quadratic Behavior) + +(ert-deftest benchmark-multiple-learns-10x100 () + "Benchmark 10 learn operations of 100 words each." + (let ((chain (cj/markov-chain-create)) + (times '())) + (dotimes (i 10) + (let* ((text (generate-test-text 100)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (push time times))) + (let ((total (apply #'+ times)) + (avg (/ (apply #'+ times) 10.0)) + (max-time (apply #'max times))) + (benchmark-report "10x learn 100 words - TOTAL" total) + (benchmark-report "10x learn 100 words - AVG" avg) + (benchmark-report "10x learn 100 words - MAX" max-time) + (message "Times: %S" (nreverse times)) + ;; Note: Watch if later operations are slower (quadratic behavior) + (should (< total 100.0))))) ; Total should be < 100ms + +(ert-deftest benchmark-multiple-learns-100x100 () + "Benchmark 100 learn operations of 100 words each (key rebuild overhead)." + :tags '(:slow) + (let ((chain (cj/markov-chain-create)) + (times '()) + (measurements '())) + (dotimes (i 100) + (let* ((text (generate-test-text 100)) + (time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (push time times) + ;; Sample measurements every 10 iterations + (when (zerop (mod i 10)) + (push (cons i time) measurements)))) + (let ((total (apply #'+ times)) + (avg (/ (apply #'+ times) 100.0)) + (first-10-avg (/ (apply #'+ (last times 10)) 10.0)) + (last-10-avg (/ (apply #'+ (seq-take times 10)) 10.0))) + (benchmark-report "100x learn 100 words - TOTAL" total) + (benchmark-report "100x learn 100 words - AVG" avg) + (benchmark-report "100x learn - First 10 AVG" first-10-avg) + (benchmark-report "100x learn - Last 10 AVG" last-10-avg) + (message "Sampled times (iteration, ms): %S" (nreverse measurements)) + (message "Hash table size: %d bigrams" + (hash-table-count (cj/markov-chain-map chain))) + ;; This exposes the quadratic behavior: last operations much slower + (when (> last-10-avg (* 2.0 first-10-avg)) + (message "WARNING: Learning slows down significantly over time!") + (message " First 10 avg: %.2f ms" first-10-avg) + (message " Last 10 avg: %.2f ms" last-10-avg) + (message " Ratio: %.1fx slower" (/ last-10-avg first-10-avg)))))) + +;;; Generation Performance Tests + +(ert-deftest benchmark-generate-100-words () + "Benchmark generating 100 words." + (let* ((text (generate-test-text 1000)) + (chain (cj/markov-chain-create))) + (cj/markov-learn chain text) + (let ((time (benchmark-time + (lambda () (cj/markov-generate chain 100))))) + (benchmark-report "Generate 100 words" time) + (should (< time 20.0))))) ; Should be < 20ms + +(ert-deftest benchmark-generate-1000-words () + "Benchmark generating 1000 words." + (let* ((text (generate-test-text 10000)) + (chain (cj/markov-chain-create))) + (cj/markov-learn chain text) + (let ((time (benchmark-time + (lambda () (cj/markov-generate chain 1000))))) + (benchmark-report "Generate 1000 words" time) + (should (< time 100.0))))) ; Should be < 100ms + +;;; Tokenization Performance Tests + +(ert-deftest benchmark-tokenize-10k-words () + "Benchmark tokenizing 10,000 words." + (let* ((text (generate-test-text 10000)) + (time (benchmark-time + (lambda () (cj/markov-tokenize text))))) + (benchmark-report "Tokenize 10K words" time) + (should (< time 50.0)))) ; Tokenization should be fast + +;;; Memory/Size Tests + +(ert-deftest benchmark-chain-growth () + "Measure hash table growth with increasing input." + (let ((chain (cj/markov-chain-create)) + (sizes '())) + (dolist (word-count '(100 500 1000 5000 10000)) + (let ((text (generate-test-text word-count))) + (cj/markov-learn chain text) + (let ((size (hash-table-count (cj/markov-chain-map chain)))) + (push (cons word-count size) sizes) + (message "After %d words: %d unique bigrams" word-count size)))) + (message "Growth pattern: %S" (nreverse sizes)))) + +;;; Comparison: Tokenization vs Learning + +(ert-deftest benchmark-tokenize-vs-learn () + "Compare tokenization time to total learning time." + (let* ((text (generate-test-text 5000)) + (tokenize-time (benchmark-time + (lambda () (cj/markov-tokenize text)))) + (chain (cj/markov-chain-create)) + (learn-time (benchmark-time + (lambda () (cj/markov-learn chain text))))) + (benchmark-report "Tokenize 5K words" tokenize-time) + (benchmark-report "Learn 5K words (total)" learn-time) + (message "Tokenization is %.1f%% of total learning time" + (* 100.0 (/ tokenize-time learn-time))))) + +;;; Real-world Scenario + +(ert-deftest benchmark-realistic-usage () + "Benchmark realistic usage: learn from multiple sources, generate paragraphs." + (let ((chain (cj/markov-chain-create)) + (learn-total 0.0) + (gen-total 0.0)) + ;; Simulate learning from 10 different sources + (dotimes (i 10) + (let ((text (generate-test-text 500))) + (setq learn-total + (+ learn-total + (benchmark-time (lambda () (cj/markov-learn chain text))))))) + + ;; Generate 5 paragraphs + (dotimes (i 5) + (setq gen-total + (+ gen-total + (benchmark-time (lambda () (cj/markov-generate chain 50)))))) + + (benchmark-report "Realistic: 10 learns (500 words each)" learn-total) + (benchmark-report "Realistic: 5 generations (50 words each)" gen-total) + (benchmark-report "Realistic: TOTAL TIME" (+ learn-total gen-total)) + (message "Final chain size: %d bigrams" + (hash-table-count (cj/markov-chain-map chain))))) + +(provide 'test-lorem-optimum-benchmark) +;;; test-lorem-optimum-benchmark.el ends here diff --git a/tests/test-lorem-optimum.el b/tests/test-lorem-optimum.el new file mode 100644 index 00000000..ca2e52f4 --- /dev/null +++ b/tests/test-lorem-optimum.el @@ -0,0 +1,242 @@ +;;; test-lorem-optimum.el --- Tests for lorem-optimum.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for lorem-optimum.el Markov chain text generation. +;; +;; Tests cover: +;; - Tokenization +;; - Learning and chain building +;; - Text generation +;; - Capitalization fixing +;; - Token joining + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module +(require 'lorem-optimum) + +;;; Test Helpers + +(defun test-chain () + "Create a fresh test chain." + (cj/markov-chain-create)) + +(defun test-learn (text) + "Create a chain and learn TEXT." + (let ((chain (test-chain))) + (cj/markov-learn chain text) + chain)) + +;;; Tokenization Tests + +(ert-deftest test-tokenize-simple () + "Should tokenize simple words." + (let ((result (cj/markov-tokenize "hello world"))) + (should (equal result '("hello" "world"))))) + +(ert-deftest test-tokenize-with-punctuation () + "Should separate punctuation as tokens." + (let ((result (cj/markov-tokenize "Hello, world!"))) + (should (equal result '("Hello" "," "world" "!"))))) + +(ert-deftest test-tokenize-multiple-spaces () + "Should handle multiple spaces." + (let ((result (cj/markov-tokenize "hello world"))) + (should (equal result '("hello" "world"))))) + +(ert-deftest test-tokenize-newlines () + "Should handle newlines as whitespace." + (let ((result (cj/markov-tokenize "hello\nworld"))) + (should (equal result '("hello" "world"))))) + +(ert-deftest test-tokenize-mixed-punctuation () + "Should tokenize complex punctuation." + (let ((result (cj/markov-tokenize "one, two; three."))) + (should (equal result '("one" "," "two" ";" "three" "."))))) + +(ert-deftest test-tokenize-empty () + "Should handle empty string." + (let ((result (cj/markov-tokenize ""))) + (should (null result)))) + +(ert-deftest test-tokenize-whitespace-only () + "Should return nil for whitespace only." + (let ((result (cj/markov-tokenize " \n\t "))) + (should (null result)))) + +;;; Markov Learn Tests + +(ert-deftest test-learn-basic () + "Should learn simple text." + (let ((chain (test-learn "one two three four"))) + (should (cj/markov-chain-p chain)) + (should (> (hash-table-count (cj/markov-chain-map chain)) 0)))) + +(ert-deftest test-learn-creates-bigrams () + "Should create bigram mappings." + (let ((chain (test-learn "one two three"))) + (should (gethash '("one" "two") (cj/markov-chain-map chain))))) + +(ert-deftest test-learn-stores-following-word () + "Should store following word for bigram." + (let ((chain (test-learn "one two three"))) + (should (member "three" (gethash '("one" "two") (cj/markov-chain-map chain)))))) + +(ert-deftest test-learn-builds-keys-list () + "Should build keys list lazily when accessed." + (let ((chain (test-learn "one two three four"))) + ;; Keys are built lazily, so initially nil + (should (null (cj/markov-chain-keys chain))) + ;; After calling random-key, keys should be built + (cj/markov-random-key chain) + (should (> (length (cj/markov-chain-keys chain)) 0)))) + +(ert-deftest test-learn-repeated-patterns () + "Should accumulate repeated patterns." + (let ((chain (test-learn "one two three one two four"))) + (let ((nexts (gethash '("one" "two") (cj/markov-chain-map chain)))) + (should (= (length nexts) 2)) + (should (member "three" nexts)) + (should (member "four" nexts))))) + +(ert-deftest test-learn-incremental () + "Should support incremental learning." + (let ((chain (test-chain))) + (cj/markov-learn chain "one two three") + (cj/markov-learn chain "four five six") + (should (> (hash-table-count (cj/markov-chain-map chain)) 0)))) + +;;; Token Joining Tests + +(ert-deftest test-join-simple-words () + "Should join words with spaces." + (let ((result (cj/markov-join-tokens '("hello" "world")))) + (should (string-match-p "^Hello world" result)))) + +(ert-deftest test-join-with-punctuation () + "Should attach punctuation without spaces." + (let ((result (cj/markov-join-tokens '("hello" "," "world")))) + (should (string-match-p "Hello, world" result)))) + +(ert-deftest test-join-capitalizes-first () + "Should capitalize first word." + (let ((result (cj/markov-join-tokens '("hello" "world")))) + (should (string-match-p "^H" result)))) + +(ert-deftest test-join-adds-period () + "Should add period if missing." + (let ((result (cj/markov-join-tokens '("hello" "world")))) + (should (string-match-p "\\.$" result)))) + +(ert-deftest test-join-preserves-existing-period () + "Should not double-add period." + (let ((result (cj/markov-join-tokens '("hello" "world" ".")))) + (should (string-match-p "\\.$" result)) + (should-not (string-match-p "\\.\\.$" result)))) + +(ert-deftest test-join-empty-tokens () + "Should handle empty token list." + (let ((result (cj/markov-join-tokens '()))) + (should (equal result ".")))) + +;;; Capitalization Tests + +(ert-deftest test-capitalize-first-word () + "Should capitalize first word." + (let ((result (cj/markov-fix-capitalization "hello world"))) + (should (string-match-p "^Hello" result)))) + +(ert-deftest test-capitalize-after-period () + "Should capitalize after period." + (let ((result (cj/markov-fix-capitalization "hello. world"))) + (should (string-match-p "Hello\\. World" result)))) + +(ert-deftest test-capitalize-after-exclamation () + "Should capitalize after exclamation." + (let ((result (cj/markov-fix-capitalization "hello! world"))) + (should (string-match-p "Hello! World" result)))) + +(ert-deftest test-capitalize-after-question () + "Should capitalize after question mark." + (let ((result (cj/markov-fix-capitalization "hello? world"))) + (should (string-match-p "Hello\\? World" result)))) + +(ert-deftest test-capitalize-skip-non-alpha () + "Should skip non-alphabetic tokens." + (let ((result (cj/markov-fix-capitalization "hello. 123 world"))) + (should (string-match-p "123" result)))) + +(ert-deftest test-capitalize-multiple-sentences () + "Should capitalize all sentences." + (let ((result (cj/markov-fix-capitalization "first. second. third"))) + (should (string-match-p "First\\. Second\\. Third" result)))) + +;;; Generation Tests (deterministic with fixed chain) + +(ert-deftest test-generate-produces-output () + "Should generate non-empty output." + (let ((chain (test-learn "Lorem ipsum dolor sit amet consectetur adipiscing elit"))) + (let ((result (cj/markov-generate chain 5))) + (should (stringp result)) + (should (> (length result) 0))))) + +(ert-deftest test-generate-empty-chain () + "Should handle empty chain gracefully." + (let ((chain (test-chain))) + (let ((result (cj/markov-generate chain 5))) + (should (or (null result) (string-empty-p result)))))) + +(ert-deftest test-generate-respects-start () + "Should use provided start state if available." + (let ((chain (test-learn "Lorem ipsum dolor sit amet"))) + (let ((result (cj/markov-generate chain 3 '("Lorem" "ipsum")))) + (should (stringp result)) + ;; Should start with Lorem or similar + (should (> (length result) 0))))) + +;;; Integration Tests + +(ert-deftest test-full-workflow () + "Should complete full learn-generate workflow." + (let ((chain (test-chain))) + (cj/markov-learn chain "The quick brown fox jumps over the lazy dog") + (let ((result (cj/markov-generate chain 8))) + (should (stringp result)) + (should (> (length result) 0)) + (should (string-match-p "^[A-Z]" result)) + (should (string-match-p "[.!?]$" result))))) + +(ert-deftest test-latin-like-output () + "Should generate Latin-like text from Latin input." + (let ((chain (test-chain))) + (cj/markov-learn chain "Lorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua.") + (let ((result (cj/markov-generate chain 10))) + (should (stringp result)) + (should (> (length result) 10))))) + +;;; Edge Cases + +(ert-deftest test-learn-short-text () + "Should handle text shorter than trigram." + (let ((chain (test-learn "one two"))) + (should (cj/markov-chain-p chain)))) + +(ert-deftest test-learn-single-word () + "Should handle single word." + (let ((chain (test-learn "word"))) + (should (cj/markov-chain-p chain)))) + +(ert-deftest test-generate-requested-count-small () + "Should handle small generation count." + (let ((chain (test-learn "one two three four five"))) + (let ((result (cj/markov-generate chain 2))) + (should (stringp result))))) + +(provide 'test-lorem-optimum) +;;; test-lorem-optimum.el ends here diff --git a/tests/test-org-contacts-parse-email.el b/tests/test-org-contacts-parse-email.el new file mode 100644 index 00000000..37e79fba --- /dev/null +++ b/tests/test-org-contacts-parse-email.el @@ -0,0 +1,219 @@ +;;; test-org-contacts-parse-email.el --- Tests for cj/--parse-email-string -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--parse-email-string function from org-contacts-config.el +;; +;; This function parses a string containing one or more email addresses +;; separated by commas, semicolons, or spaces, and formats them as +;; "Name <email>" strings. +;; +;; Examples: +;; Input: name="John Doe", email-string="john@example.com" +;; Output: '("John Doe <john@example.com>") +;; +;; Input: name="Jane Smith", email-string="jane@work.com, jane@home.com" +;; Output: '("Jane Smith <jane@work.com>" "Jane Smith <jane@home.com>") + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-contacts-config) + +;;; Test Helpers + +(defun test-parse-email (name email-string) + "Test cj/--parse-email-string with NAME and EMAIL-STRING. +Returns the formatted email list." + (cj/--parse-email-string name email-string)) + +;;; Normal Cases - Single Email + +(ert-deftest test-parse-single-email () + "Should format single email address." + (let ((result (test-parse-email "John Doe" "john@example.com"))) + (should (equal result '("John Doe <john@example.com>"))))) + +(ert-deftest test-parse-single-email-with-subdomain () + "Should handle email with subdomain." + (let ((result (test-parse-email "Jane Smith" "jane@mail.company.com"))) + (should (equal result '("Jane Smith <jane@mail.company.com>"))))) + +(ert-deftest test-parse-email-with-numbers () + "Should handle email containing numbers." + (let ((result (test-parse-email "User 123" "user123@test.com"))) + (should (equal result '("User 123 <user123@test.com>"))))) + +(ert-deftest test-parse-email-with-dots () + "Should handle email with dots in local part." + (let ((result (test-parse-email "Bob Jones" "bob.jones@example.com"))) + (should (equal result '("Bob Jones <bob.jones@example.com>"))))) + +(ert-deftest test-parse-email-with-hyphen () + "Should handle email with hyphens." + (let ((result (test-parse-email "Alice Brown" "alice-brown@test-domain.com"))) + (should (equal result '("Alice Brown <alice-brown@test-domain.com>"))))) + +;;; Normal Cases - Multiple Emails with Different Separators + +(ert-deftest test-parse-two-emails-comma () + "Should parse two emails separated by comma." + (let ((result (test-parse-email "John Doe" "john@work.com, john@home.com"))) + (should (equal result '("John Doe <john@work.com>" "John Doe <john@home.com>"))))) + +(ert-deftest test-parse-two-emails-semicolon () + "Should parse two emails separated by semicolon." + (let ((result (test-parse-email "Jane Smith" "jane@work.com; jane@home.com"))) + (should (equal result '("Jane Smith <jane@work.com>" "Jane Smith <jane@home.com>"))))) + +(ert-deftest test-parse-two-emails-space () + "Should parse two emails separated by space." + (let ((result (test-parse-email "Bob Jones" "bob@work.com bob@home.com"))) + (should (equal result '("Bob Jones <bob@work.com>" "Bob Jones <bob@home.com>"))))) + +(ert-deftest test-parse-three-emails-mixed-separators () + "Should parse emails with mixed separators." + (let ((result (test-parse-email "Alice" "alice@a.com, alice@b.com; alice@c.com"))) + (should (equal result '("Alice <alice@a.com>" "Alice <alice@b.com>" "Alice <alice@c.com>"))))) + +(ert-deftest test-parse-multiple-emails-with-spaces () + "Should parse comma-separated emails with spaces." + (let ((result (test-parse-email "User" "a@test.com , b@test.com , c@test.com"))) + (should (equal result '("User <a@test.com>" "User <b@test.com>" "User <c@test.com>"))))) + +;;; Normal Cases - Whitespace Handling + +(ert-deftest test-parse-email-leading-whitespace () + "Should trim leading whitespace from email." + (let ((result (test-parse-email "John" " john@example.com"))) + (should (equal result '("John <john@example.com>"))))) + +(ert-deftest test-parse-email-trailing-whitespace () + "Should trim trailing whitespace from email." + (let ((result (test-parse-email "Jane" "jane@example.com "))) + (should (equal result '("Jane <jane@example.com>"))))) + +(ert-deftest test-parse-email-surrounding-whitespace () + "Should trim surrounding whitespace from email." + (let ((result (test-parse-email "Bob" " bob@example.com "))) + (should (equal result '("Bob <bob@example.com>"))))) + +(ert-deftest test-parse-emails-with-tabs () + "Should handle emails separated by tabs." + (let ((result (test-parse-email "User" "a@test.com\tb@test.com"))) + (should (equal result '("User <a@test.com>" "User <b@test.com>"))))) + +;;; Edge Cases - Empty and Nil + +(ert-deftest test-parse-nil-email-string () + "Should return nil for nil email string." + (let ((result (test-parse-email "John Doe" nil))) + (should (null result)))) + +(ert-deftest test-parse-empty-email-string () + "Should return nil for empty email string." + (let ((result (test-parse-email "Jane Smith" ""))) + (should (null result)))) + +(ert-deftest test-parse-whitespace-only () + "Should return nil for whitespace-only string." + (let ((result (test-parse-email "Bob Jones" " "))) + (should (null result)))) + +(ert-deftest test-parse-tabs-only () + "Should return nil for tabs-only string." + (let ((result (test-parse-email "Alice" "\t\t\t"))) + (should (null result)))) + +(ert-deftest test-parse-mixed-whitespace-only () + "Should return nil for mixed whitespace." + (let ((result (test-parse-email "User" " \t \n "))) + (should (null result)))) + +;;; Edge Cases - Multiple Consecutive Separators + +(ert-deftest test-parse-multiple-commas () + "Should handle multiple consecutive commas." + (let ((result (test-parse-email "John" "john@a.com,,,john@b.com"))) + (should (equal result '("John <john@a.com>" "John <john@b.com>"))))) + +(ert-deftest test-parse-multiple-semicolons () + "Should handle multiple consecutive semicolons." + (let ((result (test-parse-email "Jane" "jane@a.com;;;jane@b.com"))) + (should (equal result '("Jane <jane@a.com>" "Jane <jane@b.com>"))))) + +(ert-deftest test-parse-multiple-spaces () + "Should handle multiple consecutive spaces." + (let ((result (test-parse-email "Bob" "bob@a.com bob@b.com"))) + (should (equal result '("Bob <bob@a.com>" "Bob <bob@b.com>"))))) + +(ert-deftest test-parse-mixed-multiple-separators () + "Should handle mixed consecutive separators." + (let ((result (test-parse-email "User" "a@test.com , ; b@test.com"))) + (should (equal result '("User <a@test.com>" "User <b@test.com>"))))) + +;;; Edge Cases - Special Name Formats + +(ert-deftest test-parse-name-with-title () + "Should handle name with title." + (let ((result (test-parse-email "Dr. John Smith" "john@example.com"))) + (should (equal result '("Dr. John Smith <john@example.com>"))))) + +(ert-deftest test-parse-name-with-suffix () + "Should handle name with suffix." + (let ((result (test-parse-email "John Doe Jr." "john@example.com"))) + (should (equal result '("John Doe Jr. <john@example.com>"))))) + +(ert-deftest test-parse-name-with-special-chars () + "Should handle name with special characters." + (let ((result (test-parse-email "O'Brien, Patrick" "patrick@example.com"))) + (should (equal result '("O'Brien, Patrick <patrick@example.com>"))))) + +(ert-deftest test-parse-unicode-name () + "Should handle Unicode characters in name." + (let ((result (test-parse-email "José García" "jose@example.com"))) + (should (equal result '("José García <jose@example.com>"))))) + +;;; Edge Cases - Special Email Formats + +(ert-deftest test-parse-email-with-plus () + "Should handle email with plus sign." + (let ((result (test-parse-email "User" "user+tag@example.com"))) + (should (equal result '("User <user+tag@example.com>"))))) + +(ert-deftest test-parse-email-with-underscore () + "Should handle email with underscore." + (let ((result (test-parse-email "User" "user_name@example.com"))) + (should (equal result '("User <user_name@example.com>"))))) + +(ert-deftest test-parse-very-long-email () + "Should handle very long email address." + (let* ((long-local (make-string 50 ?a)) + (email (concat long-local "@example.com")) + (result (test-parse-email "User" email))) + (should (equal result (list (format "User <%s>" email)))))) + +;;; Integration Tests + +(ert-deftest test-parse-realistic-contact () + "Should parse realistic contact with multiple emails." + (let ((result (test-parse-email "John Doe" "john.doe@company.com, jdoe@personal.com"))) + (should (equal result '("John Doe <john.doe@company.com>" "John Doe <jdoe@personal.com>"))))) + +(ert-deftest test-parse-messy-input () + "Should handle messy real-world input." + (let ((result (test-parse-email "Jane Smith" " jane@work.com ; jane@home.com,jane@mobile.com "))) + (should (equal result '("Jane Smith <jane@work.com>" "Jane Smith <jane@home.com>" "Jane Smith <jane@mobile.com>"))))) + +(ert-deftest test-parse-single-with-extra-separators () + "Should handle single email with trailing separators." + (let ((result (test-parse-email "Bob" "bob@example.com;;;"))) + (should (equal result '("Bob <bob@example.com>"))))) + +(provide 'test-org-contacts-parse-email) +;;; test-org-contacts-parse-email.el ends here diff --git a/tests/test-org-gcal-mock.el b/tests/test-org-gcal-mock.el new file mode 100644 index 00000000..4b063867 --- /dev/null +++ b/tests/test-org-gcal-mock.el @@ -0,0 +1,112 @@ +;;; test-org-gcal-mock.el --- Mock test for org-gcal sync -*- lexical-binding: t; -*- + +;;; Commentary: +;; Mock test to capture what org-gcal sends to Google Calendar API +;; This helps debug bidirectional sync issues without hitting the real API + +;;; Code: + +(require 'ert) +(require 'org) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load org-gcal (this will require auth, but we'll mock the requests) +(require 'org-gcal-config nil t) + +;; Variables to capture requests +(defvar test-org-gcal-captured-requests nil + "List of captured HTTP requests.") + +(defvar test-org-gcal-captured-url nil + "Last captured URL.") + +(defvar test-org-gcal-captured-type nil + "Last captured HTTP method (GET/POST/PUT/PATCH).") + +(defvar test-org-gcal-captured-data nil + "Last captured request body/data.") + +(defvar test-org-gcal-captured-headers nil + "Last captured request headers.") + +;;; Mock request-deferred to capture what org-gcal sends + +(defun test-org-gcal-mock-request-deferred (url &rest args) + "Mock request-deferred to capture requests instead of sending them. +URL is the API endpoint. ARGS contains :type, :data, :headers, etc." + (let* ((type (plist-get args :type)) + (data (plist-get args :data)) + (headers (plist-get args :headers))) + ;; Capture the request + (setq test-org-gcal-captured-url url) + (setq test-org-gcal-captured-type type) + (setq test-org-gcal-captured-data data) + (setq test-org-gcal-captured-headers headers) + (push (list :url url + :type type + :data data + :headers headers) + test-org-gcal-captured-requests) + + ;; Print for debugging + (message "MOCK REQUEST: %s %s" type url) + (when data + (message "MOCK DATA: %S" data)) + + ;; Return a mock deferred object that succeeds immediately + (require 'deferred) + (deferred:succeed + ;; Mock response with a fake event + (list :data '(:id "test-event-id-123" + :etag "test-etag-456" + :summary "Test Event" + :start (:dateTime "2025-10-28T14:00:00-05:00") + :end (:dateTime "2025-10-28T15:00:00-05:00")) + :status-code 200)))) + +(ert-deftest test-org-gcal-capture-post-request () + "Test capturing what org-gcal sends when posting an event." + ;; Reset captured requests + (setq test-org-gcal-captured-requests nil) + (setq test-org-gcal-captured-url nil) + (setq test-org-gcal-captured-type nil) + (setq test-org-gcal-captured-data nil) + + ;; Mock request-deferred + (cl-letf (((symbol-function 'request-deferred) #'test-org-gcal-mock-request-deferred)) + + ;; Create a test org buffer with an event + (with-temp-buffer + (org-mode) + (insert "* TEST: Mock Sync Test Event\n") + (insert "<2025-10-28 Tue 14:00-15:00>\n") + (insert "\n") + (insert "Test event for mocking.\n") + + ;; Go to the headline + (goto-char (point-min)) + (org-back-to-heading) + + ;; Try to post (this should be captured by our mock) + (condition-case err + (org-gcal-post-at-point) + (error + (message "Error during post: %S" err))))) + + ;; Check what was captured + (should test-org-gcal-captured-requests) + (let ((request (car test-org-gcal-captured-requests))) + (message "Captured URL: %s" (plist-get request :url)) + (message "Captured Type: %s" (plist-get request :type)) + (message "Captured Data: %S" (plist-get request :data)) + + ;; Verify it's trying to POST/PATCH + (should (member (plist-get request :type) '("POST" "PATCH" "PUT"))) + + ;; Verify URL contains calendar API + (should (string-match-p "googleapis.com/calendar" (plist-get request :url))))) + +(provide 'test-org-gcal-mock) +;;; test-org-gcal-mock.el ends here diff --git a/tests/test-org-roam-config-demote.el b/tests/test-org-roam-config-demote.el new file mode 100644 index 00000000..98cc8244 --- /dev/null +++ b/tests/test-org-roam-config-demote.el @@ -0,0 +1,183 @@ +;;; test-org-roam-config-demote.el --- Tests for cj/--demote-org-subtree -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--demote-org-subtree function from org-roam-config.el +;; +;; This function demotes org subtree content from one level to another. +;; All headings in the tree are adjusted proportionally, with a minimum level of 1. +;; +;; Examples: +;; Input: "*** Heading\n**** Sub", from: 3, to: 1 +;; Output: "* Heading\n** Sub" +;; +;; Input: "** Heading\n*** Sub", from: 2, to: 1 +;; Output: "* Heading\n** Sub" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-demote (content from-level to-level) + "Test cj/--demote-org-subtree on CONTENT. +FROM-LEVEL is the current top level, TO-LEVEL is the desired top level. +Returns the demoted content." + (cj/--demote-org-subtree content from-level to-level)) + +;;; Normal Cases - Single Heading + +(ert-deftest test-demote-level2-to-level1 () + "Should demote level 2 heading to level 1." + (let ((result (test-demote "** Heading\n" 2 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-level3-to-level1 () + "Should demote level 3 heading to level 1." + (let ((result (test-demote "*** Heading\n" 3 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-level4-to-level1 () + "Should demote level 4 heading to level 1." + (let ((result (test-demote "**** Heading\n" 4 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-level3-to-level2 () + "Should demote level 3 heading to level 2." + (let ((result (test-demote "*** Heading\n" 3 2))) + (should (string= result "** Heading\n")))) + +;;; Normal Cases - Multiple Headings at Same Level + +(ert-deftest test-demote-multiple-same-level () + "Should demote multiple headings at same level." + (let ((result (test-demote "** First\n** Second\n** Third\n" 2 1))) + (should (string= result "* First\n* Second\n* Third\n")))) + +;;; Normal Cases - Hierarchical Structure + +(ert-deftest test-demote-with-subheading () + "Should demote heading and subheading proportionally." + (let ((result (test-demote "** Heading\n*** Subheading\n" 2 1))) + (should (string= result "* Heading\n** Subheading\n")))) + +(ert-deftest test-demote-three-levels () + "Should demote three-level hierarchy." + (let ((result (test-demote "** Main\n*** Sub\n**** SubSub\n" 2 1))) + (should (string= result "* Main\n** Sub\n*** SubSub\n")))) + +(ert-deftest test-demote-complex-hierarchy () + "Should demote complex hierarchy maintaining relative structure." + (let ((result (test-demote "*** Top\n**** Sub1\n***** Deep\n**** Sub2\n" 3 1))) + (should (string= result "* Top\n** Sub1\n*** Deep\n** Sub2\n")))) + +;;; Normal Cases - With Content + +(ert-deftest test-demote-heading-with-text () + "Should demote heading preserving body text." + (let ((result (test-demote "** Heading\nBody text\n" 2 1))) + (should (string= result "* Heading\nBody text\n")))) + +(ert-deftest test-demote-with-properties () + "Should demote heading preserving properties." + (let ((result (test-demote "** Heading\n:PROPERTIES:\n:ID: 123\n:END:\n" 2 1))) + (should (string= result "* Heading\n:PROPERTIES:\n:ID: 123\n:END:\n")))) + +(ert-deftest test-demote-with-mixed-content () + "Should demote headings preserving all content." + (let ((result (test-demote "** H1\nText\n*** H2\nMore text\n" 2 1))) + (should (string= result "* H1\nText\n** H2\nMore text\n")))) + +;;; Boundary Cases - No Demotion Needed + +(ert-deftest test-demote-same-level () + "Should return content unchanged when from equals to." + (let ((result (test-demote "* Heading\n" 1 1))) + (should (string= result "* Heading\n")))) + +(ert-deftest test-demote-promote-ignored () + "Should return content unchanged when to > from (promotion)." + (let ((result (test-demote "* Heading\n" 1 2))) + (should (string= result "* Heading\n")))) + +;;; Boundary Cases - Minimum Level + +(ert-deftest test-demote-respects-minimum-level () + "Should not demote below level 1." + (let ((result (test-demote "** Main\n*** Sub\n" 2 1))) + (should (string= result "* Main\n** Sub\n")) + ;; Sub went from 3 to 2, not below 1 + (should (string-match-p "^\\*\\* Sub" result)))) + +(ert-deftest test-demote-deep-hierarchy-min-level () + "Should respect minimum level for deep hierarchies." + (let ((result (test-demote "**** L4\n***** L5\n****** L6\n" 4 1))) + (should (string= result "* L4\n** L5\n*** L6\n")))) + +;;; Boundary Cases - Empty and Edge Cases + +(ert-deftest test-demote-empty-string () + "Should handle empty string." + (let ((result (test-demote "" 2 1))) + (should (string= result "")))) + +(ert-deftest test-demote-no-headings () + "Should return non-heading content unchanged." + (let ((result (test-demote "Just plain text\nNo headings here\n" 2 1))) + (should (string= result "Just plain text\nNo headings here\n")))) + +(ert-deftest test-demote-heading-without-space () + "Should not match headings without space after stars." + (let ((result (test-demote "**Not a heading\n** Real Heading\n" 2 1))) + (should (string= result "**Not a heading\n* Real Heading\n")))) + +;;; Edge Cases - Special Heading Content + +(ert-deftest test-demote-heading-with-tags () + "Should demote heading preserving tags." + (let ((result (test-demote "** Heading :tag1:tag2:\n" 2 1))) + (should (string= result "* Heading :tag1:tag2:\n")))) + +(ert-deftest test-demote-heading-with-todo () + "Should demote heading preserving TODO keyword." + (let ((result (test-demote "** TODO Task\n" 2 1))) + (should (string= result "* TODO Task\n")))) + +(ert-deftest test-demote-heading-with-priority () + "Should demote heading preserving priority." + (let ((result (test-demote "** [#A] Important\n" 2 1))) + (should (string= result "* [#A] Important\n")))) + +;;; Edge Cases - Whitespace + +(ert-deftest test-demote-preserves-indentation () + "Should preserve indentation in body text." + (let ((result (test-demote "** Heading\n Indented text\n" 2 1))) + (should (string= result "* Heading\n Indented text\n")))) + +(ert-deftest test-demote-multiple-spaces-after-stars () + "Should handle multiple spaces after stars." + (let ((result (test-demote "** Heading\n" 2 1))) + (should (string= result "* Heading\n")))) + +;;; Edge Cases - Large Demotion + +(ert-deftest test-demote-large-level-difference () + "Should handle large level differences." + (let ((result (test-demote "****** Level 6\n******* Level 7\n" 6 1))) + (should (string= result "* Level 6\n** Level 7\n")))) + +(ert-deftest test-demote-to-level-2 () + "Should demote to level 2 when specified." + (let ((result (test-demote "***** Level 5\n****** Level 6\n" 5 2))) + (should (string= result "** Level 5\n*** Level 6\n")))) + +(provide 'test-org-roam-config-demote) +;;; test-org-roam-config-demote.el ends here diff --git a/tests/test-org-roam-config-format.el b/tests/test-org-roam-config-format.el new file mode 100644 index 00000000..e9378b7a --- /dev/null +++ b/tests/test-org-roam-config-format.el @@ -0,0 +1,151 @@ +;;; test-org-roam-config-format.el --- Tests for cj/--format-roam-node -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--format-roam-node function from org-roam-config.el +;; +;; This function formats org-roam node file content with title, node-id, and body content. +;; It creates a complete org-roam file with properties, title, category, and filetags. +;; +;; Example: +;; Input: title: "My Note", node-id: "abc123", content: "* Content\n" +;; Output: Full org-roam file with metadata and content + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-format (title node-id content) + "Test cj/--format-roam-node with TITLE, NODE-ID, and CONTENT. +Returns the formatted file content." + (cj/--format-roam-node title node-id content)) + +;;; Normal Cases + +(ert-deftest test-format-simple-node () + "Should format simple node with all components." + (let ((result (test-format "Test Title" "id-123" "* Content\n"))) + (should (string-match-p ":PROPERTIES:" result)) + (should (string-match-p ":ID: id-123" result)) + (should (string-match-p "#\\+TITLE: Test Title" result)) + (should (string-match-p "#\\+CATEGORY: Test Title" result)) + (should (string-match-p "#\\+FILETAGS: Topic" result)) + (should (string-match-p "\\* Content" result)))) + +(ert-deftest test-format-properties-first () + "Should place properties at the beginning." + (let ((result (test-format "Title" "id" "content"))) + (should (string-prefix-p ":PROPERTIES:\n" result)))) + +(ert-deftest test-format-id-after-properties () + "Should place ID in properties block." + (let ((result (test-format "Title" "test-id-456" "content"))) + (should (string-match-p ":PROPERTIES:\n:ID: test-id-456\n:END:" result)))) + +(ert-deftest test-format-title-after-properties () + "Should place title after properties." + (let ((result (test-format "My Title" "id" "content"))) + (should (string-match-p ":END:\n#\\+TITLE: My Title\n" result)))) + +(ert-deftest test-format-category-matches-title () + "Should set category to match title." + (let ((result (test-format "Project Name" "id" "content"))) + (should (string-match-p "#\\+TITLE: Project Name\n#\\+CATEGORY: Project Name\n" result)))) + +(ert-deftest test-format-filetags-topic () + "Should set filetags to Topic." + (let ((result (test-format "Title" "id" "content"))) + (should (string-match-p "#\\+FILETAGS: Topic\n" result)))) + +(ert-deftest test-format-content-at-end () + "Should place content after metadata." + (let ((result (test-format "Title" "id" "* Heading\nBody text\n"))) + (should (string-suffix-p "* Heading\nBody text\n" result)))) + +;;; Edge Cases - Various Titles + +(ert-deftest test-format-title-with-spaces () + "Should handle title with spaces." + (let ((result (test-format "Multi Word Title" "id" "content"))) + (should (string-match-p "#\\+TITLE: Multi Word Title" result)) + (should (string-match-p "#\\+CATEGORY: Multi Word Title" result)))) + +(ert-deftest test-format-title-with-punctuation () + "Should handle title with punctuation." + (let ((result (test-format "Title: With, Punctuation!" "id" "content"))) + (should (string-match-p "#\\+TITLE: Title: With, Punctuation!" result)))) + +(ert-deftest test-format-title-with-numbers () + "Should handle title with numbers." + (let ((result (test-format "Version 2.0" "id" "content"))) + (should (string-match-p "#\\+TITLE: Version 2\\.0" result)))) + +;;; Edge Cases - Various Node IDs + +(ert-deftest test-format-uuid-style-id () + "Should handle UUID-style ID." + (let ((result (test-format "Title" "a1b2c3d4-e5f6-7890-abcd-ef1234567890" "content"))) + (should (string-match-p ":ID: a1b2c3d4-e5f6-7890-abcd-ef1234567890" result)))) + +(ert-deftest test-format-short-id () + "Should handle short ID." + (let ((result (test-format "Title" "1" "content"))) + (should (string-match-p ":ID: 1" result)))) + +(ert-deftest test-format-long-id () + "Should handle long ID." + (let* ((long-id (make-string 100 ?a)) + (result (test-format "Title" long-id "content"))) + (should (string-match-p (concat ":ID: " long-id) result)))) + +;;; Edge Cases - Various Content + +(ert-deftest test-format-empty-content () + "Should handle empty content." + (let ((result (test-format "Title" "id" ""))) + (should (string-suffix-p "#+FILETAGS: Topic\n\n" result)))) + +(ert-deftest test-format-multiline-content () + "Should handle multiline content." + (let ((result (test-format "Title" "id" "* H1\nText\n** H2\nMore\n"))) + (should (string-suffix-p "* H1\nText\n** H2\nMore\n" result)))) + +(ert-deftest test-format-content-with-properties () + "Should handle content that already has properties." + (let ((result (test-format "Title" "id" "* Heading\n:PROPERTIES:\n:CUSTOM: value\n:END:\n"))) + (should (string-match-p ":CUSTOM: value" result)))) + +;;; Integration Tests - Structure + +(ert-deftest test-format-complete-structure () + "Should create proper org-roam file structure." + (let ((result (test-format "My Note" "abc-123" "* Content\n"))) + ;; Check order of components + (should (< (string-match ":PROPERTIES:" result) + (string-match ":ID:" result))) + (should (< (string-match ":ID:" result) + (string-match ":END:" result))) + (should (< (string-match ":END:" result) + (string-match "#\\+TITLE:" result))) + (should (< (string-match "#\\+TITLE:" result) + (string-match "#\\+CATEGORY:" result))) + (should (< (string-match "#\\+CATEGORY:" result) + (string-match "#\\+FILETAGS:" result))) + (should (< (string-match "#\\+FILETAGS:" result) + (string-match "\\* Content" result))))) + +(ert-deftest test-format-double-newline-after-metadata () + "Should have double newline between metadata and content." + (let ((result (test-format "Title" "id" "* Content"))) + (should (string-match-p "#\\+FILETAGS: Topic\n\n\\* Content" result)))) + +(provide 'test-org-roam-config-format) +;;; test-org-roam-config-format.el ends here diff --git a/tests/test-org-roam-config-link-description.el b/tests/test-org-roam-config-link-description.el new file mode 100644 index 00000000..06321b8f --- /dev/null +++ b/tests/test-org-roam-config-link-description.el @@ -0,0 +1,188 @@ +;;; test-org-roam-config-link-description.el --- Tests for cj/org-link-get-description -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/org-link-get-description function from org-roam-config.el +;; +;; This function extracts the description from an org link, or returns the text unchanged. +;; If TEXT contains an org link like [[url][description]], it returns description. +;; If TEXT contains multiple links, only the first one is processed. +;; Otherwise it returns TEXT unchanged. +;; +;; Examples: +;; Input: "[[https://example.com][Example Site]]" +;; Output: "Example Site" +;; +;; Input: "[[https://example.com]]" +;; Output: "https://example.com" +;; +;; Input: "Plain text" +;; Output: "Plain text" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-link-description (text) + "Test cj/org-link-get-description on TEXT. +Returns the extracted description or text unchanged." + (cj/org-link-get-description text)) + +;;; Normal Cases - Link with Description + +(ert-deftest test-link-with-description () + "Should extract description from link with description." + (let ((result (test-link-description "[[https://example.com][Example Site]]"))) + (should (string= result "Example Site")))) + +(ert-deftest test-link-with-multiword-description () + "Should extract multi-word description." + (let ((result (test-link-description "[[url][Multiple Word Description]]"))) + (should (string= result "Multiple Word Description")))) + +(ert-deftest test-link-with-special-chars-in-description () + "Should extract description with special characters." + (let ((result (test-link-description "[[url][Description: with, punctuation!]]"))) + (should (string= result "Description: with, punctuation!")))) + +(ert-deftest test-link-file-path-with-description () + "Should extract description from file link." + (let ((result (test-link-description "[[file:~/document.pdf][My Document]]"))) + (should (string= result "My Document")))) + +(ert-deftest test-link-with-numbers-in-description () + "Should extract description containing numbers." + (let ((result (test-link-description "[[url][Chapter 42]]"))) + (should (string= result "Chapter 42")))) + +;;; Normal Cases - Link without Description + +(ert-deftest test-link-without-description-url () + "Should return URL when no description is present." + (let ((result (test-link-description "[[https://example.com]]"))) + (should (string= result "https://example.com")))) + +(ert-deftest test-link-without-description-file () + "Should return file path when no description." + (let ((result (test-link-description "[[file:~/notes.org]]"))) + (should (string= result "file:~/notes.org")))) + +(ert-deftest test-link-without-description-id () + "Should return ID when no description." + (let ((result (test-link-description "[[id:abc123]]"))) + (should (string= result "id:abc123")))) + +;;; Normal Cases - No Link + +(ert-deftest test-plain-text () + "Should return plain text unchanged." + (let ((result (test-link-description "Plain text without link"))) + (should (string= result "Plain text without link")))) + +(ert-deftest test-text-with-brackets-but-not-link () + "Should return text with single brackets unchanged." + (let ((result (test-link-description "Text [with] brackets"))) + (should (string= result "Text [with] brackets")))) + +(ert-deftest test-text-with-partial-link-syntax () + "Should return text with partial link syntax unchanged." + (let ((result (test-link-description "[[incomplete link"))) + (should (string= result "[[incomplete link")))) + +;;; Boundary Cases - Multiple Links + +(ert-deftest test-multiple-links-extracts-first () + "Should extract description from first link only." + (let ((result (test-link-description "[[url1][First]] and [[url2][Second]]"))) + (should (string= result "First")))) + +(ert-deftest test-multiple-links-first-has-no-description () + "Should extract URL from first link when it has no description." + (let ((result (test-link-description "[[url1]] and [[url2][Second]]"))) + (should (string= result "url1")))) + +;;; Boundary Cases - Empty and Edge Cases + +(ert-deftest test-empty-string () + "Should return empty string unchanged." + (let ((result (test-link-description ""))) + (should (string= result "")))) + +(ert-deftest test-link-with-empty-description () + "Should return text unchanged when description brackets are empty." + (let ((result (test-link-description "[[https://example.com][]]"))) + ;; Regex requires at least one char in description, so no match + (should (string= result "[[https://example.com][]]")))) + +(ert-deftest test-link-with-empty-url () + "Should return text unchanged when link is completely empty." + (let ((result (test-link-description "[[]]"))) + ;; Regex requires at least one char in URL, so no match, returns unchanged + (should (string= result "[[]]")))) + +(ert-deftest test-link-with-empty-url-and-description () + "Should handle completely empty link." + (let ((result (test-link-description "[][]"))) + (should (string= result "[][]")))) + +;;; Edge Cases - Special Link Types + +(ert-deftest test-internal-link () + "Should extract description from internal link." + (let ((result (test-link-description "[[*Heading][My Heading]]"))) + (should (string= result "My Heading")))) + +(ert-deftest test-internal-link-without-description () + "Should return heading target from internal link without description." + (let ((result (test-link-description "[[*Heading]]"))) + (should (string= result "*Heading")))) + +(ert-deftest test-custom-id-link () + "Should handle custom ID links." + (let ((result (test-link-description "[[#custom-id][Custom Section]]"))) + (should (string= result "Custom Section")))) + +;;; Edge Cases - Link with Surrounding Text + +(ert-deftest test-link-with-prefix-text () + "Should extract description from link with prefix text." + (let ((result (test-link-description "See [[url][documentation]] for details"))) + (should (string= result "documentation")))) + +(ert-deftest test-link-at-start () + "Should extract description from link at start of text." + (let ((result (test-link-description "[[url][Link]] at beginning"))) + (should (string= result "Link")))) + +(ert-deftest test-link-at-end () + "Should extract description from link at end of text." + (let ((result (test-link-description "Text with [[url][link]]"))) + (should (string= result "link")))) + +;;; Edge Cases - Special Characters in URL + +(ert-deftest test-link-with-query-params () + "Should handle URL with query parameters." + (let ((result (test-link-description "[[https://example.com?q=test&foo=bar][Search]]"))) + (should (string= result "Search")))) + +(ert-deftest test-link-with-anchor () + "Should handle URL with anchor." + (let ((result (test-link-description "[[https://example.com#section][Section]]"))) + (should (string= result "Section")))) + +(ert-deftest test-link-with-spaces-in-description () + "Should preserve spaces in description." + (let ((result (test-link-description "[[url][Multiple Spaces]]"))) + (should (string= result "Multiple Spaces")))) + +(provide 'test-org-roam-config-link-description) +;;; test-org-roam-config-link-description.el ends here diff --git a/tests/test-org-roam-config-slug.el b/tests/test-org-roam-config-slug.el new file mode 100644 index 00000000..eb3149dd --- /dev/null +++ b/tests/test-org-roam-config-slug.el @@ -0,0 +1,223 @@ +;;; test-org-roam-config-slug.el --- Tests for cj/--generate-roam-slug -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--generate-roam-slug function from org-roam-config.el +;; +;; This function converts a title to a filename-safe slug by: +;; 1. Converting to lowercase +;; 2. Replacing non-alphanumeric characters with hyphens +;; 3. Removing leading and trailing hyphens +;; +;; Examples: +;; Input: "My Project Name" +;; Output: "my-project-name" +;; +;; Input: "Hello, World!" +;; Output: "hello-world" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-roam-config) + +;;; Test Helpers + +(defun test-slug (title) + "Test cj/--generate-roam-slug on TITLE. +Returns the slugified string." + (cj/--generate-roam-slug title)) + +;;; Normal Cases - Simple Titles + +(ert-deftest test-slug-simple-word () + "Should return lowercase simple word." + (let ((result (test-slug "Hello"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-multiple-words () + "Should replace spaces with hyphens." + (let ((result (test-slug "My Project Name"))) + (should (string= result "my-project-name")))) + +(ert-deftest test-slug-already-lowercase () + "Should handle already lowercase text." + (let ((result (test-slug "simple"))) + (should (string= result "simple")))) + +(ert-deftest test-slug-mixed-case () + "Should convert mixed case to lowercase." + (let ((result (test-slug "MixedCaseTitle"))) + (should (string= result "mixedcasetitle")))) + +;;; Normal Cases - Punctuation + +(ert-deftest test-slug-with-comma () + "Should remove commas." + (let ((result (test-slug "Hello, World"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-with-period () + "Should remove periods." + (let ((result (test-slug "Version 2.0"))) + (should (string= result "version-2-0")))) + +(ert-deftest test-slug-with-exclamation () + "Should remove exclamation marks." + (let ((result (test-slug "Hello World!"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-with-question () + "Should remove question marks." + (let ((result (test-slug "What Is This?"))) + (should (string= result "what-is-this")))) + +(ert-deftest test-slug-with-colon () + "Should remove colons." + (let ((result (test-slug "Note: Important"))) + (should (string= result "note-important")))) + +(ert-deftest test-slug-with-parentheses () + "Should remove parentheses." + (let ((result (test-slug "Item (copy)"))) + (should (string= result "item-copy")))) + +;;; Normal Cases - Numbers + +(ert-deftest test-slug-with-numbers () + "Should preserve numbers." + (let ((result (test-slug "Chapter 42"))) + (should (string= result "chapter-42")))) + +(ert-deftest test-slug-only-numbers () + "Should handle titles with only numbers." + (let ((result (test-slug "123"))) + (should (string= result "123")))) + +(ert-deftest test-slug-mixed-alphanumeric () + "Should preserve alphanumeric characters." + (let ((result (test-slug "Test123ABC"))) + (should (string= result "test123abc")))) + +;;; Boundary Cases - Multiple Consecutive Special Chars + +(ert-deftest test-slug-multiple-spaces () + "Should collapse multiple spaces into single hyphen." + (let ((result (test-slug "Hello World"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-mixed-punctuation () + "Should collapse mixed punctuation into single hyphen." + (let ((result (test-slug "Hello, ... World!"))) + (should (string= result "hello-world")))) + +(ert-deftest test-slug-consecutive-hyphens () + "Should collapse consecutive hyphens." + (let ((result (test-slug "Hello---World"))) + (should (string= result "hello-world")))) + +;;; Boundary Cases - Leading/Trailing Special Chars + +(ert-deftest test-slug-leading-space () + "Should remove leading hyphen from leading space." + (let ((result (test-slug " Hello"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-trailing-space () + "Should remove trailing hyphen from trailing space." + (let ((result (test-slug "Hello "))) + (should (string= result "hello")))) + +(ert-deftest test-slug-leading-punctuation () + "Should remove leading hyphen from leading punctuation." + (let ((result (test-slug "...Hello"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-trailing-punctuation () + "Should remove trailing hyphen from trailing punctuation." + (let ((result (test-slug "Hello!!!"))) + (should (string= result "hello")))) + +(ert-deftest test-slug-leading-and-trailing () + "Should remove both leading and trailing hyphens." + (let ((result (test-slug " Hello World "))) + (should (string= result "hello-world")))) + +;;; Boundary Cases - Empty and Short + +(ert-deftest test-slug-empty-string () + "Should return empty string for empty input." + (let ((result (test-slug ""))) + (should (string= result "")))) + +(ert-deftest test-slug-only-punctuation () + "Should return empty string for only punctuation." + (let ((result (test-slug "!!!"))) + (should (string= result "")))) + +(ert-deftest test-slug-only-spaces () + "Should return empty string for only spaces." + (let ((result (test-slug " "))) + (should (string= result "")))) + +(ert-deftest test-slug-single-char () + "Should handle single character." + (let ((result (test-slug "A"))) + (should (string= result "a")))) + +;;; Edge Cases - Special Characters + +(ert-deftest test-slug-with-underscore () + "Should replace underscores with hyphens." + (let ((result (test-slug "my_variable_name"))) + (should (string= result "my-variable-name")))) + +(ert-deftest test-slug-with-slash () + "Should remove slashes." + (let ((result (test-slug "path/to/file"))) + (should (string= result "path-to-file")))) + +(ert-deftest test-slug-with-at-sign () + "Should remove at signs." + (let ((result (test-slug "user@example"))) + (should (string= result "user-example")))) + +(ert-deftest test-slug-with-hash () + "Should remove hash symbols." + (let ((result (test-slug "#hashtag"))) + (should (string= result "hashtag")))) + +(ert-deftest test-slug-with-dollar () + "Should remove dollar signs." + (let ((result (test-slug "$price"))) + (should (string= result "price")))) + +;;; Edge Cases - Unicode (if supported) + +(ert-deftest test-slug-with-unicode () + "Should remove unicode characters." + (let ((result (test-slug "Café"))) + (should (string= result "caf")))) + +(ert-deftest test-slug-with-emoji () + "Should remove emoji." + (let ((result (test-slug "Hello 😀 World"))) + (should (string= result "hello-world")))) + +;;; Edge Cases - Long Titles + +(ert-deftest test-slug-very-long-title () + "Should handle very long titles." + (let* ((long-title (mapconcat #'identity (make-list 20 "word") " ")) + (result (test-slug long-title))) + (should (string-prefix-p "word-" result)) + (should (string-suffix-p "-word" result)) + (should (not (string-match-p " " result))))) + +(provide 'test-org-roam-config-slug) +;;; test-org-roam-config-slug.el ends here diff --git a/tests/test-org-webclipper-process.el b/tests/test-org-webclipper-process.el new file mode 100644 index 00000000..9a25ef5c --- /dev/null +++ b/tests/test-org-webclipper-process.el @@ -0,0 +1,210 @@ +;;; test-org-webclipper-process.el --- Tests for cj/--process-webclip-content -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the cj/--process-webclip-content function from org-webclipper.el +;; +;; This function processes webclipped org-mode content by: +;; 1. Removing the first top-level heading +;; 2. Removing any initial blank lines +;; 3. Demoting all remaining headings by one level +;; +;; Examples: +;; Input: "* Title\nContent\n** Sub\n" +;; Output: "Content\n*** Sub\n" +;; +;; Input: "* Title\n\n\n** Sub\n" +;; Output: "*** Sub\n" + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Now load the actual production module +(require 'org-webclipper) + +;;; Test Helpers + +(defun test-process-webclip (content) + "Test cj/--process-webclip-content on CONTENT. +Returns the processed content." + (cj/--process-webclip-content content)) + +;;; Normal Cases - Single Heading Removal + +(ert-deftest test-process-removes-first-heading () + "Should remove the first top-level heading." + (let ((result (test-process-webclip "* Title\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-heading-with-text () + "Should remove first heading preserving body text." + (let ((result (test-process-webclip "* Page Title\nParagraph text\n"))) + (should (string= result "Paragraph text\n")))) + +(ert-deftest test-process-removes-heading-with-tags () + "Should remove first heading even with tags." + (let ((result (test-process-webclip "* Title :tag1:tag2:\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-heading-with-todo () + "Should remove first heading even with TODO keyword." + (let ((result (test-process-webclip "* TODO Task\nContent\n"))) + (should (string= result "Content\n")))) + +;;; Normal Cases - Blank Line Removal + +(ert-deftest test-process-removes-single-blank-line () + "Should remove single blank line after heading removal." + (let ((result (test-process-webclip "* Title\n\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-multiple-blank-lines () + "Should remove multiple blank lines after heading removal." + (let ((result (test-process-webclip "* Title\n\n\n\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-removes-blank-lines-with-spaces () + "Should remove blank lines that contain only spaces." + (let ((result (test-process-webclip "* Title\n \n\t\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-preserves-blank-lines-in-content () + "Should preserve blank lines within the content." + (let ((result (test-process-webclip "* Title\nPara 1\n\nPara 2\n"))) + (should (string= result "Para 1\n\nPara 2\n")))) + +;;; Normal Cases - Heading Demotion + +(ert-deftest test-process-demotes-second-level () + "Should demote level 2 heading to level 3." + (let ((result (test-process-webclip "* Title\n** Section\n"))) + (should (string= result "*** Section\n")))) + +(ert-deftest test-process-demotes-third-level () + "Should demote level 3 heading to level 4." + (let ((result (test-process-webclip "* Title\n*** Subsection\n"))) + (should (string= result "**** Subsection\n")))) + +(ert-deftest test-process-demotes-multiple-headings () + "Should demote all headings in the content." + (let ((result (test-process-webclip "* Title\n** Section 1\n** Section 2\n"))) + (should (string= result "*** Section 1\n*** Section 2\n")))) + +(ert-deftest test-process-demotes-nested-hierarchy () + "Should demote nested heading structure." + (let ((result (test-process-webclip "* Title\n** Section\n*** Subsection\n"))) + (should (string= result "*** Section\n**** Subsection\n")))) + +;;; Normal Cases - Combined Processing + +(ert-deftest test-process-full-workflow () + "Should remove heading, blank lines, and demote remaining headings." + (let ((result (test-process-webclip "* Article Title\n\n** Introduction\nText\n** Conclusion\n"))) + (should (string= result "*** Introduction\nText\n*** Conclusion\n")))) + +(ert-deftest test-process-with-properties () + "Should preserve properties in demoted headings." + (let ((result (test-process-webclip "* Title\n** Heading\n:PROPERTIES:\n:ID: 123\n:END:\n"))) + (should (string= result "*** Heading\n:PROPERTIES:\n:ID: 123\n:END:\n")))) + +(ert-deftest test-process-with-mixed-content () + "Should handle mixed text and headings." + (let ((result (test-process-webclip "* Title\nIntro text\n** Section\nBody text\n"))) + (should (string= result "Intro text\n*** Section\nBody text\n")))) + +;;; Edge Cases - Empty and Minimal Content + +(ert-deftest test-process-empty-string () + "Should return empty string for empty input." + (let ((result (test-process-webclip ""))) + (should (string= result "")))) + +(ert-deftest test-process-only-heading () + "Should return empty string when only first heading present." + (let ((result (test-process-webclip "* Title\n"))) + (should (string= result "")))) + +(ert-deftest test-process-only-blank-lines () + "Should return empty string for only blank lines after heading." + (let ((result (test-process-webclip "* Title\n\n\n"))) + (should (string= result "")))) + +(ert-deftest test-process-no-heading () + "Should handle content without any heading." + (let ((result (test-process-webclip "Just plain text\n"))) + (should (string= result "Just plain text\n")))) + +(ert-deftest test-process-heading-no-newline () + "Should demote heading without trailing newline (doesn't match removal pattern)." + (let ((result (test-process-webclip "* Title"))) + (should (string= result "** Title")))) + +;;; Edge Cases - Heading Variations + +(ert-deftest test-process-heading-without-space () + "Should not match heading without space after stars." + (let ((result (test-process-webclip "*Title\nContent\n"))) + (should (string= result "*Title\nContent\n")))) + +(ert-deftest test-process-multiple-top-level-headings () + "Should only remove first top-level heading." + (let ((result (test-process-webclip "* Title 1\n* Title 2\n"))) + (should (string= result "** Title 2\n")))) + +(ert-deftest test-process-heading-with-priority () + "Should remove heading with priority marker." + (let ((result (test-process-webclip "* [#A] Important\nContent\n"))) + (should (string= result "Content\n")))) + +(ert-deftest test-process-heading-with-links () + "Should remove heading containing links." + (let ((result (test-process-webclip "* [[url][Link Title]]\nContent\n"))) + (should (string= result "Content\n")))) + +;;; Edge Cases - Special Content + +(ert-deftest test-process-preserves-lists () + "Should preserve list formatting." + (let ((result (test-process-webclip "* Title\n- Item 1\n- Item 2\n"))) + (should (string= result "- Item 1\n- Item 2\n")))) + +(ert-deftest test-process-preserves-code-blocks () + "Should preserve code block content." + (let ((result (test-process-webclip "* Title\n#+BEGIN_SRC python\nprint('hi')\n#+END_SRC\n"))) + (should (string= result "#+BEGIN_SRC python\nprint('hi')\n#+END_SRC\n")))) + +(ert-deftest test-process-preserves-tables () + "Should preserve org table content." + (let ((result (test-process-webclip "* Title\n| A | B |\n| 1 | 2 |\n"))) + (should (string= result "| A | B |\n| 1 | 2 |\n")))) + +;;; Edge Cases - Deep Nesting + +(ert-deftest test-process-very-deep-headings () + "Should demote very deep heading structures." + (let ((result (test-process-webclip "* Title\n****** Level 6\n"))) + (should (string= result "******* Level 6\n")))) + +(ert-deftest test-process-complex-document () + "Should handle complex document structure." + (let ((result (test-process-webclip "* Main Title\n\n** Section 1\nText 1\n*** Subsection 1.1\nText 2\n** Section 2\nText 3\n"))) + (should (string= result "*** Section 1\nText 1\n**** Subsection 1.1\nText 2\n*** Section 2\nText 3\n")))) + +;;; Integration Tests + +(ert-deftest test-process-realistic-webpage () + "Should process realistic webclipped content." + (let ((result (test-process-webclip "* How to Program in Emacs Lisp\n\n** Introduction\nEmacs Lisp is powerful.\n\n** Getting Started\nFirst, open Emacs.\n\n*** Installation\nDownload from gnu.org\n"))) + (should (string= result "*** Introduction\nEmacs Lisp is powerful.\n\n*** Getting Started\nFirst, open Emacs.\n\n**** Installation\nDownload from gnu.org\n")))) + +(ert-deftest test-process-article-with-metadata () + "Should handle article with org metadata." + (let ((result (test-process-webclip "* Article Title :article:web:\n#+DATE: 2024-01-01\n\n** Content\nBody text\n"))) + (should (string= result "#+DATE: 2024-01-01\n\n*** Content\nBody text\n")))) + +(provide 'test-org-webclipper-process) +;;; test-org-webclipper-process.el ends here diff --git a/tests/test-test-runner.el b/tests/test-test-runner.el new file mode 100644 index 00000000..0edc0d65 --- /dev/null +++ b/tests/test-test-runner.el @@ -0,0 +1,359 @@ +;;; test-test-runner.el --- Tests for test-runner.el -*- lexical-binding: t; -*- + +;;; Commentary: +;; Unit tests for test-runner.el - ERT test runner with focus/unfocus workflow. +;; +;; Testing approach: +;; - Tests focus on internal `cj/test--do-*` functions (pure business logic) +;; - File system operations use temp directories +;; - Tests are isolated with setup/teardown +;; - Tests verify return values, not user messages + +;;; Code: + +(require 'ert) +(require 'testutil-general) + +;; Add modules directory to load path +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) + +;; Load the module (ignore keymap error in batch mode) +(condition-case nil + (require 'test-runner) + (error nil)) + +;;; Test Utilities + +(defvar test-testrunner--temp-dir nil + "Temporary directory for test files during tests.") + +(defvar test-testrunner--original-focused-files nil + "Backup of focused files list before test.") + +(defun test-testrunner-setup () + "Setup test environment before each test." + ;; Backup current state + (setq test-testrunner--original-focused-files cj/test-focused-files) + ;; Reset to clean state + (setq cj/test-focused-files '()) + ;; Create temp directory for file tests + (setq test-testrunner--temp-dir (make-temp-file "test-runner-test" t))) + +(defun test-testrunner-teardown () + "Clean up test environment after each test." + ;; Restore state + (setq cj/test-focused-files test-testrunner--original-focused-files) + ;; Clean up temp directory + (when (and test-testrunner--temp-dir + (file-directory-p test-testrunner--temp-dir)) + (delete-directory test-testrunner--temp-dir t)) + (setq test-testrunner--temp-dir nil)) + +(defun test-testrunner-create-test-file (filename content) + "Create test file FILENAME with CONTENT in temp directory." + (let ((filepath (expand-file-name filename test-testrunner--temp-dir))) + (with-temp-file filepath + (insert content)) + filepath)) + +;;; Normal Cases - Load Files + +(ert-deftest test-testrunner-load-files-success () + "Should successfully load test files." + (test-testrunner-setup) + (let* ((file1 (test-testrunner-create-test-file "test-simple.el" + "(defun test-func () t)")) + (file2 (test-testrunner-create-test-file "test-other.el" + "(defun other-func () nil)")) + (result (cj/test--do-load-files test-testrunner--temp-dir + (list file1 file2)))) + (should (eq (car result) 'success)) + (should (= (cdr result) 2))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-load-files-with-errors () + "Should handle errors during file loading." + (test-testrunner-setup) + (let* ((good-file (test-testrunner-create-test-file "test-good.el" + "(defun good () t)")) + (bad-file (test-testrunner-create-test-file "test-bad.el" + "(defun bad ( ")) + (result (cj/test--do-load-files test-testrunner--temp-dir + (list good-file bad-file)))) + (should (eq (car result) 'error)) + (should (= (nth 1 result) 1)) ; loaded-count + (should (= (length (nth 2 result)) 1))) ; errors list + (test-testrunner-teardown)) + +;;; Normal Cases - Focus Add + +(ert-deftest test-testrunner-focus-add-success () + "Should successfully add file to focus." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-foo.el" + '("test-foo.el" "test-bar.el") + '()))) + (should (eq result 'success))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-already-focused () + "Should detect already focused file." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-foo.el" + '("test-foo.el" "test-bar.el") + '("test-foo.el")))) + (should (eq result 'already-focused))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-not-available () + "Should detect file not in available list." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-missing.el" + '("test-foo.el" "test-bar.el") + '()))) + (should (eq result 'not-available))) + (test-testrunner-teardown)) + +;;; Normal Cases - Focus Add File + +(ert-deftest test-testrunner-focus-add-file-success () + "Should successfully validate and add file to focus." + (test-testrunner-setup) + (let* ((filepath (expand-file-name "test-foo.el" test-testrunner--temp-dir)) + (result (cj/test--do-focus-add-file filepath test-testrunner--temp-dir '()))) + (should (eq (car result) 'success)) + (should (string= (cdr result) "test-foo.el"))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-file-no-file () + "Should detect nil filepath." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add-file nil test-testrunner--temp-dir '()))) + (should (eq (car result) 'no-file))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-file-not-in-testdir () + "Should detect file outside test directory." + (test-testrunner-setup) + (let* ((filepath "/tmp/outside-test.el") + (result (cj/test--do-focus-add-file filepath test-testrunner--temp-dir '()))) + (should (eq (car result) 'not-in-testdir))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-file-already-focused () + "Should detect already focused file." + (test-testrunner-setup) + (let* ((filepath (expand-file-name "test-foo.el" test-testrunner--temp-dir)) + (result (cj/test--do-focus-add-file filepath + test-testrunner--temp-dir + '("test-foo.el")))) + (should (eq (car result) 'already-focused)) + (should (string= (cdr result) "test-foo.el"))) + (test-testrunner-teardown)) + +;;; Normal Cases - Focus Remove + +(ert-deftest test-testrunner-focus-remove-success () + "Should successfully remove file from focus." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-remove "test-foo.el" '("test-foo.el" "test-bar.el")))) + (should (eq result 'success))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-remove-empty-list () + "Should detect empty focused list." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-remove "test-foo.el" '()))) + (should (eq result 'empty-list))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-remove-not-found () + "Should detect file not in focused list." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-remove "test-missing.el" '("test-foo.el")))) + (should (eq result 'not-found))) + (test-testrunner-teardown)) + +;;; Normal Cases - Get Focused Tests + +(ert-deftest test-testrunner-get-focused-tests-success () + "Should extract test names from focused files." + (test-testrunner-setup) + (let* ((file1 (test-testrunner-create-test-file "test-first.el" + "(ert-deftest test-alpha-one () (should t))\n(ert-deftest test-alpha-two () (should t))")) + (result (cj/test--do-get-focused-tests '("test-first.el") test-testrunner--temp-dir))) + (should (eq (car result) 'success)) + (should (= (length (nth 1 result)) 2)) ; 2 test names + (should (= (nth 2 result) 1))) ; 1 file loaded + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-get-focused-tests-empty-list () + "Should detect empty focused files list." + (test-testrunner-setup) + (let ((result (cj/test--do-get-focused-tests '() test-testrunner--temp-dir))) + (should (eq (car result) 'empty-list))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-get-focused-tests-no-tests () + "Should detect when no tests found in files." + (test-testrunner-setup) + (test-testrunner-create-test-file "test-empty.el" "(defun not-a-test () t)") + (let ((result (cj/test--do-get-focused-tests '("test-empty.el") test-testrunner--temp-dir))) + (should (eq (car result) 'no-tests))) + (test-testrunner-teardown)) + +;;; Normal Cases - Extract Test Names + +(ert-deftest test-testrunner-extract-test-names-simple () + "Should extract test names from file." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-simple.el" + "(ert-deftest test-foo () (should t))\n(ert-deftest test-bar () (should nil))")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 2)) + (should (member "test-foo" names)) + (should (member "test-bar" names))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-names-with-whitespace () + "Should extract test names with various whitespace." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-whitespace.el" + "(ert-deftest test-spaces () (should t))\n (ert-deftest test-indent () t)")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 2)) + (should (member "test-spaces" names)) + (should (member "test-indent" names))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-names-no-tests () + "Should return empty list when no tests in file." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-none.el" + "(defun not-a-test () t)")) + (names (cj/test--extract-test-names file))) + (should (null names))) + (test-testrunner-teardown)) + +;;; Normal Cases - Extract Test at Position + +(ert-deftest test-testrunner-extract-test-at-pos-found () + "Should extract test name at point." + (test-testrunner-setup) + (with-temp-buffer + (insert "(ert-deftest test-sample ()\n (should t))") + (goto-char (point-min)) + (let ((name (cj/test--extract-test-at-pos))) + (should (eq name 'test-sample)))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-at-pos-not-found () + "Should return nil when not in a test." + (test-testrunner-setup) + (with-temp-buffer + (insert "(defun regular-function ()\n (message \"hi\"))") + (goto-char (point-min)) + (let ((name (cj/test--extract-test-at-pos))) + (should (null name)))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-at-pos-invalid-syntax () + "Should return nil for invalid syntax." + (test-testrunner-setup) + (with-temp-buffer + (insert "(ert-deftest") + (goto-char (point-min)) + (let ((name (cj/test--extract-test-at-pos))) + (should (null name)))) + (test-testrunner-teardown)) + +;;; Boundary Cases - Load Files + +(ert-deftest test-testrunner-load-files-empty-list () + "Should handle empty file list." + (test-testrunner-setup) + (let ((result (cj/test--do-load-files test-testrunner--temp-dir '()))) + (should (eq (car result) 'success)) + (should (= (cdr result) 0))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-load-files-nonexistent () + "Should handle nonexistent files." + (test-testrunner-setup) + (let* ((fake-file (expand-file-name "nonexistent.el" test-testrunner--temp-dir)) + (result (cj/test--do-load-files test-testrunner--temp-dir (list fake-file)))) + (should (eq (car result) 'error)) + (should (= (nth 1 result) 0))) ; 0 files loaded + (test-testrunner-teardown)) + +;;; Boundary Cases - Focus Add + +(ert-deftest test-testrunner-focus-add-single-available () + "Should add when only one file available." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "test-only.el" '("test-only.el") '()))) + (should (eq result 'success))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-focus-add-case-sensitive () + "Should be case-sensitive for filenames." + (test-testrunner-setup) + (let ((result (cj/test--do-focus-add "Test-Foo.el" + '("test-foo.el") + '()))) + (should (eq result 'not-available))) + (test-testrunner-teardown)) + +;;; Boundary Cases - Get Focused Tests + +(ert-deftest test-testrunner-get-focused-tests-multiple-files () + "Should collect tests from multiple files." + (test-testrunner-setup) + (test-testrunner-create-test-file "test-first.el" + "(ert-deftest test-beta-one () t)") + (test-testrunner-create-test-file "test-second.el" + "(ert-deftest test-beta-two () t)") + (let ((result (cj/test--do-get-focused-tests '("test-first.el" "test-second.el") + test-testrunner--temp-dir))) + (should (eq (car result) 'success)) + (should (= (length (nth 1 result)) 2)) ; 2 tests total + (should (= (nth 2 result) 2))) ; 2 files loaded + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-get-focused-tests-skip-nonexistent () + "Should skip nonexistent files." + (test-testrunner-setup) + (test-testrunner-create-test-file "test-exists.el" + "(ert-deftest test-gamma-one () t)") + (let ((result (cj/test--do-get-focused-tests '("test-exists.el" "test-missing.el") + test-testrunner--temp-dir))) + (should (eq (car result) 'success)) + (should (= (length (nth 1 result)) 1)) ; 1 test found + (should (= (nth 2 result) 1))) ; 1 file loaded (missing skipped) + (test-testrunner-teardown)) + +;;; Boundary Cases - Extract Test Names + +(ert-deftest test-testrunner-extract-test-names-hyphens-underscores () + "Should handle test names with hyphens and underscores." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-names.el" + "(ert-deftest test-with-hyphens () t)\n(ert-deftest test_with_underscores () t)")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 2)) + (should (member "test-with-hyphens" names)) + (should (member "test_with_underscores" names))) + (test-testrunner-teardown)) + +(ert-deftest test-testrunner-extract-test-names-ignore-comments () + "Should not extract test names from comments." + (test-testrunner-setup) + (let* ((file (test-testrunner-create-test-file "test-comments.el" + ";; (ert-deftest test-commented () t)\n(ert-deftest test-real () t)")) + (names (cj/test--extract-test-names file))) + (should (= (length names) 1)) + (should (member "test-real" names))) + (test-testrunner-teardown)) + +(provide 'test-test-runner) +;;; test-test-runner.el ends here diff --git a/tests/testutil-general.el b/tests/testutil-general.el index d3c08135..b7222d1a 100644 --- a/tests/testutil-general.el +++ b/tests/testutil-general.el @@ -81,31 +81,6 @@ Return the full created path." (cj/create--directory-ensuring-parents path) (cj/create--file-ensuring-parents path content executable)))) - -;; (defun cj/create-file-with-content-ensuring-parents (filepath content &optional executable) -;; "Create a file at FILEPATH with CONTENT, ensuring parent directories exist. -;; FILEPATH will be relative to `cj/test-base-dir'. -;; Signals an error if the file already exists. -;; If EXECUTABLE is non-nil, set executable permission on the file. -;; Errors if the resulting path is outside `cj/test-base-dir`." -;; (let* ((base (file-name-as-directory cj/test-base-dir)) -;; (fullpath (if (file-name-absolute-p filepath) -;; (expand-file-name filepath) -;; (expand-file-name filepath base)))) -;; (unless (string-prefix-p base fullpath) -;; (error "File path %s is outside base test directory %s" fullpath base)) -;; (let ((parent-dir (file-name-directory fullpath))) -;; (when (file-exists-p fullpath) -;; (error "File already exists: %s" fullpath)) -;; (unless (file-directory-p parent-dir) -;; (make-directory parent-dir t)) -;; (with-temp-buffer -;; (insert content) -;; (write-file fullpath)) -;; (when executable -;; (chmod fullpath #o755)) -;; fullpath))) - (defun cj/fix-permissions-recursively (dir) "Recursively set read/write permissions for user under DIR. Directories get user read, write, and execute permissions to allow recursive |