diff options
88 files changed, 6621 insertions, 829 deletions
diff --git a/.localrepo/archive-contents b/.localrepo/archive-contents index d6c4f6b4..c823da50 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]) @@ -124,8 +124,10 @@ (org-contacts . [(1 1) ((emacs (27 1)) (org (9 3 4))) "Contacts management system for Org Mode" tar]) (org-drill . [(2 7 0) ((emacs (25 3)) (seq (2 14)) (org (9 3)) (persist (0 3))) "Self-testing using spaced repetition" tar]) (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-msg . [(4 0) ((emacs (24 4)) (htmlize (1 54))) "No description available." 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 +135,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]) @@ -176,6 +179,7 @@ (windsize . [(20181029 2257) nil "Simple, intuitive window resizing." tar]) (with-editor . [(3 4 4) ((emacs (26 1)) (compat (30 1))) "Use the Emacsclient as $EDITOR" tar]) (ws-butler . [(1 3) ((emacs (24 1))) "Unobtrusively remove trailing whitespace" tar]) + (wttrin . [(0 2 3) ((emacs (24 4)) (xterm-color (1 0))) "No description available." tar]) (xterm-color . [(20230321 3) ((emacs (24 4))) "ANSI, XTERM 256 and Truecolor support." tar]) (yaml . [(1 2 0) ((emacs (25 1))) "YAML parser for Elisp" tar]) (yaml-mode . [(0 0 16) ((emacs (24 1))) "Major mode for editing YAML files" 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-msg-4.0.tar b/.localrepo/org-msg-4.0.tar Binary files differnew file mode 100644 index 00000000..9df64990 --- /dev/null +++ b/.localrepo/org-msg-4.0.tar 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/.localrepo/wttrin-0.2.3.tar b/.localrepo/wttrin-0.2.3.tar Binary files differnew file mode 100644 index 00000000..9df64990 --- /dev/null +++ b/.localrepo/wttrin-0.2.3.tar diff --git a/ai-prompts/quality-engineer.org b/ai-prompts/quality-engineer.org index 4aad0d19..385dbec1 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 @@ -272,6 +638,119 @@ Example timeline: - Format test cases as clear, numbered lists within each category - Focus on practical, implementable tests that catch real-world bugs +## Test Future-Proofing & Time-Based Testing + +*** Dynamic Timestamp Generation +When tests involve dates and times: +- **Never hardcode dates** in tests (e.g., "2025-10-24") + - Tests will fail when that date passes + - Creates maintenance burden (annual test updates) + - Makes tests brittle and non-deterministic over time + +- **Use dynamic timestamp generation** instead: + - Create test utilities that generate timestamps relative to "now" + - Examples: `test-time-today-at`, `test-time-tomorrow-at`, `test-time-days-from-now` + - Base time can be offset into future to avoid past-date edge cases + +- **Mock time via function substitution**: + - Replace `current-time` with test-controlled time source + - Use macros like `with-test-time` to scope time mocking + - Preserves existing function mocking patterns (don't nest cl-letf*) + +- **Pattern for time-based tests**: + #+begin_src elisp + (let* ((now (test-time-today-at 14 0)) + (event-time (test-time-today-at 14 10)) + (timestamp-str (test-timestamp-string event-time))) + (with-test-time now + (cl-letf (((symbol-function 'other-mock) (lambda () ...))) + (let* ((result (function-under-test event-time))) + (should (equal expected result)))))) + #+end_src + +- **Benefits of dynamic timestamps**: + - Tests work indefinitely without modification + - Time relationships remain consistent (10 minutes = 10 minutes) + - Clearer test intent (relative times vs absolute dates) + - Easier to understand what's being tested + - No test failures from date expiration + +*** Large-Scale Test Refactoring Strategy +When refactoring many test files (e.g., removing hardcoded timestamps): + +**** Strategic Planning +- **Tackle biggest challenges first** - Largest/most complex files + - Eliminates intimidation factor early + - Makes remaining work feel manageable + - Builds confidence and momentum + - Subsequent files feel easier by comparison + +- **Establish consistent patterns early**: + - First few files set the template + - Document patterns in commit messages + - Later files follow established conventions + - Reduces decision fatigue + +- **Identify files that don't need refactoring**: + - Not all timestamp references require changes + - Copyright dates, version numbers: leave alone + - Tests without time dependencies: skip + - Focus effort where it matters + +**** Execution Approach +- **Maintain 100% test pass rate throughout**: + - Run tests after each file refactored + - Never commit broken tests + - Validates refactoring correctness immediately + - Builds trust in the process + +- **Work in batches but commit individually**: + - Refactor similar test patterns together + - But commit each file separately with detailed message + - Makes git history navigable + - Easier to revert specific changes if needed + +- **Use validation infrastructure**: + - Pre-commit hooks catch syntax errors + - Makefile targets (`make validate`, `make test-file`) + - Automated checks prevent regressions + +- **Document patterns in commits**: + - Before/after examples in commit messages + - List of changes made + - Pattern transformations explained + - Future maintainers understand the approach + +**** Project Management Lessons +- **Track progress visibly**: + - Use todo lists to show what's done vs remaining + - Update counts: "16/23 files (70%) complete" + - Provides motivation and clarity + +- **Celebrate milestones**: + - Acknowledge when biggest challenges complete + - Note when majority threshold reached (>50%) + - Recognize systematic progress + +- **Know when you're done**: + - Some files genuinely don't need changes + - Don't force work where it doesn't apply + - Project can complete before all files touched + +**** Real-World Example: chime.el Timestamp Refactoring +Project scope: 23 test files, 339 tests total +- 16 files needed timestamp refactoring (251 tests) +- 7 files had no timestamp dependencies (88 tests) +- Completed over multiple sessions maintaining 100% pass rate +- Strategic approach: Always chose largest remaining file +- Result: Future-proof test suite, tests never expire + +Key insight: **Not all refactoring projects require touching every file** +- Analyze which files actually need work +- Skip files without relevant issues +- Focus effort on high-impact changes +- Don't let perfectionism create unnecessary work + ## Red Flags Watch for and report these issues: @@ -286,3 +765,4 @@ Watch for and report these issues: - Flaky tests that pass/fail intermittently - Tests that are too slow - Tests that require manual setup or verification +- **Hardcoded dates in tests** - Will fail when dates pass, creates maintenance burden @@ -29,9 +29,8 @@ (require 'custom-case) ;; operations for upper/lower/title case (require 'custom-comments) ;; operations with comments (require 'custom-datetime) ;; date/timestamp insertion in various formats -(require 'custom-file-buffer) ;; custom buffer and file operations and keymap +(require 'custom-buffer-file) ;; 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 @@ -111,7 +110,7 @@ (require 'org-contacts-config) ;; fully integrated org-mode contacts management (require 'org-drill-config) (require 'org-export-config) -(require 'org-gcal-config) +(require 'org-gcal-config) ;; bi directional sync google calendar for org-agenda (require 'org-refile-config) ;; refile org-branches (require 'org-roam-config) ;; personal knowledge management in org mode (require 'org-webclipper) ;; "instapaper" to org-roam workflow @@ -128,14 +127,14 @@ ;; 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)) ;; ------------------------- Personal Workflow Related ------------------------- (require 'reconcile-open-repos) -(require 'local-repository) +(require 'local-repository) ;; local repository for easy config portability ;; ------------------------------- Entertainment ------------------------------- @@ -143,10 +142,11 @@ (require 'games-config) ;; ------------------------------ Modules In Test ------------------------------ -(require 'browser-config) + ;;(require 'wip) -;;(require 'lipsum-generator) -;;(require 'jumper) +(require 'lorem-optimum) ;; best fake latin text generator ever +(require 'jumper) ;; navigation help for large projects/lotsa buffers +(require 'system-commands) ;; reboot, logout, etc. ;; ---------------------------------- 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-file-buffer.el b/modules/custom-buffer-file.el index e0224a32..9438e8ed 100644 --- a/modules/custom-file-buffer.el +++ b/modules/custom-buffer-file.el @@ -1,4 +1,4 @@ -;;; custom-file-buffer.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*- +;;; custom-buffer-file.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; This module provides custom buffer and file operations including PostScript @@ -240,8 +240,21 @@ 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) -;;; custom-file-buffer.el ends here. +(provide 'custom-buffer-file) +;;; custom-buffer-file.el ends here. 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-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 2af9c244..be1f26bb 100644 --- a/modules/custom-misc.el +++ b/modules/custom-misc.el @@ -152,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 034216d6..7d906e75 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -4,9 +4,14 @@ ;; Text transformation and sorting utilities for reformatting data structures. ;; -;; Main functions: +;; 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 ;; @@ -15,6 +20,8 @@ ;;; Code: +(require 'cl-lib) + ;; cj/custom-keymap defined in keybindings.el (eval-when-compile (defvar cj/custom-keymap)) (defvar cj/ordering-map) @@ -89,6 +96,90 @@ START and END identify the active region." (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. @@ -154,12 +245,24 @@ Returns the transformed string without modifying the buffer." "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) (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..1d5a14ea 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -283,9 +283,9 @@ Prompts user for the action when executing." ;; user composes org mode; recipient receives html (use-package org-msg - :ensure nil ;; loading locally for fixes + ;; :vc (:url "https://github.com/cjennings/org-msg" :rev :newest) + :load-path "/home/cjennings/code/org-msg" :defer 1 - :load-path "~/code/org-msg/" :after (org mu4e) :preface (defvar-keymap cj/email-map @@ -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..30f4606c 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 @@ -275,13 +273,25 @@ This allows a line to show in an agenda without being scheduled or a deadline." ;; This gives two notifications per event without any after-event notifications (setq chime-alert-time '(5 0)) - ;; Modeline display: show upcoming events within 60 minutes + ;; Modeline display: show upcoming events within 2 hours + (setq chime-enable-modeline t) (setq chime-modeline-lookahead 120) (setq chime-modeline-format " ⏰ %s") - ;; Chime sound: plays when notifications appear - (setq chime-play-sound t) - ;; Uses bundled chime.wav by default + ;; Modeline content: show title and countdown only (omit event time) + (setq chime-notification-text-format "%t (%u)") + + ;; Time-until format: compact style like " in 10m" or " in 1h 37m" + (setq chime-time-left-format-short " in %mm") ; Under 1 hour: " in 10m" + (setq chime-time-left-format-long " in %hh %mm") ; 1 hour+: " in 1h 37m" + (setq chime-time-left-format-at-event "right now") + + ;; Title truncation: limit long event titles to 15 characters + ;; This affects only the title, not the icon or countdown + (setq chime-max-title-length 25) ; "Very Long Me... ( in 10m)" + + ;; Chime sound: disabled + (setq chime-play-sound nil) ;; Notification settings (setq chime-notification-title "Reminder") @@ -298,6 +308,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..b3c63663 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,6 +96,10 @@ 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) @@ -90,5 +119,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..a6b42ce7 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: @@ -11,6 +19,7 @@ ;; ---------------------------------- Org Roam --------------------------------- (use-package org-roam + :defer 1 :commands (org-roam-node-find org-roam-node-insert org-roam-db-autosync-mode) :config ;; Enable autosync mode after org-roam loads @@ -77,7 +86,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 +201,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 +269,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 +285,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 +297,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/popper-config.el b/modules/popper-config.el index b0f503e8..d9a9d9b0 100644 --- a/modules/popper-config.el +++ b/modules/popper-config.el @@ -26,6 +26,7 @@ '("\\*Messages\\*" "Output\\*$" "\\*Async Shell Command\\*" + "\\*Async-native-compile-log\\*" help-mode compilation-mode)) (add-to-list 'display-buffer-alist diff --git a/modules/prog-general.el b/modules/prog-general.el index f6ebfe09..d8d9627d 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -264,12 +264,8 @@ If no such file exists there, display a message." ("C-c s n" . yas-new-snippet) ("C-c s e" . yas-visit-snippet-file) :config - (setq yas-snippet-dirs '(snippets-dir))) - -(use-package ivy-yasnippet - :after yasnippet - :bind - ("C-c s i" . ivy-yasnippet)) + (setq yas-snippet-dirs (list snippets-dir)) + (yas-reload-all)) ;; --------------------- Display Color On Color Declaration -------------------- ;; display the actual color as highlight to color hex code @@ -400,6 +396,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/prog-lisp.el b/modules/prog-lisp.el index 7693c253..cfa015ae 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -97,9 +97,12 @@ :commands (with-mock mocklet mocklet-function)) ;; mock/stub framework ;; --------------------------------- Elisp Lint -------------------------------- +;; Comprehensive linting for Emacs Lisp code (indentation, whitespace, etc.) +;; Used by chime.el 'make lint' target for code quality checks (use-package elisp-lint - :commands (elisp-lint-file elisp-lint-directory)) + :ensure t + :commands (elisp-lint-file elisp-lint-directory elisp-lint-files-batch)) ;; ------------------------------ Package Tooling ------------------------------ 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..a89afc02 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -27,7 +27,6 @@ (vertico-resize nil) ; Don't resize the minibuffer (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical :bind (:map vertico-map - ;; Match ivy's C-j C-k behavior ("C-j" . vertico-next) ("C-k" . vertico-previous) ("C-l" . vertico-insert) ; Insert current candidate @@ -128,7 +127,7 @@ ;; Use Consult for completion-at-point (setq completion-in-region-function #'consult-completion-in-region)) -(global-unset-key (kbd "C-s")) +;; Override default search with consult-line (keymap-global-set "C-s" #'consult-line) ;; Consult integration with Embark @@ -152,10 +151,10 @@ (use-package orderless :demand t :custom - (completion-styles '(orderless)) + (completion-styles '(orderless basic)) (completion-category-defaults nil) - (completion-category-overrides '((file (styles partial-completion)) - (multi-category (styles orderless)))) + (completion-category-overrides '((file (styles partial-completion orderless basic)) + (multi-category (styles orderless basic)))) (orderless-matching-styles '(orderless-literal orderless-regexp orderless-initialism @@ -183,16 +182,10 @@ nil (window-parameters (mode-line-format . none))))) -;; this typo causes crashes -;; (add-to-list 'display-buffer-alist -;; '("\\=\\*Embark Collect \\(Live\\|Completions\\)\\*" -;; nil -;; (window-parameters (mode-line-format . none))))) - ;; --------------------------- Consult Integration ---------------------------- ;; Additional integrations for specific features -;; Yasnippet integration - replaces ivy-yasnippet +;; Yasnippet integration (use-package consult-yasnippet :after yasnippet :bind ("C-c s i" . consult-yasnippet)) @@ -204,7 +197,7 @@ ("C-c ! c" . consult-flycheck))) ;; ---------------------------------- Company ---------------------------------- -;; In-buffer completion (retained from original configuration) +;; In-buffer completion for text and code (use-package company :demand t @@ -259,5 +252,13 @@ :config (company-prescient-mode)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c h" "consult history" + "C-c s i" "insert snippet" + "M-g" "goto menu" + "M-s" "search menu")) + (provide 'selection-framework) ;;; selection-framework.el ends here diff --git a/modules/system-commands.el b/modules/system-commands.el new file mode 100644 index 00000000..fb8c0611 --- /dev/null +++ b/modules/system-commands.el @@ -0,0 +1,138 @@ +;;; system-commands.el --- System power and session management -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; +;; System commands for logout, lock, suspend, shutdown, reboot, and Emacs +;; exit/restart. Provides both a keymap (C-; !) and a completing-read menu. +;; +;; Commands include: +;; - Logout (terminate user session) +;; - Lock screen (slock) +;; - Suspend (systemctl suspend) +;; - Shutdown (systemctl poweroff) +;; - Reboot (systemctl reboot) +;; - Exit Emacs (kill-emacs) +;; - Restart Emacs (via systemctl --user restart emacs.service) +;; +;; Dangerous commands (logout, suspend, shutdown, reboot) require confirmation. +;; +;;; Code: + +(eval-when-compile (require 'keybindings)) +(eval-when-compile (require 'subr-x)) +(require 'rx) + +;; ------------------------------ System Commands ------------------------------ + +(defun cj/system-cmd--resolve (cmd) + "Return (values symbol-or-nil command-string label) for CMD." + (cond + ((symbolp cmd) + (let ((val (and (boundp cmd) (symbol-value cmd)))) + (unless (and (stringp val) (not (string-empty-p val))) + (user-error "Variable %s is not a non-empty string" cmd)) + (list cmd val (symbol-name cmd)))) + ((stringp cmd) + (let ((s (string-trim cmd))) + (when (string-empty-p s) (user-error "Command string is empty")) + (list nil s "command"))) + (t (user-error "Error: cj/system-cmd expects a string or a symbol")))) + +(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. +If CMD is deemed dangerous, ask for confirmation." + (interactive (list (read-shell-command "System command: "))) + (pcase-let ((`(,sym ,cmdstr ,label) (cj/system-cmd--resolve cmd))) + (when (and sym (get sym 'cj/system-confirm) + (memq (read-char-choice + (format "Run %s now (%s)? (Y/n) " label cmdstr) + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N))) + (user-error "Aborted")) + (let ((proc (start-process-shell-command "cj/system-cmd" nil + (format "nohup %s >/dev/null 2>&1 &" cmdstr)))) + (set-process-query-on-exit-flag proc nil) + (set-process-sentinel proc #'ignore) + (message "Running %s..." label)))) + +(defmacro cj/defsystem-command (name var cmdstr &optional confirm) + "Define VAR with CMDSTR and interactive command NAME to run it. +If CONFIRM is non-nil, mark VAR to always require confirmation." + (declare (indent defun)) + `(progn + (defvar ,var ,cmdstr) + ,(when confirm `(put ',var 'cj/system-confirm t)) + (defun ,name () + ,(format "Run %s via `cj/system-cmd'." var) + (interactive) + (cj/system-cmd ',var)))) + +;; Define system commands +(cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) +(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") +(cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) +(cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" t) +(cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" t) + +(defun cj/system-cmd-exit-emacs () + "Exit Emacs server and all clients." + (interactive) + (when (memq (read-char-choice + "Exit Emacs? (Y/n) " + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N)) + (user-error "Aborted")) + (kill-emacs)) + +(defun cj/system-cmd-restart-emacs () + "Restart Emacs server after saving buffers." + (interactive) + (when (memq (read-char-choice + "Restart Emacs? (Y/n) " + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N)) + (user-error "Aborted")) + (save-some-buffers) + ;; Start the restart process before killing Emacs + (run-at-time 0.5 nil + (lambda () + (call-process-shell-command + "systemctl --user restart emacs.service && emacsclient -c" + nil 0))) + (run-at-time 1 nil #'kill-emacs) + (message "Restarting Emacs...")) + +(defvar-keymap cj/system-command-map + :doc "Keymap for system commands." + "L" #'cj/system-cmd-logout + "r" #'cj/system-cmd-reboot + "s" #'cj/system-cmd-shutdown + "S" #'cj/system-cmd-suspend + "l" #'cj/system-cmd-lock + "E" #'cj/system-cmd-exit-emacs + "e" #'cj/system-cmd-restart-emacs) +(keymap-set cj/custom-keymap "!" cj/system-command-map) + +(defun cj/system-command-menu () + "Present system commands via \='completing-read\='." + (interactive) + (let* ((commands '(("Logout System" . cj/system-cmd-logout) + ("Lock Screen" . cj/system-cmd-lock) + ("Suspend System" . cj/system-cmd-suspend) + ("Shutdown System" . cj/system-cmd-shutdown) + ("Reboot System" . cj/system-cmd-reboot) + ("Exit Emacs" . cj/system-cmd-exit-emacs) + ("Restart Emacs" . cj/system-cmd-restart-emacs))) + (choice (completing-read "System command: " commands nil t))) + (when-let ((cmd (alist-get choice commands nil nil #'equal))) + (call-interactively cmd)))) + +(keymap-set cj/custom-keymap "!" #'cj/system-command-menu) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; !" "system commands")) + +(provide 'system-commands) +;;; system-commands.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..93c799fb 100644 --- a/modules/wip.el +++ b/modules/wip.el @@ -14,134 +14,6 @@ ;; ;;; Code: -(eval-when-compile (require 'user-constants)) -(eval-when-compile (require 'keybindings)) -(eval-when-compile (require 'subr-x)) ;; for system commands -(require 'rx) ;; for system commands - -;; ------------------------------ System Commands ------------------------------ - -(defun cj/system-cmd--resolve (cmd) - "Return (values symbol-or-nil command-string label) for CMD." - (cond - ((symbolp cmd) - (let ((val (and (boundp cmd) (symbol-value cmd)))) - (unless (and (stringp val) (not (string-empty-p val))) - (user-error "Variable %s is not a non-empty string" cmd)) - (list cmd val (symbol-name cmd)))) - ((stringp cmd) - (let ((s (string-trim cmd))) - (when (string-empty-p s) (user-error "Command string is empty")) - (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. -If CMD is deemed dangerous, ask for confirmation." - (interactive (list (read-shell-command "System command: "))) - (pcase-let ((`(,sym ,cmdstr ,label) (cj/system-cmd--resolve cmd))) - (when (and sym (get sym 'cj/system-confirm) - (memq (read-char-choice - (format "Run %s now (%s)? (Y/n) " label camdstr) - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N))) - (user-error "Aborted")) - (let ((proc (start-process-shell-command "cj/system-cmd" nil - (format "nohup %s >/dev/null 2>&1 &" cmdstr)))) - (set-process-query-on-exit-flag proc nil) - (set-process-sentinel proc #'ignore) - (message "Running %s..." label)))) - -(defmacro cj/defsystem-command (name var cmdstr &optional confirm) - "Define VAR with CMDSTR and interactive command NAME to run it. -If CONFIRM is non-nil, mark VAR to always require confirmation." - (declare (indent defun)) - `(progn - (defvar ,var ,cmdstr) - ,(when confirm `(put ',var 'cj/system-confirm t)) - (defun ,name () - ,(format "Run %s via `cj/system-cmd'." var) - (interactive) - (cj/system-cmd ',var)))) - -;; Define system commands -(cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") -(cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) -(cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" t) -(cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" t) - -(defun cj/system-cmd-exit-emacs () - "Exit Emacs server and all clients." - (interactive) - (when (memq (read-char-choice - "Exit Emacs? (Y/n) " - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N)) - (user-error "Aborted")) - (kill-emacs)) - -(defun cj/system-cmd-restart-emacs () - "Restart Emacs server after saving buffers." - (interactive) - (when (memq (read-char-choice - "Restart Emacs? (Y/n) " - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N)) - (user-error "Aborted")) - (save-some-buffers) - ;; Start the restart process before killing Emacs - (run-at-time 0.5 nil - (lambda () - (call-process-shell-command - "systemctl --user restart emacs.service && emacsclient -c" - nil 0))) - (run-at-time 1 nil #'kill-emacs) - (message "Restarting Emacs...")) - -;; (defvar-keymap cj/system-command-map -;; :doc "Keymap for system commands." -;; "L" #'cj/system-cmd-logout -;; "r" #'cj/system-cmd-reboot -;; "s" #'cj/system-cmd-shutdown -;; "S" #'cj/system-cmd-suspend -;; "l" #'cj/system-cmd-lock -;; "E" #'cj/system-cmd-exit-emacs -;; "e" #'cj/system-cmd-restart-emacs) -;; (keymap-set cj/custom-keymap "!" cj/system-command-map) - -(defun cj/system-command-menu () - "Present system commands via \='completing-read\='." - (interactive) - (let* ((commands '(("Logout System" . cj/system-cmd-logout) - ("Lock Screen" . cj/system-cmd-lock) - ("Suspend System" . cj/system-cmd-suspend) - ("Shutdown System" . cj/system-cmd-shutdown) - ("Reboot System" . cj/system-cmd-reboot) - ("Exit Emacs" . cj/system-cmd-exit-emacs) - ("Restart Emacs" . cj/system-cmd-restart-emacs))) - (choice (completing-read "System command: " commands nil t))) - (when-let ((cmd (alist-get choice commands nil nil #'equal))) - (call-interactively cmd)))) - -(keymap-set cj/custom-keymap "!" #'cj/system-command-menu) - - -;; --------------------------- Org Upcoming Modeline --------------------------- - -;; (use-package org-upcoming-modeline -;; :after org -;; :load-path "~/code/org-upcoming-modeline/org-upcoming-modeline.el" -;; :config -;; (setq org-upcoming-modeline-keep-late 300) -;; (setq org-upcoming-modeline-ignored-keywords '("DONE" "CANCELLED" "FAILED")) -;; (setq org-upcoming-modeline-trim 30) -;; (setq org-upcoming-modeline-days-ahead 5) -;; (setq org-upcoming-modeline-format (lambda (ms mh) (format "📅 %s %s" ms mh))) -;; (org-upcoming-modeline-mode)) - ;; ----------------------------------- Efrit ----------------------------------- ;; not working as of Wednesday, September 03, 2025 at 12:44:09 AM CDT @@ -184,30 +56,5 @@ If CONFIRM is non-nil, mark VAR to always require confirmation." :bind ("M-p" . pomm) :commands (pomm pomm-third-time)) -;; ----------------------------------- Popper ---------------------------------- - -;; (use-package popper -;; :bind (("C-`" . popper-toggle) -;; ("M-`" . popper-cycle) -;; ("C-M-`" . popper-toggle-type)) -;; :custom -;; (popper-display-control-nil) -;; :init -;; (setq popper-reference-buffers -;; '("\\*Messages\\*" -;; "Output\\*$" -;; "\\*Async Shell Command\\*" -;; ;; "\\*scratch\\*" -;; help-mode -;; compilation-mode)) -;; (add-to-list 'display-buffer-alist -;; '(popper-display-control-p ; Predicate to match popper buffers -;; (display-buffer-in-side-window) -;; (side . bottom) -;; (slot . 0) -;; (window-height . 0.5))) ; Half the frame height -;; (popper-mode +1) -;; (popper-echo-mode +1)) - (provide 'wip) ;;; wip.el ends here. 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-file-buffer-clear-to-bottom-of-buffer.el b/tests/test-custom-buffer-file-clear-to-bottom-of-buffer.el index 969f9bb7..bd309880 100644 --- a/tests/test-custom-file-buffer-clear-to-bottom-of-buffer.el +++ b/tests/test-custom-buffer-file-clear-to-bottom-of-buffer.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-clear-to-bottom-of-buffer.el --- Tests for cj/clear-to-bottom-of-buffer -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-clear-to-bottom-of-buffer.el --- Tests for cj/clear-to-bottom-of-buffer -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/clear-to-bottom-of-buffer function from custom-file-buffer.el +;; Tests for the cj/clear-to-bottom-of-buffer function from custom-buffer-file.el ;; ;; This function deletes all text from point to the end of the current buffer. ;; It does not save the deleted text in the kill ring. @@ -22,7 +22,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -159,5 +159,5 @@ (should-error (cj/clear-to-bottom-of-buffer))) (test-clear-to-bottom-teardown))) -(provide 'test-custom-file-buffer-clear-to-bottom-of-buffer) -;;; test-custom-file-buffer-clear-to-bottom-of-buffer.el ends here +(provide 'test-custom-buffer-file-clear-to-bottom-of-buffer) +;;; test-custom-buffer-file-clear-to-bottom-of-buffer.el ends here diff --git a/tests/test-custom-file-buffer-clear-to-top-of-buffer.el b/tests/test-custom-buffer-file-clear-to-top-of-buffer.el index 18e3f71b..2bf79b27 100644 --- a/tests/test-custom-file-buffer-clear-to-top-of-buffer.el +++ b/tests/test-custom-buffer-file-clear-to-top-of-buffer.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-clear-to-top-of-buffer.el --- Tests for cj/clear-to-top-of-buffer -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-clear-to-top-of-buffer.el --- Tests for cj/clear-to-top-of-buffer -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/clear-to-top-of-buffer function from custom-file-buffer.el +;; Tests for the cj/clear-to-top-of-buffer function from custom-buffer-file.el ;; ;; This function deletes all text from point to the beginning of the current buffer. ;; It does not save the deleted text in the kill ring. @@ -22,7 +22,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -158,5 +158,5 @@ (should-error (cj/clear-to-top-of-buffer))) (test-clear-to-top-teardown))) -(provide 'test-custom-file-buffer-clear-to-top-of-buffer) -;;; test-custom-file-buffer-clear-to-top-of-buffer.el ends here +(provide 'test-custom-buffer-file-clear-to-top-of-buffer) +;;; test-custom-buffer-file-clear-to-top-of-buffer.el ends here diff --git a/tests/test-custom-file-buffer-copy-link-to-buffer-file.el b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el index 94d1e01e..262968d6 100644 --- a/tests/test-custom-file-buffer-copy-link-to-buffer-file.el +++ b/tests/test-custom-buffer-file-copy-link-to-buffer-file.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-copy-link-to-buffer-file.el --- Tests for cj/copy-link-to-buffer-file -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-copy-link-to-buffer-file.el --- Tests for cj/copy-link-to-buffer-file -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/copy-link-to-buffer-file function from custom-file-buffer.el +;; Tests for the cj/copy-link-to-buffer-file function from custom-buffer-file.el ;; ;; This function copies the full file:// path of the current buffer's file to ;; the kill ring. For non-file buffers, it does nothing (no error). @@ -22,7 +22,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -205,5 +205,5 @@ (should (null kill-ring)))) (test-copy-link-teardown))) -(provide 'test-custom-file-buffer-copy-link-to-buffer-file) -;;; test-custom-file-buffer-copy-link-to-buffer-file.el ends here +(provide 'test-custom-buffer-file-copy-link-to-buffer-file) +;;; test-custom-buffer-file-copy-link-to-buffer-file.el ends here diff --git a/tests/test-custom-file-buffer-copy-path-to-buffer-file-as-kill.el b/tests/test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el index e7a6f64b..08959a85 100644 --- a/tests/test-custom-file-buffer-copy-path-to-buffer-file-as-kill.el +++ b/tests/test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-copy-path-to-buffer-file-as-kill.el --- Tests for cj/copy-path-to-buffer-file-as-kill -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el --- Tests for cj/copy-path-to-buffer-file-as-kill -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/copy-path-to-buffer-file-as-kill function from custom-file-buffer.el +;; Tests for the cj/copy-path-to-buffer-file-as-kill function from custom-buffer-file.el ;; ;; This function copies the full path of the current buffer's file to the kill ring ;; and returns the path. It signals an error if the buffer is not visiting a file. @@ -22,7 +22,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -201,5 +201,5 @@ (should-error (cj/copy-path-to-buffer-file-as-kill) :type 'user-error)) (test-copy-path-teardown))) -(provide 'test-custom-file-buffer-copy-path-to-buffer-file-as-kill) -;;; test-custom-file-buffer-copy-path-to-buffer-file-as-kill.el ends here +(provide 'test-custom-buffer-file-copy-path-to-buffer-file-as-kill) +;;; test-custom-buffer-file-copy-path-to-buffer-file-as-kill.el ends here diff --git a/tests/test-custom-file-buffer-copy-whole-buffer.el b/tests/test-custom-buffer-file-copy-whole-buffer.el index a0546b18..181c491a 100644 --- a/tests/test-custom-file-buffer-copy-whole-buffer.el +++ b/tests/test-custom-buffer-file-copy-whole-buffer.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-copy-whole-buffer.el --- Tests for cj/copy-whole-buffer -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-copy-whole-buffer.el --- Tests for cj/copy-whole-buffer -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/copy-whole-buffer function from custom-file-buffer.el +;; Tests for the cj/copy-whole-buffer function from custom-buffer-file.el ;; ;; This function copies the entire contents of the current buffer to the kill ring. ;; Point and mark are left exactly where they were. No transient region is created. @@ -22,7 +22,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -190,5 +190,5 @@ (should (null (text-properties-at 0 (car kill-ring))))) (test-copy-whole-buffer-teardown))) -(provide 'test-custom-file-buffer-copy-whole-buffer) -;;; test-custom-file-buffer-copy-whole-buffer.el ends here +(provide 'test-custom-buffer-file-copy-whole-buffer) +;;; test-custom-buffer-file-copy-whole-buffer.el ends here diff --git a/tests/test-custom-file-buffer-delete-buffer-and-file.el b/tests/test-custom-buffer-file-delete-buffer-and-file.el index 1c43ff3b..4af8d2a7 100644 --- a/tests/test-custom-file-buffer-delete-buffer-and-file.el +++ b/tests/test-custom-buffer-file-delete-buffer-and-file.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-delete-buffer-and-file.el --- Tests for cj/delete-buffer-and-file -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-delete-buffer-and-file.el --- Tests for cj/delete-buffer-and-file -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/delete-buffer-and-file function from custom-file-buffer.el +;; Tests for the cj/delete-buffer-and-file function from custom-buffer-file.el ;; ;; This function deletes both the current buffer and the file it visits. ;; It uses vc-delete-file for version-controlled files and delete-file @@ -42,7 +42,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -667,5 +667,5 @@ (should-error (cj/delete-buffer-and-file)))) (test-delete-buffer-and-file-teardown))) -(provide 'test-custom-file-buffer-delete-buffer-and-file) -;;; test-custom-file-buffer-delete-buffer-and-file.el ends here +(provide 'test-custom-buffer-file-delete-buffer-and-file) +;;; test-custom-buffer-file-delete-buffer-and-file.el ends here diff --git a/tests/test-custom-file-buffer-move-buffer-and-file.el b/tests/test-custom-buffer-file-move-buffer-and-file.el index 1fc16011..e8f4563d 100644 --- a/tests/test-custom-file-buffer-move-buffer-and-file.el +++ b/tests/test-custom-buffer-file-move-buffer-and-file.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-move-buffer-and-file.el --- Tests for cj/move-buffer-and-file -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-move-buffer-and-file.el --- Tests for cj/move-buffer-and-file -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/--move-buffer-and-file function from custom-file-buffer.el +;; Tests for the cj/--move-buffer-and-file function from custom-buffer-file.el ;; ;; This is the internal (non-interactive) implementation that moves both the ;; current buffer and its visited file to a new directory. It handles trailing @@ -25,7 +25,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -932,5 +932,5 @@ (kill-buffer (current-buffer))) (test-move-buffer-and-file-teardown))) -(provide 'test-custom-file-buffer-move-buffer-and-file) -;;; test-custom-file-buffer-move-buffer-and-file.el ends here +(provide 'test-custom-buffer-file-move-buffer-and-file) +;;; test-custom-buffer-file-move-buffer-and-file.el ends here diff --git a/tests/test-custom-file-buffer-rename-buffer-and-file.el b/tests/test-custom-buffer-file-rename-buffer-and-file.el index ca8acff8..1eb61f1b 100644 --- a/tests/test-custom-file-buffer-rename-buffer-and-file.el +++ b/tests/test-custom-buffer-file-rename-buffer-and-file.el @@ -1,7 +1,7 @@ -;;; test-custom-file-buffer-rename-buffer-and-file.el --- Tests for cj/--rename-buffer-and-file -*- lexical-binding: t; -*- +;;; test-custom-buffer-file-rename-buffer-and-file.el --- Tests for cj/--rename-buffer-and-file -*- lexical-binding: t; -*- ;;; Commentary: -;; Tests for the cj/--rename-buffer-and-file function from custom-file-buffer.el +;; Tests for the cj/--rename-buffer-and-file function from custom-buffer-file.el ;; ;; This is the internal (non-interactive) implementation that renames both the ;; current buffer and its visited file. The interactive wrapper @@ -24,7 +24,7 @@ (provide 'ps-print) ;; Now load the actual production module -(require 'custom-file-buffer) +(require 'custom-buffer-file) ;;; Setup and Teardown @@ -935,5 +935,5 @@ (kill-buffer (current-buffer))) (test-rename-buffer-and-file-teardown))) -(provide 'test-custom-file-buffer-rename-buffer-and-file) -;;; test-custom-file-buffer-rename-buffer-and-file.el ends here +(provide 'test-custom-buffer-file-rename-buffer-and-file) +;;; test-custom-buffer-file-rename-buffer-and-file.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-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 |