diff options
| -rw-r--r-- | README.md | 8 | ||||
| -rw-r--r-- | docs/plans/2026-04-10-navigation-history-implementation.md | 118 | ||||
| -rw-r--r-- | lisp/ss-keys.el | 4 | ||||
| -rw-r--r-- | lisp/ss-org.el | 175 | ||||
| -rw-r--r-- | tests/ss-capture-tests.el | 145 |
5 files changed, 409 insertions, 41 deletions
@@ -174,14 +174,22 @@ The configured capture templates cover: The people CRM remains outside `org-capture`: `M-x ss-crm-add` writes directly to `~/org/areas/people/people.org`. +Navigation history adds a small browser-style back and forward layer on top of +mark-based movement. It records significant note jumps from the custom journal +and MOC commands, CRM find/open commands, `org-open-at-point`, common agenda +jumps, and `denote-open-or-create`, while ignoring ordinary cursor motion and +same-location no-ops. + ## Keybindings The main bindings are: - `C-c a` for the agenda +- `C-c b` to move back through recorded note and mark navigation history - `c` inside the agenda dispatcher to show the custom `Clarify items` view for `CLARIFY` tasks - `C-c c` for capture +- `C-c f` to move forward again after using navigation back - `C-c n n` to open or create a Denote note - `C-c n l` to insert a Denote link - `C-c n j` to open the full `~/org/journal.org` buffer diff --git a/docs/plans/2026-04-10-navigation-history-implementation.md b/docs/plans/2026-04-10-navigation-history-implementation.md new file mode 100644 index 0000000..0d58756 --- /dev/null +++ b/docs/plans/2026-04-10-navigation-history-implementation.md @@ -0,0 +1,118 @@ +# Navigation History Implementation Plan + +> **For Claude:** REQUIRED SUB-SKILL: Use superpowers:executing-plans to implement this plan task-by-task. + +**Goal:** Add small, browser-style back and forward navigation commands for note and mark-based movement across Org, agenda, CRM, and Denote workflows. + +**Architecture:** Keep the navigation state and restoration helpers in `lisp/ss-org.el`, using marker-based location records plus a simple back stack and forward stack. Record only significant jumps by wiring the repo's custom note commands and advising common built-in jump commands after they move, while skipping same-location noise and clearing forward history on fresh navigation. + +**Tech Stack:** Emacs Lisp, ERT, batch Emacs verification, interactive `emacs -nw` sanity check + +--- + +### Task 1: Add failing navigation tests + +**Files:** +- Modify: `tests/ss-capture-tests.el` +- Modify: `lisp/ss-org.el` + +**Step 1: Write the failing tests** + +```elisp +(ert-deftest ss-jump-back-restores-previous-location-and-enables-forward () + ...) + +(ert-deftest ss-navigation-push-current-location-clears-forward-on-fresh-jump () + ...) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL because the navigation stack commands and helper functions do not exist yet. + +**Step 3: Write minimal implementation** + +```elisp +(defvar ss-navigation-back-stack nil) +(defvar ss-navigation-forward-stack nil) +... +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS for the new stack behavior tests. + +**Step 5: Commit** + +```bash +git add tests/ss-capture-tests.el lisp/ss-org.el +git commit -m "Add navigation history stack" +``` + +### Task 2: Wire note and jump commands into history + +**Files:** +- Modify: `lisp/ss-org.el` +- Modify: `lisp/ss-keys.el` + +**Step 1: Write the failing test** + +```elisp +(ert-deftest ss-navigation-jump-wrapper-records-pre-jump-location () + ...) +``` + +**Step 2: Run test to verify it fails** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -f ert-run-tests-batch-and-exit` +Expected: FAIL because custom navigation commands and advised jump commands do not record history yet. + +**Step 3: Write minimal implementation** + +```elisp +(defun ss-navigation-record-before-command (&rest _) + ...) + +(advice-add 'org-open-at-point :before #'ss-navigation-record-before-command) +``` + +**Step 4: Run test to verify it passes** + +Run: `emacs --batch -Q -L . -L lisp -l tests/ss-capture-tests.el -l tests/ss-crm-tests.el -f ert-run-tests-batch-and-exit` +Expected: PASS, with the navigation helpers loaded cleanly beside the existing CRM and capture tests. + +**Step 5: Commit** + +```bash +git add lisp/ss-org.el lisp/ss-keys.el tests/ss-capture-tests.el +git commit -m "Wire note jumps into navigation history" +``` + +### Task 3: Update docs and verify startup behavior + +**Files:** +- Modify: `README.md` +- Review: `AGENTS.md` + +**Step 1: Update docs** + +Add the new `C-c b` and `C-c f` bindings plus a short explanation of what participates in navigation history. + +**Step 2: Run verification** + +Run: `emacs --batch -Q --load ./init.el` +Expected: PASS with the updated navigation code loaded through the normal startup path. + +**Step 3: Run interactive sanity check** + +Run: `emacs -nw` +Expected: manual verification that MOC, journal, and note jumps can go back and forward, and that a fresh jump clears forward history. + +**Step 4: Commit** + +```bash +git add README.md +git commit -m "Document navigation history bindings" +``` diff --git a/lisp/ss-keys.el b/lisp/ss-keys.el index c83c1e5..4816eea 100644 --- a/lisp/ss-keys.el +++ b/lisp/ss-keys.el @@ -16,6 +16,10 @@ (when (ss-feature-enabled-p 'capture) (global-set-key (kbd "C-c c") #'org-capture)) + (when (ss-feature-enabled-p 'org) + (global-set-key (kbd "C-c b") #'ss-jump-back) + (global-set-key (kbd "C-c f") #'ss-jump-forward)) + (when (and (ss-feature-enabled-p 'denote) (fboundp 'denote-open-or-create) (fboundp 'denote-link)) diff --git a/lisp/ss-org.el b/lisp/ss-org.el index 793ee1d..f1a2274 100644 --- a/lisp/ss-org.el +++ b/lisp/ss-org.el @@ -9,6 +9,177 @@ (require 'org) (require 'ss-core) +(defvar ss-navigation-back-stack nil + "Stack of older locations for `ss-jump-back'.") + +(defvar ss-navigation-forward-stack nil + "Stack of newer locations for `ss-jump-forward'.") + +(defvar ss-navigation--inhibit-recording nil + "When non-nil, suppress navigation history recording.") + +(defun ss-navigation--current-location () + "Return the current location as a marker-backed plist." + (unless (minibufferp (current-buffer)) + (list :marker (copy-marker (point-marker)) + :window-start + (when (window-live-p (selected-window)) + (copy-marker (window-start (selected-window))))))) + +(defun ss-navigation--location-valid-p (location) + "Return non-nil when LOCATION still points to a live buffer position." + (when-let ((marker (plist-get location :marker))) + (and (markerp marker) + (marker-buffer marker) + (marker-position marker)))) + +(defun ss-navigation--same-location-p (left right) + "Return non-nil when LEFT and RIGHT identify the same buffer position." + (and (ss-navigation--location-valid-p left) + (ss-navigation--location-valid-p right) + (eq (marker-buffer (plist-get left :marker)) + (marker-buffer (plist-get right :marker))) + (= (marker-position (plist-get left :marker)) + (marker-position (plist-get right :marker))))) + +(defun ss-navigation--prune-stack (stack) + "Return STACK with dead or duplicate locations removed." + (let (pruned previous) + (dolist (location stack (nreverse pruned)) + (when (and (ss-navigation--location-valid-p location) + (not (ss-navigation--same-location-p location previous))) + (push location pruned) + (setq previous location))))) + +(defun ss-navigation--push-location (stack-symbol location &optional clear-forward) + "Push LOCATION onto STACK-SYMBOL unless it duplicates the top entry. +When CLEAR-FORWARD is non-nil, reset `ss-navigation-forward-stack'." + (when (ss-navigation--location-valid-p location) + (set stack-symbol (ss-navigation--prune-stack (symbol-value stack-symbol))) + (unless (ss-navigation--same-location-p location (car (symbol-value stack-symbol))) + (set stack-symbol (cons location (symbol-value stack-symbol)))) + (when clear-forward + (setq ss-navigation-forward-stack nil)) + t)) + +(defun ss-navigation-push-current-location () + "Push the current location onto the back stack. +This is for significant navigation points only and clears forward history." + (interactive) + (ss-navigation--push-location + 'ss-navigation-back-stack + (ss-navigation--current-location) + 'clear-forward)) + +(defun ss-navigation--restore-location (location) + "Restore LOCATION, returning non-nil when successful." + (when (ss-navigation--location-valid-p location) + (let* ((marker (plist-get location :marker)) + (buffer (marker-buffer marker)) + (window-start (plist-get location :window-start))) + (switch-to-buffer buffer) + (goto-char marker) + (when (and (markerp window-start) + (eq (marker-buffer window-start) buffer) + (window-live-p (selected-window))) + (set-window-start (selected-window) + (marker-position window-start) + t)) + t))) + +(defun ss-navigation--jump-from-stack (stack-symbol target-symbol) + "Restore the next location from STACK-SYMBOL and push current onto TARGET-SYMBOL." + (set stack-symbol (ss-navigation--prune-stack (symbol-value stack-symbol))) + (when-let ((target (car (symbol-value stack-symbol)))) + (let ((current (ss-navigation--current-location))) + (set stack-symbol (cdr (symbol-value stack-symbol))) + (when (ss-navigation--location-valid-p current) + (ss-navigation--push-location target-symbol current)) + (let ((ss-navigation--inhibit-recording t)) + (ss-navigation--restore-location target))))) + +(defun ss-navigation--jump-via-command (command) + "Use COMMAND as a mark-ring fallback jump, recording forward history." + (when (fboundp command) + (let ((before (ss-navigation--current-location)) + after) + (let ((ss-navigation--inhibit-recording t)) + (condition-case nil + (call-interactively command) + (error nil))) + (setq after (ss-navigation--current-location)) + (when (and (ss-navigation--location-valid-p before) + (ss-navigation--location-valid-p after) + (not (ss-navigation--same-location-p before after))) + (ss-navigation--push-location 'ss-navigation-forward-stack before) + t)))) + +(defun ss-jump-back () + "Move backward through navigation history." + (interactive) + (or (ss-navigation--jump-from-stack + 'ss-navigation-back-stack + 'ss-navigation-forward-stack) + (ss-navigation--jump-via-command 'pop-global-mark) + (ss-navigation--jump-via-command 'pop-to-mark-command) + (progn + (message "No back location available") + nil))) + +(defun ss-jump-forward () + "Move forward through navigation history." + (interactive) + (or (ss-navigation--jump-from-stack + 'ss-navigation-forward-stack + 'ss-navigation-back-stack) + (progn + (message "No forward location available") + nil))) + +(defun ss-navigation--record-jump (original &rest args) + "Record the pre-jump location around ORIGINAL with ARGS." + (if ss-navigation--inhibit-recording + (apply original args) + (let ((before (ss-navigation--current-location)) + result) + (setq result (apply original args)) + (let ((after (ss-navigation--current-location))) + (when (and (ss-navigation--location-valid-p before) + (ss-navigation--location-valid-p after) + (not (ss-navigation--same-location-p before after))) + (ss-navigation--push-location + 'ss-navigation-back-stack + before + 'clear-forward))) + result))) + +(defun ss-navigation--advise-command (command) + "Wrap COMMAND so significant jumps record navigation history." + (unless (advice-member-p #'ss-navigation--record-jump command) + (advice-add command :around #'ss-navigation--record-jump))) + +(defun ss-navigation-setup () + "Install navigation history advice for note-related jump commands." + (dolist (command '(ss-open-journal + ss-open-journal-today-session + ss-open-journal-full + ss-open-moc)) + (ss-navigation--advise-command command)) + (with-eval-after-load 'org + (ss-navigation--advise-command 'org-open-at-point)) + (with-eval-after-load 'org-agenda + (dolist (command '(org-agenda-goto + org-agenda-switch-to + org-agenda-open-link)) + (ss-navigation--advise-command command))) + (with-eval-after-load 'denote + (ss-navigation--advise-command 'denote-open-or-create)) + (with-eval-after-load 'ss-crm + (dolist (command '(ss-crm-find + ss-crm-open + ss-crm-overview)) + (ss-navigation--advise-command command)))) + (defvar ss-journal-session-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "C-c C-c") #'ss-journal-session-save-and-dismiss) @@ -105,7 +276,9 @@ (add-hook 'emacs-startup-hook (lambda () - (find-file (ss-require-existing-file ss-moc-file))))) + (find-file (ss-require-existing-file ss-moc-file)))) + + (ss-navigation-setup)) (provide 'ss-org) diff --git a/tests/ss-capture-tests.el b/tests/ss-capture-tests.el index b91d4ef..006c90d 100644 --- a/tests/ss-capture-tests.el +++ b/tests/ss-capture-tests.el @@ -13,6 +13,65 @@ (require 'ss-capture) (require 'ss-org) +(ert-deftest ss-jump-back-restores-previous-location-and-enables-forward () + (let ((ss-navigation-back-stack nil) + (ss-navigation-forward-stack nil) + (buffer-a (generate-new-buffer " *ss-nav-a*")) + (buffer-b (generate-new-buffer " *ss-nav-b*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer buffer-a + (insert "alpha") + (goto-char 3)) + (with-current-buffer buffer-b + (insert "bravo") + (goto-char 5)) + (switch-to-buffer buffer-a) + (ss-navigation-push-current-location) + (switch-to-buffer buffer-b) + (should (ss-jump-back)) + (should (eq (current-buffer) buffer-a)) + (should (= (point) 3)) + (should (ss-jump-forward)) + (should (eq (current-buffer) buffer-b)) + (should (= (point) 5))) + (kill-buffer buffer-a) + (kill-buffer buffer-b)))) + +(ert-deftest ss-navigation-push-current-location-clears-forward-after-back () + (let ((ss-navigation-back-stack nil) + (ss-navigation-forward-stack nil) + (buffer-a (generate-new-buffer " *ss-nav-a*")) + (buffer-b (generate-new-buffer " *ss-nav-b*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer buffer-a + (insert "alpha") + (goto-char 2)) + (with-current-buffer buffer-b + (insert "bravo") + (goto-char 4)) + (switch-to-buffer buffer-a) + (ss-navigation-push-current-location) + (switch-to-buffer buffer-b) + (should (ss-jump-back)) + (should ss-navigation-forward-stack) + (ss-navigation-push-current-location) + (should-not ss-navigation-forward-stack)) + (kill-buffer buffer-a) + (kill-buffer buffer-b)))) + +(ert-deftest ss-navigation-record-jump-skips-noop-movements () + (let ((ss-navigation-back-stack nil) + (ss-navigation-forward-stack nil)) + (with-temp-buffer + (switch-to-buffer (current-buffer)) + (insert "alpha") + (goto-char 2) + (ss-navigation--record-jump (lambda () nil)) + (should-not ss-navigation-back-stack) + (should-not ss-navigation-forward-stack)))) + (ert-deftest ss-journal-ensure-day-sections-adds-all-standard-sections () (with-temp-buffer (org-mode) @@ -34,30 +93,35 @@ (ert-deftest ss-open-journal-narrows-to-today-when-entry-exists () (let* ((file (make-temp-file "ss-journal" nil ".org")) - (ss-journal-file file)) + (ss-journal-file file) + (test-time (encode-time 0 0 12 9 4 2026))) (unwind-protect - (progn + (cl-letf (((symbol-function 'current-time) + (lambda () + test-time))) (with-temp-file file (insert "#+title: Journal\n" "* 2026\n" "** 2026-04-09 Thursday\n" "*** Notes\n")) - (let ((org-overriding-default-time (encode-time 0 0 12 9 4 2026))) - (ss-open-journal) - (should (buffer-narrowed-p)) - (should (equal (org-get-outline-path t) - '("2026" "2026-04-09 Thursday"))) - (should (looking-at-p "^\\*\\* 2026-04-09 Thursday$")))) - (when (buffer-live-p (current-buffer)) - (kill-buffer (current-buffer))) + (ss-open-journal) + (should (buffer-narrowed-p)) + (should (equal (org-get-outline-path t) + '("2026" "2026-04-09 Thursday"))) + (should (looking-at-p "^\\*\\* 2026-04-09 Thursday$"))) + (when-let ((buffer (get-file-buffer file))) + (kill-buffer buffer)) (when (file-exists-p file) (delete-file file))))) (ert-deftest ss-open-journal-reveals-folded-today-subtree () (let* ((file (make-temp-file "ss-journal" nil ".org")) - (ss-journal-file file)) + (ss-journal-file file) + (test-time (encode-time 0 0 12 9 4 2026))) (unwind-protect - (progn + (cl-letf (((symbol-function 'current-time) + (lambda () + test-time))) (with-temp-file file (insert "#+title: Journal\n" "* 2026\n" @@ -66,45 +130,46 @@ "Body\n")) (with-current-buffer (find-file-noselect file) (org-overview)) - (let ((org-overriding-default-time (encode-time 0 0 12 9 4 2026))) - (ss-open-journal) - (should (buffer-narrowed-p)) - (should-not - (save-excursion - (goto-char (point-min)) - (re-search-forward "^\\*\\*\\* Notes$" nil t) - (invisible-p (point)))) - (should-not - (save-excursion - (goto-char (point-min)) - (re-search-forward "^Body$" nil t) - (invisible-p (point)))))) - (when (buffer-live-p (current-buffer)) - (kill-buffer (current-buffer))) + (ss-open-journal) + (should (buffer-narrowed-p)) + (should-not + (save-excursion + (goto-char (point-min)) + (re-search-forward "^\\*\\*\\* Notes$" nil t) + (invisible-p (point)))) + (should-not + (save-excursion + (goto-char (point-min)) + (re-search-forward "^Body$" nil t) + (invisible-p (point))))) + (when-let ((buffer (get-file-buffer file))) + (kill-buffer buffer)) (when (file-exists-p file) (delete-file file))))) (ert-deftest ss-open-journal-creates-missing-today-entry-with-standard-sections () (let* ((file (make-temp-file "ss-journal" nil ".org")) - (ss-journal-file file)) + (ss-journal-file file) + (test-time (encode-time 0 0 12 9 4 2026))) (unwind-protect - (progn + (cl-letf (((symbol-function 'current-time) + (lambda () + test-time))) (with-temp-file file (insert "#+title: Journal\n" "* 2026\n" "** 2026-04-08 Wednesday\n" "*** Notes\n")) - (let ((org-overriding-default-time (encode-time 0 0 12 9 4 2026))) - (ss-open-journal) - (should (buffer-narrowed-p)) - (should (equal (org-get-outline-path t) - '("2026" "2026-04-09 Thursday"))) - (should (string-match-p - (regexp-quote - "** 2026-04-09 Thursday\n*** Tasks\n*** Notes\n*** Meetings\n") - (buffer-string))))) - (when (buffer-live-p (current-buffer)) - (kill-buffer (current-buffer))) + (ss-open-journal) + (should (buffer-narrowed-p)) + (should (equal (org-get-outline-path t) + '("2026" "2026-04-09 Thursday"))) + (should (string-match-p + (regexp-quote + "** 2026-04-09 Thursday\n*** Tasks\n*** Notes\n*** Meetings\n") + (buffer-string)))) + (when-let ((buffer (get-file-buffer file))) + (kill-buffer buffer)) (when (file-exists-p file) (delete-file file))))) |