diff options
| -rw-r--r-- | docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org | 5 | ||||
| -rw-r--r-- | init.el | 1 | ||||
| -rw-r--r-- | modules/org-agenda-config.el | 123 | ||||
| -rw-r--r-- | modules/org-agenda-frame.el | 874 | ||||
| -rw-r--r-- | tests/test-integration-org-agenda-frame-load-order.el | 89 | ||||
| -rw-r--r-- | tests/test-org-agenda-config--auto-refresh.el | 170 | ||||
| -rw-r--r-- | tests/test-org-agenda-config-display.el | 69 | ||||
| -rw-r--r-- | tests/test-org-agenda-frame.el | 1167 |
8 files changed, 324 insertions, 2174 deletions
diff --git a/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org b/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org index 567da53b..497131dc 100644 --- a/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org +++ b/docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org @@ -4,10 +4,11 @@ #+TODO: TODO | DONE #+TODO: DRAFT READY DOING | IMPLEMENTED SUPERSEDED CANCELLED -* IMPLEMENTED org-agenda fullscreen frame +* SUPERSEDED org-agenda fullscreen frame :PROPERTIES: :ID: 7705c94b-9bb7-47d8-9828-e9584172c54f :END: +- 2026-07-27 Mon @ 13:57 -0500 — SUPERSEDED. Craig replaced the whole design with a separate Emacs process that shows the agenda, toggles fullscreen on a key, and refreshes itself every five minutes. This reverses the "Not a separate OS process" non-goal below: the daemon frame bought live shared state, but paid for it with a default-deny read-only policy, engage-routing, auto-dim suspension, and a marker-cloning failure path — machinery that only existed because the agenda shared a process with the working frames. A separate process needs none of it. =modules/org-agenda-frame.el= and its two test files were deleted and =S-<f8>= returned to =cj/org-agenda-refresh-files=. - 2026-07-20 Mon @ 15:33 -0500 — post-implementation correction: dropped =(fullscreen . fullboth)= from the spawned frame. Craig's "fullscreen" meant a normal frame at its full tiled position, not a compositor-wide fullscreen; the frame is now a plain =make-frame= that a tiling WM (Hyprland) places side by side with the working frame. The engage-routing and focus logic are unchanged and now matter more (open a task in the adjacent working pane). The spec's "fullscreen" wording and filename are retained as historical; read them as "dedicated tiled frame". Covered by =test-org-agenda-frame-parameters-normal-tiled-frame=. - 2026-07-20 Mon @ 14:10 -0500 — IMPLEMENTED. Built both phases in =modules/org-agenda-frame.el= (58 ERT tests, full suite green, byte-compile clean, full init loads clean, live-reloaded into the daemon with all wiring confirmed). Phase 1: frame lookup/predicate/working-frame routing, the =F= today-anchored 7-day view + registration, the default-deny =cj/agenda-frame-mode= (allowlist + two message classes + menu removal + finalize re-enable), transactional spawn/raise/delete/toggle, engage routing, sticky/close lifecycle. Phase 2: the 5-min wall-clock =org-agenda-redo= timer with the window/focus contract, duplicate-timer prevention, deterministic point restoration, the frame-owned last-good snapshot with cloned markers + failure overlay + report-once latch, and the public =cj/agenda-frame-toggle= on =S-<f8>= with the force-rescan moved to =C-M-<f8>=. The compositor fullscreen/focus and real-redo behaviors are a residual manual check (VERIFY filed under Manual testing). - 2026-07-20 Mon @ 13:30 -0500 — DOING. Decomposed into build tasks (Phase 1, Phase 2, flip-to-IMPLEMENTED) under the fullscreen-frame PROJECT in todo.org; =:SPEC_ID:= stamped. Building Phase 1. @@ -27,7 +28,7 @@ - 2026-07-17 Fri @ 19:34:07 -0500 — drafted. * Metadata -| Status | implemented | +| Status | superseded | |----------+------------------------------------------------| | Owner | Craig Jennings | |----------+------------------------------------------------| @@ -129,7 +129,6 @@ (require 'org-config) ;; basic org-mode settings (require 'org-faces-config) ;; custom themeable faces for agenda keywords + priorities (require 'org-agenda-config) ;; agenda, task tracking, and notifications -(require 'org-agenda-frame) ;; S-<f8> dedicated agenda frame (tiled beside the working frame) (require 'org-babel-config) ;; org-mode prog blocks; literate programming (require 'org-capture-config) (require 'org-contacts-config) ;; fully integrated org-mode contacts management diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index 1e91fa48..599a8abf 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -20,21 +20,25 @@ ;; keep normal agenda opens fast. ;;; Code: +(require 'seq) (require 'user-constants) (require 'system-lib) (require 'cj-cache-lib) -(defcustom cj/org-agenda-window-height 0.75 - "Fraction of the selected frame used for the org agenda window." - :type 'number - :group 'org-agenda) - (defun cj/--org-agenda-display-rule () - "Return the display-buffer rule for the org agenda buffer." - `("\\*Org Agenda\\*" - (display-buffer-reuse-mode-window display-buffer-below-selected) - (dedicated . t) - (window-height . ,cj/org-agenda-window-height))) + "Return the display-buffer rule for the org agenda buffer. +`display-buffer-full-frame' gives the agenda the whole frame rather than a +fraction of it, so the view is a surface you read rather than a strip you +squint at. `org-agenda-restore-windows-after-quit' (set below) is what +makes that non-destructive: quitting the agenda puts the previous window +layout back. + +The window is deliberately not `dedicated': with the agenda owning the only +window, a dedicated one leaves `org-agenda-switch-to' (RET on an item) with +nowhere to put the file, and it splits or opens a frame instead of simply +replacing the agenda." + '("\\*Org Agenda\\*" + (display-buffer-reuse-mode-window display-buffer-full-frame))) ;; Load debug functions if enabled (when (or (eq cj/debug-modules t) @@ -65,7 +69,12 @@ ;; that reaches `org-agenda-files' another way. (setq org-agenda-skip-unavailable-files t) - ;; display the agenda from the bottom + ;; The agenda takes the whole frame, so quitting it has to give the previous + ;; window layout back -- otherwise every F8 costs the arrangement of windows + ;; that were up when it was pressed. + (setq org-agenda-restore-windows-after-quit t) + + ;; display the agenda across the whole frame (add-to-list 'display-buffer-alist (cj/--org-agenda-display-rule)) @@ -75,6 +84,89 @@ (local-set-key (kbd "s-<left>") #'org-agenda-todo-previousset)))) +;; ---------------------------- Agenda Auto-Refresh ---------------------------- +;; A full-frame agenda is meant to be left up and glanced at, so it has to stay +;; current on its own: the now-line moves, and calendar-sync writes new events +;; into the agenda files behind it. One repeating timer rebuilds whichever +;; agenda is actually on screen. + +(defcustom cj/org-agenda-refresh-seconds 300 + "Cadence, in seconds, of the org-agenda auto-refresh. +The timer fires on wall-clock multiples of this value, so the default 300 +refreshes on the :00/:05/:10 marks rather than five minutes after whenever +the agenda happened to open." + :type 'integer + :group 'org-agenda) + +(defvar cj/--org-agenda-refresh-timer nil + "The repeating auto-refresh timer, or nil when auto-refresh is stopped.") + +(declare-function org-agenda-redo "org-agenda" (&optional all)) + +(defun cj/--org-agenda-seconds-to-next-mark (time period) + "Return seconds from TIME to the next wall-clock multiple of PERIOD. +TIME is any Emacs time value; PERIOD is a positive number of seconds, so +300 gives the :00/:05 marks. A TIME landing exactly on a mark returns a +full PERIOD rather than zero, so the timer never fires twice back to back." + (unless (and (numberp period) (> period 0)) + (error "Refresh period must be a positive number of seconds: %S" period)) + (let ((remainder (mod (floor (float-time time)) period))) + (if (zerop remainder) period (- period remainder)))) + +(defun cj/--org-agenda-refresh-window () + "Return a live window displaying an org-agenda buffer, or nil. +Only a visible agenda is worth rebuilding: an off-screen one costs the same +full rescan and shows it to nobody, and it will be rebuilt on the next tick +after it comes back into view." + (seq-find (lambda (window) + (with-current-buffer (window-buffer window) + (derived-mode-p 'org-agenda-mode))) + (window-list-1 nil 'nomini 'visible))) + +(defun cj/--org-agenda-auto-refresh () + "Rebuild the on-screen agenda, leaving point on the line it was on. +Does nothing when no agenda is displayed. + +The body is wrapped in `condition-case' deliberately. This runs from a +repeating timer, where an unguarded signal resignals on every tick and +buries Emacs in identical backtraces -- the failure mode that made +calendar-sync's hourly timer unusable. A failed rebuild is logged and the +timer keeps its cadence." + (condition-case err + (when-let* ((window (cj/--org-agenda-refresh-window))) + (with-selected-window window + (let ((line (line-number-at-pos))) + (org-agenda-redo) + (goto-char (point-min)) + (forward-line (1- line))))) + (error + (cj/log-silently + (format "org-agenda auto-refresh failed: %s" (error-message-string err)))))) + +(defun cj/org-agenda-auto-refresh-start () + "Start the wall-clock-aligned agenda auto-refresh timer. +Cancels any existing timer first, so re-loading this module into a running +daemon replaces the ticker rather than stacking a second one." + (interactive) + (cj/org-agenda-auto-refresh-stop) + (setq cj/--org-agenda-refresh-timer + (run-at-time (cj/--org-agenda-seconds-to-next-mark + (current-time) cj/org-agenda-refresh-seconds) + cj/org-agenda-refresh-seconds + #'cj/--org-agenda-auto-refresh))) + +(defun cj/org-agenda-auto-refresh-stop () + "Cancel the agenda auto-refresh timer. A no-op when already stopped." + (interactive) + (when (timerp cj/--org-agenda-refresh-timer) + (cancel-timer cj/--org-agenda-refresh-timer)) + (setq cj/--org-agenda-refresh-timer nil)) + +;; Arm at load. Skipped under `noninteractive' so a batch test run doesn't +;; carry a live repeating timer it has nothing to refresh. +(unless noninteractive + (cj/org-agenda-auto-refresh-start)) + ;; ----------------------- Project-name Category Override --------------------- ;; The default `org-category' for a todo.org buffer is "todo" (the filename ;; without extension), which renders as "todo:" in every agenda `%c' column @@ -225,14 +317,11 @@ improves performance from several seconds to instant." Use this after adding new projects or todo.org files. Bypasses cache and scans directories from scratch. -Bound to C-M-<f8>, the force-rebuild sibling of the F8 agenda family -\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer). -The binding lives in `org-agenda-frame.el', which took S-<f8> for the -agenda-frame toggle and moved the force-rescan here." +Bound to S-<f8>, the force-rebuild sibling of the F8 agenda family +\(<f8> display, s-<f8> all files, C-<f8> single project, M-<f8> this buffer)." (interactive) (cj/build-org-agenda-list 'force-rebuild)) -;; S-<f8> and C-M-<f8> are bound by `org-agenda-frame.el' (cj/--agenda-frame-install-keys): -;; S-<f8> toggles the dedicated agenda frame; C-M-<f8> runs the force-rescan above. +(global-set-key (kbd "S-<f8>") #'cj/org-agenda-refresh-files) (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el deleted file mode 100644 index 471b246b..00000000 --- a/modules/org-agenda-frame.el +++ /dev/null @@ -1,874 +0,0 @@ -;;; org-agenda-frame.el --- Dedicated agenda frame -*- lexical-binding: t; -*- -;; author: Craig Jennings <c@cjennings.net> - -;;; Commentary: -;; -;; Layer: 4 (Optional). -;; Category: O/D. -;; Load shape: eager (binds keys in Phase 2; Phase 1 defines helpers only). -;; Top-level side effects: none yet (Phase 1 is private helpers). -;; Runtime requires: none. -;; Direct test load: yes. -;; -;; A dedicated Emacs frame of the running daemon that shows a today-anchored -;; seven-day org-agenda, refreshing itself, kept read-only and focus-locked. -;; A normal (non-fullscreen) frame, so a tiling WM places it side by side with -;; the working frame. Spawned/raised/closed by one key. See the spec: -;; docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org. -;; -;; Phase 1 (this pass) builds non-interactive helpers only: frame lookup, -;; spawn/raise/delete, the dedicated view, the default-deny read-only policy, -;; and working-frame routing. No interactive command or key is bound until -;; Phase 2, so nothing user-visible changes yet. - -;;; Code: - -(require 'seq) - -;; Declared, not required: `org-agenda-config' pulls in vc packages that don't -;; load under `make test' (no package-initialize). The frame module references -;; org-agenda symbols through these declarations and does its real wiring inside -;; `with-eval-after-load' so a batch test-load runs no org-agenda side effects. -(defvar org-agenda-custom-commands) -(defvar org-agenda-finalize-hook) -(defvar org-agenda-mode-map) -(defvar org-agenda-sticky) -(defvar org-agenda-window-setup) -(declare-function cj/build-org-agenda-list "org-agenda-config" (&optional force-rebuild)) -(declare-function cj/org-agenda-refresh-files "org-agenda-config" ()) -(declare-function org-agenda-redo "org-agenda" (&optional all)) -(declare-function org-agenda-next-line "org-agenda" ()) -(declare-function org-agenda-previous-line "org-agenda" ()) -(declare-function org-agenda-next-item "org-agenda" (n)) -(declare-function org-agenda-previous-item "org-agenda" (n)) -(declare-function org-agenda-open-link "org-agenda" (&optional arg)) -(declare-function org-agenda-priority-down "org-agenda" ()) -(declare-function org-agenda-priority-up "org-agenda" ()) -(declare-function org-agenda-todo "org-agenda" (&optional arg)) -(declare-function org-agenda-todo-nextset "org-agenda" ()) -(declare-function org-agenda-todo-previousset "org-agenda" ()) -(declare-function org-get-at-bol "org" (property)) -(declare-function org-fold-show-context "org-fold" (&optional key)) -(declare-function org-agenda "org-agenda" (&optional arg org-keys restriction)) -;; No declare-function for -safe-redo / -delete: they are defined later in THIS -;; file, and the byte-compiler resolves same-file forward references at end of -;; compilation. A declare-function for a same-file function instead counts as a -;; second definition ("defined multiple times") and, worse, its declared arglist -;; overrides the real one for arg-count checking -- the empty () shadowed -;; -safe-redo's actual (&optional frame), disabling that check. - -(defconst cj/--agenda-frame-parameter 'cj/agenda-frame - "Frame parameter marking the dedicated agenda frame. -Its presence (non-nil) is how `cj/--agenda-frame' locates the frame among -all of the daemon's frames.") - -(defvar cj/--agenda-frame-launch-frame nil - "The frame selected when the agenda frame was last spawned. -Preferred routing target for source files opened from the agenda (see -`cj/--agenda-frame-working-frame'); ignored once it is dead or is itself -the agenda frame.") - -(defun cj/--agenda-frame-p (frame) - "Return non-nil when FRAME is a live agenda frame. -FRAME is an agenda frame when it is live and carries the -`cj/--agenda-frame-parameter' marker; a dead frame is never one." - (and (frame-live-p frame) - (frame-parameter frame cj/--agenda-frame-parameter))) - -(defun cj/--agenda-frame () - "Return the live agenda frame, or nil. -The frame is identified by the `cj/--agenda-frame-parameter' marker; a -dead frame is never returned even if it still carries the marker." - (seq-find #'cj/--agenda-frame-p (frame-list))) - -(defun cj/--agenda-frame-working-frame () - "Return a live non-agenda frame to route source files into, or nil. -Prefer `cj/--agenda-frame-launch-frame' when it is still live and not the -agenda frame; otherwise the first live non-agenda frame among all frames. -Return nil when the agenda frame is the only live frame -- the caller then -creates a normal frame." - (or (and (frame-live-p cj/--agenda-frame-launch-frame) - (not (cj/--agenda-frame-p cj/--agenda-frame-launch-frame)) - cj/--agenda-frame-launch-frame) - (seq-find (lambda (frame) - (and (frame-live-p frame) - (not (cj/--agenda-frame-p frame)))) - (frame-list)))) - -;;; The dedicated seven-day view (org-agenda-custom-commands key F) - -(defconst cj/--agenda-frame-command-key "F" - "The `org-agenda-custom-commands' key for the agenda-frame view. -The existing top-level key is `d' (org-agenda-config.el:344), so `F' is -collision-free. The sticky buffer derives its name from this key -\(*Org Agenda(F)*).") - -(defvar cj/--agenda-frame-span 7 - "Span, in days, of the agenda-frame view. -The `F' custom command reads this via its `org-agenda-span' setting, which -Org evaluates on every build and every redo, so `cj/--agenda-frame-day-view' -\(span 1) and `cj/--agenda-frame-week-view' (span 7) change it and the next -redo picks up the new span. Reset to 7 on each spawn so a fresh frame opens -at the documented default.") - -(defun cj/--agenda-frame-command () - "Return the `org-agenda-custom-commands' entry for the agenda frame. -A one-block agenda: a `cj/--agenda-frame-span'-day span anchored to today -rather than -Monday (`org-agenda-list' otherwise anchors any seven-day span to the -week start in Org 9.7.11), rendered in the frame's sole window -\(`current-window', so Org's default `reorganize-frame' can't split it), -as its own sticky *Org Agenda(F)* buffer, with follow-mode forced off so -a non-nil global default can't open a second window at build time." - `(,cj/--agenda-frame-command-key "Agenda frame: 7-day today-anchored" - ((agenda "" - ((org-agenda-span cj/--agenda-frame-span) - (org-agenda-start-day "0d") - (org-agenda-start-on-weekday nil) - (org-agenda-start-with-follow-mode nil) - ;; The global daily agenda intentionally keeps scheduled done - ;; items visible. The Full Agenda is a live work surface, so - ;; completed items are noise regardless of schedule or priority. - (org-agenda-skip-function - '(org-agenda-skip-entry-if 'todo 'done)) - ;; Narrow category column: the global agenda format pads the - ;; category to 25 chars, leaving a wide blank gutter between - ;; the source name (todo:, dcal:) and the item. - (org-agenda-prefix-format " %i %-10:c%?-12t% s")))) - ;; No `org-agenda-sticky' here, deliberately: these settings are baked - ;; into the buffer's series-redo-cmd and re-applied by every redo, and a - ;; sticky t mid-redo makes `org-agenda-use-sticky-p' true while the - ;; buffer exists -- `org-agenda-prepare' then throws \\='exit ("use `r' - ;; to refresh") with no catch, failing every refresh tick. Stickiness - ;; is bound in the spawn wrapper instead, where it names the buffer. - ((org-agenda-window-setup 'current-window)))) - -(defun cj/--agenda-frame-register-command () - "Register the agenda-frame view in `org-agenda-custom-commands'. -Idempotent: any existing entry for `cj/--agenda-frame-command-key' is -replaced, so a module reload never accumulates duplicate keys." - (setq org-agenda-custom-commands - (cons (cj/--agenda-frame-command) - (assoc-delete-all cj/--agenda-frame-command-key - org-agenda-custom-commands)))) - -;;; Engage routing — open the item's source outside the agenda frame - -(defun cj/--agenda-frame-item-marker () - "Return the source marker for the agenda item at point, or nil. -Prefers the item's own marker, falling back to the heading marker. Reads -the text property directly (like `org-get-at-bol') so point restoration -is exercisable without loading org." - (or (get-text-property (line-beginning-position) 'org-marker) - (get-text-property (line-beginning-position) 'org-hd-marker))) - -(defun cj/--agenda-frame-target-frame () - "Return the frame to open agenda source in, creating one when needed. -The engage action never opens into the agenda frame: it targets the -working frame (`cj/--agenda-frame-working-frame'), and when the agenda -frame is the only live frame it creates a normal, non-fullscreen frame." - (or (cj/--agenda-frame-working-frame) - (make-frame))) - -(defun cj/--agenda-frame-engage-open () - "Open the source of the agenda item at point in the working frame. -Routes to the MRU non-agenda frame (or a new normal frame when the agenda -frame is the only one), so the agenda frame keeps showing the agenda. -Signals a `user-error' when point is not on an agenda item." - (interactive) - (let ((marker (cj/--agenda-frame-item-marker))) - (unless (and marker (marker-buffer marker)) - (user-error "No agenda item on this line")) - (let ((buffer (marker-buffer marker)) - (pos (marker-position marker)) - (frame (cj/--agenda-frame-target-frame))) - (select-frame-set-input-focus frame) - (pop-to-buffer-same-window buffer) - (widen) - (goto-char pos) - (when (derived-mode-p 'org-mode) - (org-fold-show-context 'agenda)) - (beginning-of-line)))) - -(defun cj/--agenda-frame-engage-mouse (event) - "Open the agenda item clicked by EVENT in the working frame." - (interactive "e") - (mouse-set-point event) - (cj/--agenda-frame-engage-open)) - -(defun cj/--agenda-frame-open-link () - "Follow the link in the agenda item at point, in the working frame." - (interactive) - (select-frame-set-input-focus (cj/--agenda-frame-target-frame)) - (org-agenda-open-link)) - -(defun cj/--agenda-frame-close () - "Close the agenda frame from within it. -Bound to q, Q, and x so Org's own quit keys delete the whole frame -\(and cancel its timer) rather than leaving a sole-window agenda -frame stranded on a non-agenda buffer." - (interactive) - (cj/--agenda-frame-delete)) - -;;; Default-deny read-only policy - -(defconst cj/--agenda-frame-readonly-message - "Agenda frame is read-only — press RET to edit in your working frame" - "Shown when a mutating or buffer-opening command is denied in the frame.") - -(defconst cj/--agenda-frame-fixed-view-message - "Agenda frame shows only the day (d) and week (w) views" - "Shown when a view-changing command is denied in the frame.") - -(defun cj/--agenda-frame-denied-readonly () - "Deny a mutating or buffer-opening command in the agenda frame. -The default binding for every key not on the allowlist." - (interactive) - (message "%s" cj/--agenda-frame-readonly-message)) - -(defun cj/--agenda-frame-denied-fixed-view () - "Deny a view-changing command that would break the today-anchored span." - (interactive) - (message "%s" cj/--agenda-frame-fixed-view-message)) - -(defvar cj/agenda-frame-mode-map - (let ((map (make-sparse-keymap))) - ;; Default-deny: every key/mouse event not rebound below funnels through - ;; this one catch-all, so mutations (present and future) are read-only. - (define-key map [t] #'cj/--agenda-frame-denied-readonly) - ;; Hide the Org Agenda menu-bar entry so there is no menu path to a mutation. - (define-key map [menu-bar org-agenda] #'undefined) - ;; (a) Navigation — allowlisted to their org-agenda commands. - (define-key map (kbd "n") #'org-agenda-next-line) - (define-key map (kbd "p") #'org-agenda-previous-line) - (define-key map (kbd "<down>") #'org-agenda-next-line) - (define-key map (kbd "<up>") #'org-agenda-previous-line) - (define-key map (kbd "C-n") #'org-agenda-next-line) - (define-key map (kbd "C-p") #'org-agenda-previous-line) - (define-key map (kbd "N") #'org-agenda-next-item) - (define-key map (kbd "P") #'org-agenda-previous-item) - (define-key map (kbd "C-v") #'scroll-up-command) - (define-key map (kbd "M-v") #'scroll-down-command) - (define-key map (kbd "M-<") #'beginning-of-buffer) - (define-key map (kbd "M->") #'end-of-buffer) - ;; Read-only point motion and search within the agenda. - (define-key map (kbd "C-a") #'move-beginning-of-line) - (define-key map (kbd "C-e") #'move-end-of-line) - (define-key map (kbd "C-f") #'forward-char) - (define-key map (kbd "C-b") #'backward-char) - (define-key map (kbd "C-s") #'isearch-forward) - (define-key map (kbd "C-r") #'isearch-backward) - (define-key map (kbd "C-g") #'keyboard-quit) - ;; (b) Engage / open — routed to the working frame, never the agenda frame. - ;; Bind the GUI function-key events ([return]/[tab]) as well as the ASCII - ;; forms: the [t] catch-all otherwise gives `return'/`tab' a binding, which - ;; suppresses their function-key translation to RET/TAB, so a bare RET would - ;; hit the deny handler instead of engaging in a graphical frame. - (define-key map (kbd "RET") #'cj/--agenda-frame-engage-open) - (define-key map (kbd "TAB") #'cj/--agenda-frame-engage-open) - (define-key map [return] #'cj/--agenda-frame-engage-open) - (define-key map [tab] #'cj/--agenda-frame-engage-open) - (define-key map (kbd "<mouse-2>") #'cj/--agenda-frame-engage-mouse) - (define-key map (kbd "C-c C-o") #'cj/--agenda-frame-open-link) - ;; (c) The frame's own controls. - (define-key map (kbd "q") #'cj/--agenda-frame-close) - (define-key map (kbd "Q") #'cj/--agenda-frame-close) - (define-key map (kbd "x") #'cj/--agenda-frame-close) - (define-key map (kbd "r") #'cj/--agenda-frame-safe-redo) - ;; g is the muscle-memory agenda refresh; keep it working here (the - ;; frame-scoped safe redo, same as r) rather than denying it as a - ;; view-change. C-M-<f8> stays the force-rescan. - (define-key map (kbd "g") #'cj/--agenda-frame-safe-redo) - ;; d / w toggle the span (today's day vs the seven-day view) in place; the - ;; other view-changers stay denied to keep the today-anchored frame stable. - (define-key map (kbd "d") #'cj/--agenda-frame-day-view) - (define-key map (kbd "w") #'cj/--agenda-frame-week-view) - ;; (d) Controlled task mutations. The frame remains default-deny for - ;; scheduling, clocking, capture, notes, and file writes, but status and - ;; priority are deliberate in-place agenda operations. C-c t is Craig's - ;; requested status chord; C-c C-t keeps Org's standard agenda chord. - ;; This config uses Super arrows in ordinary Org agendas, while Meta arrows - ;; are the requested Full Agenda muscle memory, so support both. - (define-key map (kbd "C-c t") #'org-agenda-todo) - (define-key map (kbd "C-c C-t") #'org-agenda-todo) - (dolist (key '("M-<up>" "s-<up>")) - (define-key map (kbd key) #'org-agenda-priority-up)) - (dolist (key '("M-<down>" "s-<down>")) - (define-key map (kbd key) #'org-agenda-priority-down)) - (dolist (key '("M-<left>" "s-<left>")) - (define-key map (kbd key) #'org-agenda-todo-previousset)) - (dolist (key '("M-<right>" "s-<right>")) - (define-key map (kbd key) #'org-agenda-todo-nextset)) - (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) - (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files) - ;; C-x C-c means "close this frame" here. The global - ;; `save-buffers-kill-terminal' must never run in this frame: it was made - ;; by `make-frame', not emacsclient, so with no client to close it falls - ;; back to killing the daemon itself. - (define-key map (kbd "C-x C-c") #'cj/--agenda-frame-close) - ;; (e) Input machinery punched through the catch-all. An explicit nil - ;; shadows the [t] default in this map, so these fall through to their - ;; global bindings. Without the punches, every frame-focus change - ;; (switch-frame), every wheel scroll, and every mouse click hits the - ;; deny handler -- message spam and broken frame switching. - (dolist (key (list [switch-frame] - [wheel-up] [wheel-down] [wheel-left] [wheel-right] - [double-wheel-up] [double-wheel-down] - [triple-wheel-up] [triple-wheel-down] - [mouse-1] [down-mouse-1] [drag-mouse-1] - (kbd "C-h"))) - (define-key map key nil)) - ;; (f) Global chords that would pull focus out of the frame must be - ;; denied *explicitly*. The [t] catch-all can't reach them: a keymap's - ;; default binding does not shadow an *explicit* binding in a - ;; lower-priority map, and these are bound in the global map (M-SPC / - ;; M-S-SPC swap ai-term agents). Left to the catch-all, M-SPC follows - ;; its global binding and escapes the read-only frame into ai-term. - (dolist (key '("M-SPC" "M-S-SPC")) - (define-key map (kbd key) #'cj/--agenda-frame-denied-readonly)) - ;; The remaining view-changers get the distinct fixed-view message, not the - ;; read-only one. d/w are handled above (they toggle the span in place). - (dolist (key '("y" "f" "b" "j")) - (define-key map (kbd key) #'cj/--agenda-frame-denied-fixed-view)) - map) - "Keymap for `cj/agenda-frame-mode'. -Shadows `org-agenda-mode-map' by default-deny: the `[t]' catch-all denies -every key that is not explicitly allowlisted here. Status and priority are -the only source-task mutations allowed; a future Org binding is denied by -default and there is nothing to keep in sync.") - -(define-minor-mode cj/agenda-frame-mode - "Focus-locked, default-deny policy for the dedicated agenda frame. -Only the allowlist in `cj/agenda-frame-mode-map' is permitted: navigation, -the engage/open keys (routed to the working frame), and the frame's own -controls, plus controlled task status and priority changes. Every other -key/mouse command is denied. The enforcement boundary is keys and mouse; -a direct \\[execute-extended-command] is out of contract." - :init-value nil - :lighter " AgendaFrame" - :keymap cj/agenda-frame-mode-map) - -(defun cj/--agenda-frame-shadow-mutations (&optional source-map prefix) - "Deny every SOURCE-MAP key sequence not on the frame map's allowlist. -Walk SOURCE-MAP (default `org-agenda-mode-map') recursively. For each -sequence it binds to a command, if `cj/agenda-frame-mode-map' doesn't already -bind that sequence to a command or manage it as a prefix, add an explicit -read-only deny. - -This closes the default-deny hole: a keymap's `[t]' default never shadows an -explicit binding in a lower-priority map, so a single `[t]' catch-all denies -only keys that are unbound everywhere. Every key `org-agenda-mode-map' binds -\(t, I, k, z, s, ., the C-c mutators, C-x C-s, ...) would otherwise sail -through the catch-all and mutate source files from the read-only frame. -Explicitly denying each non-allowlisted sequence makes the catch-all's intent -actually hold. - -PREFIX is the accumulated key vector during recursion (internal). Idempotent: -re-running rebinds the same denials. Runs from `with-eval-after-load' once -`org-agenda-mode-map' exists." - (let ((source (or source-map org-agenda-mode-map)) - (prefix (or prefix []))) - (map-keymap - (lambda (event binding) - (unless (or (eq event t) (eq event 'menu-bar) (eq event 'remap) - (consp event)) - (let ((seq (vconcat prefix (vector event)))) - (cond - ((keymapp binding) - (cj/--agenda-frame-shadow-mutations binding seq)) - ((commandp binding) - (let ((ours (lookup-key cj/agenda-frame-mode-map seq))) - ;; A command we allowlisted or a prefix we manage: leave it. - ;; Anything else (only the `[t]' default, or unbound under a - ;; shared prefix) escapes to org's command -- deny it here. - (unless (or (commandp ours) (keymapp ours)) - (define-key cj/agenda-frame-mode-map seq - #'cj/--agenda-frame-denied-readonly)))))))) - source))) - -;; The shadow walk is installed at the END of this file, not here: it reads -;; `commandp' on each allowlisted binding to decide whether to keep it, and the -;; view/redo handlers (day-view, week-view, safe-redo) are defined further down. -;; If org-agenda is already loaded when this file loads (the normal startup order, -;; and every reload), `with-eval-after-load' fires immediately -- so the walk must -;; not run until those defuns exist, or it reads them as undefined, fails the -;; commandp guard, and denies the very keys the allowlist grants. See the bottom -;; of the file. - -(defun cj/--agenda-frame-maybe-enable-mode () - "Re-enable `cj/agenda-frame-mode' after an agenda build in the agenda frame. -Added to `org-agenda-finalize-hook'. `org-agenda-redo' rebuilds through -`org-agenda-mode', whose `kill-all-local-variables' strips the buffer-local -minor mode; this reinstates it whenever the just-built buffer is displayed -in the frame carrying the `cj/agenda-frame' marker (a frame parameter, which -survives the buffer reset). Ordinary agenda builds in working frames are -left untouched. - -The same reset also strips the buffer-local `kill-buffer-hook' installed at -spawn, so it is re-added here too -- otherwise, after the first refresh -tick, killing the buffer would no longer delete the frame." - (let ((frame (cj/--agenda-frame))) - (when (and frame (get-buffer-window (current-buffer) frame)) - (cj/agenda-frame-mode 1) - (add-hook 'kill-buffer-hook #'cj/--agenda-frame-on-kill-buffer nil t)))) - -;;; Frame lifecycle — spawn, raise, delete, toggle, cleanup - -(defconst cj/--agenda-frame-timer-parameter 'cj/agenda-frame-timer - "Frame parameter holding the agenda frame's refresh timer (set in Phase 2).") - -(declare-function auto-dim-other-buffers-mode "auto-dim-other-buffers" (&optional arg)) - -(defvar cj/--agenda-frame-dim-was-on nil - "Non-nil when the agenda frame's spawn turned `auto-dim-other-buffers-mode' off. -The refresh tick's selection swing marks the working window non-selected, -and auto-dim's debounced dim lands after the tick -- the working frame -visibly dims every five minutes. Spawn suspends the mode and remembers it -here; closing the frame restores it.") - -(defun cj/--agenda-frame-suspend-dim () - "Turn auto-dim off for the agenda frame's lifetime, remembering it was on." - (when (and (bound-and-true-p auto-dim-other-buffers-mode) - (fboundp 'auto-dim-other-buffers-mode)) - (setq cj/--agenda-frame-dim-was-on t) - (auto-dim-other-buffers-mode -1))) - -(defun cj/--agenda-frame-restore-dim () - "Restore auto-dim if the agenda frame's spawn suspended it." - (when (and cj/--agenda-frame-dim-was-on - (fboundp 'auto-dim-other-buffers-mode)) - (setq cj/--agenda-frame-dim-was-on nil) - (auto-dim-other-buffers-mode 1))) - -(defvar cj/--agenda-frame-tearing-down nil - "Non-nil while the agenda frame is being torn down. -Breaks the `delete-frame' / `kill-buffer-hook' re-entrancy loop: deleting -the frame kills its buffer and killing the buffer deletes the frame, so -whichever fires first sets this to skip the other.") - -(defun cj/--agenda-frame-sticky-buffer () - "Return the dedicated *Org Agenda(F)* sticky buffer, or nil if none." - (get-buffer (format "*Org Agenda(%s)*" cj/--agenda-frame-command-key))) - -(defun cj/--agenda-frame-cancel-timer (&optional frame) - "Cancel and clear the refresh timer on FRAME (default: the agenda frame). -Safe when no timer is set or FRAME is dead. Returns nil." - (let* ((frame (or frame (cj/--agenda-frame))) - (timer (and (frame-live-p frame) - (frame-parameter frame cj/--agenda-frame-timer-parameter)))) - (when (timerp timer) - (cancel-timer timer)) - (when (frame-live-p frame) - (set-frame-parameter frame cj/--agenda-frame-timer-parameter nil)) - nil)) - -(defun cj/--agenda-frame-on-delete-frame (frame) - "Clean up when the agenda FRAME dies by any path. -Registered on `delete-frame-functions': cancels the refresh timer and -kills the dedicated sticky buffer, so the next spawn regenerates fresh -rather than reusing stale sticky content. A non-agenda frame is ignored." - (when (cj/--agenda-frame-p frame) - (cj/--agenda-frame-cancel-timer frame) - (cj/--agenda-frame-restore-dim) - (let ((buffer (cj/--agenda-frame-sticky-buffer)) - (cj/--agenda-frame-tearing-down t)) - (when (buffer-live-p buffer) - (kill-buffer buffer))))) - -(defun cj/--agenda-frame-on-kill-buffer () - "Delete the agenda frame when its dedicated buffer is killed. -A buffer-local `kill-buffer-hook' on the sticky buffer, so killing it from -anywhere takes the frame with it. Guarded against re-entry during a -frame-initiated teardown." - (unless cj/--agenda-frame-tearing-down - (let ((frame (cj/--agenda-frame))) - (when (frame-live-p frame) - (delete-frame frame))))) - -(defun cj/--agenda-frame-delete () - "Delete the agenda frame; a no-op when none exists. -`delete-frame' fires `cj/--agenda-frame-on-delete-frame', which cancels -the timer and kills the sticky buffer." - (let ((frame (cj/--agenda-frame))) - (when (frame-live-p frame) - (delete-frame frame)))) - -(defun cj/--agenda-frame-raise (frame) - "Raise FRAME and give it input focus. Returns FRAME." - (select-frame-set-input-focus frame) - frame) - -(defun cj/--agenda-frame-make-parameters () - "Return the frame parameters for the dedicated agenda frame. -A normal frame -- not fullscreen -- so a tiling window manager places it -side by side with the working frame rather than covering the whole output. -It carries the `cj/agenda-frame' marker and a distinct, noticeable name -\(\"Full Agenda\") so the frame is recognizable at a glance and -window-manager rules can target it." - `((,cj/--agenda-frame-parameter . t) - (name . "Full Agenda"))) - -(defun cj/--agenda-frame-spawn () - "Create, display, and focus the dedicated agenda frame. -Transactional: on any failure after `make-frame', delete the partial -frame (which cleans up its buffer and timer via the delete hook), restore -focus to the launching frame, and signal a `user-error' naming the cause. -Returns the new agenda frame on success." - (let ((launch (selected-frame)) - (frame nil)) - (condition-case err - (progn - (setq cj/--agenda-frame-launch-frame launch) - ;; A fresh frame opens at the documented seven-day default, even if a - ;; prior session left the span on the day view (d). - (setq cj/--agenda-frame-span 7) - (setq frame (make-frame (cj/--agenda-frame-make-parameters))) - (select-frame-set-input-focus frame) - ;; Cached, non-forced: a frame spawned early after daemon startup - ;; still shows the full project agenda, not the base-files-only view. - (cj/build-org-agenda-list) - ;; Bind sticky + current-window dynamically around the render. The - ;; custom command's own settings apply too late to name the buffer; - ;; without these the buffer is plain *Org Agenda*, which matches the - ;; 0.75 below-selected display rule in org-agenda-config.el -- the - ;; new frame gets split with the launch buffer left in the top 25%. - ;; Sticky names it *Org Agenda(F)*, which no display rule matches. - (let ((org-agenda-sticky t) - (org-agenda-window-setup 'current-window)) - (org-agenda "a" cj/--agenda-frame-command-key)) - ;; Belt: whatever a display rule did, the frame is one agenda window. - (delete-other-windows) - (let ((buffer (cj/--agenda-frame-sticky-buffer))) - (when (buffer-live-p buffer) - (with-current-buffer buffer - (add-hook 'kill-buffer-hook - #'cj/--agenda-frame-on-kill-buffer nil t)))) - (cj/--agenda-frame-start-timer frame) - (cj/--agenda-frame-suspend-dim) - frame) - (error - (when (frame-live-p frame) - (delete-frame frame)) - (when (frame-live-p launch) - (select-frame-set-input-focus launch)) - (user-error "Agenda frame: spawn failed: %s" - (error-message-string err)))))) - -(defun cj/--agenda-frame-toggle () - "Spawn, raise, or delete the dedicated agenda frame. -Spawn when none exists, delete when the agenda frame is the selected -frame, raise and focus it otherwise. - -Non-interactive by design in Phase 1: reachable only from ERT, never from -\\[execute-extended-command] or a key. Phase 2 wraps this in the public -`cj/agenda-frame-toggle' and binds it to S-<f8>." - (let ((frame (cj/--agenda-frame))) - (cond - ((null frame) (cj/--agenda-frame-spawn)) - ((eq frame (selected-frame)) (cj/--agenda-frame-delete) nil) - (t (cj/--agenda-frame-raise frame))))) - -;;; Phase 2 — refresh timer, snapshot restore, and the public command - -(defconst cj/--agenda-frame-refresh-seconds 300 - "Refresh cadence for the agenda frame, in seconds (five minutes).") - -(defconst cj/--agenda-frame-fail-count-parameter 'cj/agenda-frame-fail-count - "Frame parameter holding the consecutive-failure count for the refresh timer.") - -(defconst cj/--agenda-frame-overlay-property 'cj/agenda-frame-failure - "Overlay property tagging the refresh-failed banner. -The banner is found by scanning for this property, never held in a -buffer-local variable: `org-agenda-redo' runs `kill-all-local-variables', -which would wipe the variable while the overlay object survives -`erase-buffer' -- leaving a banner nothing could ever remove.") - -(defun cj/--agenda-frame-seconds-to-next-mark (time period) - "Return seconds from TIME to the next wall-clock multiple of PERIOD. -TIME is any Emacs time value, PERIOD is seconds (300 gives the :00/:05 -marks). A TIME exactly on a mark returns a full PERIOD, so the timer -never fires twice back-to-back." - (let ((rem (mod (floor (float-time time)) period))) - (if (zerop rem) period (- period rem)))) - -;; -- Point restoration ------------------------------------------------------- - -(defun cj/--agenda-frame-goto-first-item () - "Move point to the first agenda item, or `point-min' when the view is empty." - (goto-char (point-min)) - (let ((found nil)) - (while (and (not found) (not (eobp))) - (if (get-text-property (line-beginning-position) 'org-marker) - (setq found t) - (forward-line 1))) - (unless found (goto-char (point-min))))) - -(defun cj/--agenda-frame-restore-point (old-marker old-line) - "Restore point in the rebuilt agenda buffer after a redo. -Prefer the line whose org-marker points at the same source location as -OLD-MARKER, choosing the occurrence nearest OLD-LINE when a source line -appears twice. When the marker is gone, clamp OLD-LINE into range; if -that lands on a header (no item), move to the first item; an item-less -view leaves point at buffer start." - (let ((max-line (line-number-at-pos (point-max))) - (targets '())) - (when (and (markerp old-marker) (marker-buffer old-marker)) - (let ((src-buf (marker-buffer old-marker)) - (src-pos (marker-position old-marker))) - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((m (get-text-property (line-beginning-position) 'org-marker))) - (when (and (markerp m) - (eq (marker-buffer m) src-buf) - (eql (marker-position m) src-pos)) - (push (line-number-at-pos) targets))) - (forward-line 1))))) - (cond - (targets - (let ((best (car (sort targets - (lambda (a b) - (< (abs (- a old-line)) (abs (- b old-line)))))))) - (goto-char (point-min)) - (forward-line (1- best)))) - (t - (let ((line (max 1 (min old-line max-line)))) - (goto-char (point-min)) - (forward-line (1- line)) - (unless (get-text-property (line-beginning-position) 'org-marker) - (cj/--agenda-frame-goto-first-item))))))) - -;; -- Snapshot with cloned markers -------------------------------------------- - -(defun cj/--agenda-frame-snapshot-markers (buffer) - "Return a list of (POSITION . CLONE) for every org-marker in BUFFER. -CLONE is an independent `copy-marker' into the same source location, so -it survives `org-agenda-reset-markers' nulling BUFFER's own markers on a -rebuild." - (with-current-buffer buffer - (let ((clones '()) - (pos (point-min))) - (while (< pos (point-max)) - (let ((m (get-text-property pos 'org-marker))) - (when (and (markerp m) (marker-buffer m)) - (push (cons pos (copy-marker m)) clones))) - (setq pos (or (next-single-property-change pos 'org-marker buffer) - (point-max)))) - (nreverse clones)))) - -(defun cj/--agenda-frame-reinstall-markers (buffer clones) - "Reapply CLONES (from `cj/--agenda-frame-snapshot-markers') to BUFFER. -Restores each cloned marker as the org-marker text property at its -recorded position, so RET/TAB resolve to the right source line after a -snapshot restore." - (with-current-buffer buffer - (dolist (entry clones) - (let ((pos (car entry))) - (when (and (>= pos (point-min)) (< pos (point-max))) - (put-text-property pos (1+ pos) 'org-marker (cdr entry))))))) - -(defun cj/--agenda-frame-snapshot (buffer window) - "Capture BUFFER's last-good state for restore after a failed redo. -Returns a plist of the propertized :text (carrying org-redo-cmd/org-lprops), -:point, :window-start, and :markers (cloned, source-owned)." - (with-current-buffer buffer - (list :text (buffer-substring (point-min) (point-max)) - :point (point) - :window-start (and (window-live-p window) (window-start window)) - :markers (cj/--agenda-frame-snapshot-markers buffer)))) - -(defun cj/--agenda-frame-restore-snapshot (buffer snapshot window) - "Restore SNAPSHOT verbatim into BUFFER, reinstating cloned markers. -Sets point and, when WINDOW is live, window-start from the snapshot." - (with-current-buffer buffer - (let ((inhibit-read-only t)) - (erase-buffer) - (insert (plist-get snapshot :text)) - (cj/--agenda-frame-reinstall-markers buffer (plist-get snapshot :markers)) - (goto-char (min (plist-get snapshot :point) (point-max)))) - (when (and (window-live-p window) (plist-get snapshot :window-start)) - (set-window-start window (min (plist-get snapshot :window-start) - (point-max)))))) - -(defun cj/--agenda-frame-release-snapshot (snapshot) - "Release SNAPSHOT's cloned markers so repeated redoes don't leak markers. -Called on a successful redo (the snapshot is discarded); never on the -error path, where the clones become the buffer's live org-markers." - (dolist (entry (plist-get snapshot :markers)) - (when (markerp (cdr entry)) - (set-marker (cdr entry) nil)))) - -;; -- Failure latch and overlay ----------------------------------------------- - -(defun cj/--agenda-frame-record-failure (frame) - "Increment FRAME's consecutive-failure count; return non-nil to report. -Reports only on the first failure of a run (the 0 -> 1 transition)." - (let ((n (1+ (or (frame-parameter frame cj/--agenda-frame-fail-count-parameter) - 0)))) - (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter n) - (= n 1))) - -(defun cj/--agenda-frame-clear-failure (frame) - "Reset FRAME's consecutive-failure count (the next tick reports again)." - (set-frame-parameter frame cj/--agenda-frame-fail-count-parameter 0)) - -(defun cj/--agenda-frame-failure-overlays (buffer) - "Return the refresh-failed banner overlays in BUFFER (normally 0 or 1)." - (with-current-buffer buffer - (seq-filter (lambda (o) (overlay-get o cj/--agenda-frame-overlay-property)) - (overlays-in (point-min) (point-max))))) - -(defun cj/--agenda-frame-show-failure-overlay (buffer) - "Show the refresh-failed notice as an overlay at the top of BUFFER. -Idempotent: an existing banner is reused, so consecutive failures never -stack a second one." - (with-current-buffer buffer - (let ((overlay (or (car (cj/--agenda-frame-failure-overlays buffer)) - (make-overlay (point-min) (point-min))))) - (overlay-put overlay cj/--agenda-frame-overlay-property t) - (overlay-put overlay 'before-string - (propertize "Agenda frame: refresh failed (C-M-<f8> to force-rescan)\n" - 'face 'warning))))) - -(defun cj/--agenda-frame-remove-overlay (buffer) - "Remove the refresh-failed banner from BUFFER, if present." - (when (buffer-live-p buffer) - (mapc #'delete-overlay (cj/--agenda-frame-failure-overlays buffer)))) - -;; -- The refresh itself ------------------------------------------------------ - -(defun cj/--agenda-frame-do-redo (frame buffer window) - "Redo the agenda in BUFFER, degrading to the last-good snapshot on failure. -On success: drop the failure overlay, restore point, clear the failure -latch, and release the pre-redo snapshot. On error: restore the snapshot -verbatim, re-enable the policy (the finalize hook runs only on success), -show the failure overlay, and report once per consecutive-failure run. -Either way the frame is never blank, unrestricted, or non-retryable." - (with-current-buffer buffer - ;; Clone the point marker: `org-agenda-redo' calls `org-agenda-reset-markers' - ;; which nulls the buffer's own org-markers, so the raw marker would be dead - ;; by the time `cj/--agenda-frame-restore-point' runs -- collapsing the - ;; "follow the same source item" restoration to the line-number clamp on - ;; every normal tick. An independent clone survives the reset. - (let ((old-marker (let ((m (cj/--agenda-frame-item-marker))) - (and (markerp m) (marker-buffer m) (copy-marker m)))) - (old-line (line-number-at-pos)) - (snapshot (cj/--agenda-frame-snapshot buffer window))) - (unwind-protect - (condition-case nil - ;; Never bind sticky here: `org-agenda-redo' handles the - ;; in-place rebuild itself (binds sticky nil, redirects the - ;; buffer name). A sticky t reaching `org-agenda-prepare' - ;; mid-redo makes it throw \\='exit with no catch, failing - ;; every tick. current-window is bound as a belt so a rule - ;; can't split the frame during the rebuild. - (let ((inhibit-message t) - (org-agenda-window-setup 'current-window)) - (org-agenda-redo) - (cj/--agenda-frame-remove-overlay buffer) - (cj/--agenda-frame-restore-point old-marker old-line) - (cj/--agenda-frame-clear-failure frame) - (cj/--agenda-frame-release-snapshot snapshot)) - (error - (cj/--agenda-frame-restore-snapshot buffer snapshot window) - (cj/agenda-frame-mode 1) - (cj/--agenda-frame-show-failure-overlay buffer) - (when (cj/--agenda-frame-record-failure frame) - (message "Agenda frame: refresh failed (C-M-<f8> to force-rescan)")))) - (when (markerp old-marker) - (set-marker old-marker nil)))))) - -(defun cj/--agenda-frame-safe-redo (&optional frame) - "Refresh the agenda buffer in FRAME safely (the timer tick and manual `r'). -Runs with the dedicated window selected for the redo's dynamic extent and -restores the prior window afterward, never calling an input-focus -function, so a tick while another frame is active neither errors on an -out-of-range window-start nor steals focus." - (interactive) - (let* ((frame (or frame (cj/--agenda-frame))) - (buffer (cj/--agenda-frame-sticky-buffer)) - (window (and (frame-live-p frame) (buffer-live-p buffer) - (get-buffer-window buffer frame)))) - (when (and (window-live-p window) - ;; Skip the tick while a minibuffer is active anywhere -- - ;; reselecting windows under an active minibuffer session can - ;; break it, and the next tick catches up. - (not (active-minibuffer-window))) - (let ((prev-window (selected-window)) - ;; The rebuild takes visible time, and for its duration the - ;; agenda window is the selected window. Without inhibiting - ;; redisplay the user's cursor visibly goes hollow for the whole - ;; rebuild every tick -- indistinguishable from focus theft. - ;; The rebuild blocks Emacs either way (it is synchronous), so - ;; this hides the selection flicker at no extra cost; redisplay - ;; resumes after the selection is restored. - (inhibit-redisplay t)) - (unwind-protect - (progn - (select-window window t) - (cj/--agenda-frame-do-redo frame buffer window)) - (when (window-live-p prev-window) - (select-window prev-window t))))))) - -(defun cj/--agenda-frame-day-view () - "Shrink the Full Agenda frame to today's single-day view. -Sets the span to 1 and refreshes. The redo re-evaluates the span, so the -day view survives the wall-clock refresh tick until `w' widens it again." - (interactive) - (setq cj/--agenda-frame-span 1) - (cj/--agenda-frame-safe-redo)) - -(defun cj/--agenda-frame-week-view () - "Restore the Full Agenda frame to the seven-day today-anchored view. -Sets the span back to 7 and refreshes." - (interactive) - (setq cj/--agenda-frame-span 7) - (cj/--agenda-frame-safe-redo)) - -(defun cj/--agenda-frame-start-timer (frame) - "Start FRAME's five-minute wall-clock refresh timer, unless one exists. -Idempotent: a frame already carrying a live timer keeps it (no duplicate). -Returns the timer." - (unless (timerp (frame-parameter frame cj/--agenda-frame-timer-parameter)) - (let* ((period cj/--agenda-frame-refresh-seconds) - (delay (cj/--agenda-frame-seconds-to-next-mark (current-time) period)) - (timer (run-at-time delay period #'cj/--agenda-frame-safe-redo frame))) - (set-frame-parameter frame cj/--agenda-frame-timer-parameter timer) - timer))) - -;; -- Public command and key install ------------------------------------------ - -(defun cj/agenda-frame-toggle () - "Toggle the dedicated agenda frame. -Spawn it when none exists, raise and focus it when it exists but is -unfocused, and close it when it is the selected frame." - (interactive) - (cj/--agenda-frame-toggle)) - -(defun cj/--agenda-frame-install-keys (&optional map) - "Bind the F8-family keys for the agenda frame in MAP (default: the global map). -S-<f8> toggles the agenda frame; the force-rescan -\(`cj/org-agenda-refresh-files') moves to C-M-<f8>, keeping the whole -force-refresh idea in the F8 family." - (let ((map (or map (current-global-map)))) - (define-key map (kbd "S-<f8>") #'cj/agenda-frame-toggle) - (define-key map (kbd "C-M-<f8>") #'cj/org-agenda-refresh-files))) - -;;; Wiring — registered once org-agenda is loaded (no batch side effects) - -(with-eval-after-load 'org-agenda - (cj/--agenda-frame-register-command) - (add-hook 'org-agenda-finalize-hook #'cj/--agenda-frame-maybe-enable-mode) - (add-hook 'delete-frame-functions #'cj/--agenda-frame-on-delete-frame)) - -;; The public gesture appears only now that the feature is complete and live. -(cj/--agenda-frame-install-keys) - -;; Install the read-only shadow now that every allowlist handler above is -;; defined, so the walk's `commandp' guard recognizes them and preserves the -;; allowlist regardless of whether org-agenda loaded before or after this file. -(with-eval-after-load 'org-agenda - (cj/--agenda-frame-shadow-mutations)) - -(provide 'org-agenda-frame) -;;; org-agenda-frame.el ends here diff --git a/tests/test-integration-org-agenda-frame-load-order.el b/tests/test-integration-org-agenda-frame-load-order.el deleted file mode 100644 index a8eeaa47..00000000 --- a/tests/test-integration-org-agenda-frame-load-order.el +++ /dev/null @@ -1,89 +0,0 @@ -;;; test-integration-org-agenda-frame-load-order.el --- Frame allowlist survives load order -*- lexical-binding: t; -*- - -;;; Commentary: -;; Regression test for a load-order bug in the Full Agenda frame's read-only -;; shadow. -;; -;; Components integrated: -;; - org-agenda-frame (real, loaded in a subprocess) -;; - org-agenda (real, loaded BEFORE the frame module to reproduce the bug) -;; -;; The bug: cj/--agenda-frame-shadow-mutations walks org-agenda-mode-map and -;; keeps a key only when the frame map already binds it to a `commandp' value. -;; The view/redo handlers (day-view, week-view, safe-redo) were defined LOWER in -;; the file than the `with-eval-after-load' that ran the walk. When org-agenda -;; was already loaded at frame-load time -- the normal startup order and every -;; reload -- the walk fired before those defuns existed, read them as not-yet -;; commands, and denied d/w/g/r, the very keys the allowlist grants. Moving the -;; walk to the end of the file (after the defuns) fixed it. -;; -;; This test can't reproduce the ordering in-process (the module is already -;; loaded), so it drives a fresh Emacs that requires org-agenda first, then the -;; frame module, and inspects the resulting keymap. -;; -;; Validates: -;; - d/w/g/r keep their allowlist commands in the org-first load order -;; - the controlled status/priority mutations survive the shadow walk -;; - a non-allowlisted mutation key (t) is still denied -;; -;;; Code: - -(require 'ert) - -(defconst test-oaf--repo-root - (file-name-directory (directory-file-name - (file-name-directory (or load-file-name buffer-file-name)))) - "Repo root, one level up from tests/.") - -(defun test-oaf--lookup-in-subprocess (keys) - "Load org-agenda then org-agenda-frame in a fresh Emacs, return KEYS' bindings. -Returns an alist of (KEY . BINDING-SYMBOL-NAME-OR-nil)." - (let* ((root test-oaf--repo-root) - (form - (prin1-to-string - `(progn - (setq load-prefer-newer t) - (package-initialize) - (require 'org-agenda) ; the bad order: org first - (require 'org-agenda-frame) - (princ (prin1-to-string - (mapcar - (lambda (k) - (cons k (let ((b (lookup-key cj/agenda-frame-mode-map (kbd k)))) - (and (symbolp b) (symbol-name b))))) - ',keys)))))) - (out (with-output-to-string - (with-current-buffer standard-output - (call-process - (expand-file-name invocation-name invocation-directory) - nil t nil - "--batch" "--no-site-file" "--no-site-lisp" - "-L" root - "-L" (expand-file-name "modules" root) - "-L" (expand-file-name "themes" root) - "--eval" form))))) - (car (read-from-string out)))) - -(ert-deftest test-integration-org-agenda-frame-allowlist-survives-org-first-load () - "Integration: with org-agenda loaded before the frame module, the allowlisted -view/redo and controlled task-mutation keys survive while t stays denied." - (skip-unless (file-exists-p (expand-file-name "modules/org-agenda-frame.el" - test-oaf--repo-root))) - (let ((got (test-oaf--lookup-in-subprocess - '("d" "w" "g" "r" "C-c t" "C-c C-t" - "M-<up>" "M-<right>" "s-<down>" "s-<left>" "t")))) - (should (equal "cj/--agenda-frame-day-view" (cdr (assoc "d" got)))) - (should (equal "cj/--agenda-frame-week-view" (cdr (assoc "w" got)))) - (should (equal "cj/--agenda-frame-safe-redo" (cdr (assoc "g" got)))) - (should (equal "cj/--agenda-frame-safe-redo" (cdr (assoc "r" got)))) - (should (equal "org-agenda-todo" (cdr (assoc "C-c t" got)))) - (should (equal "org-agenda-todo" (cdr (assoc "C-c C-t" got)))) - (should (equal "org-agenda-priority-up" (cdr (assoc "M-<up>" got)))) - (should (equal "org-agenda-todo-nextset" (cdr (assoc "M-<right>" got)))) - (should (equal "org-agenda-priority-down" (cdr (assoc "s-<down>" got)))) - (should (equal "org-agenda-todo-previousset" (cdr (assoc "s-<left>" got)))) - ;; t is a real org mutation key; it must be denied, not allowlisted. - (should (equal "cj/--agenda-frame-denied-readonly" (cdr (assoc "t" got)))))) - -(provide 'test-integration-org-agenda-frame-load-order) -;;; test-integration-org-agenda-frame-load-order.el ends here diff --git a/tests/test-org-agenda-config--auto-refresh.el b/tests/test-org-agenda-config--auto-refresh.el new file mode 100644 index 00000000..58ef729b --- /dev/null +++ b/tests/test-org-agenda-config--auto-refresh.el @@ -0,0 +1,170 @@ +;;; test-org-agenda-config--auto-refresh.el --- Tests for agenda auto-refresh -*- lexical-binding: t; -*- + +;;; Commentary: +;; Tests for the wall-clock-aligned auto-refresh behind the F8 agenda: +;; the next-mark arithmetic, the on-screen-agenda lookup, the timer body's +;; error containment, and start/stop timer ownership. + +;;; Code: + +(require 'ert) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'org-agenda-config) + +;; -- Fixtures ---------------------------------------------------------------- + +(defun test-org-agenda-auto-refresh--time (hh mm ss) + "Return an Emacs time value for today at HH:MM:SS local time." + (let ((now (decode-time))) + (encode-time (list ss mm hh + (nth 3 now) (nth 4 now) (nth 5 now) + nil -1 (nth 8 now))))) + +(defmacro test-org-agenda-auto-refresh--with-agenda-window (&rest body) + "Run BODY with a window displaying a buffer in `org-agenda-mode'. +Sets `major-mode' directly rather than calling the mode function: the +lookup under test only asks what mode the window's buffer is in, and +`org-agenda-mode' setup wants a real agenda build behind it." + (declare (indent 0)) + `(let ((buffer (get-buffer-create "*Org Agenda*"))) + (unwind-protect + (save-window-excursion + (with-current-buffer buffer + (setq major-mode 'org-agenda-mode)) + (set-window-buffer (selected-window) buffer) + ,@body) + (kill-buffer buffer)))) + +;; -- cj/--org-agenda-seconds-to-next-mark ------------------------------------ + +(ert-deftest test-org-agenda-config-next-mark-mid-interval () + "Normal: a time between marks returns the remainder to the next one." + (should (= 120 (cj/--org-agenda-seconds-to-next-mark + (test-org-agenda-auto-refresh--time 9 3 0) 300)))) + +(ert-deftest test-org-agenda-config-next-mark-exactly-on-mark () + "Boundary: a time exactly on a mark returns a full period, never zero. +A zero delay would fire the timer immediately and again a period later." + (should (= 300 (cj/--org-agenda-seconds-to-next-mark + (test-org-agenda-auto-refresh--time 9 5 0) 300)))) + +(ert-deftest test-org-agenda-config-next-mark-one-second-before () + "Boundary: one second short of a mark returns one second." + (should (= 1 (cj/--org-agenda-seconds-to-next-mark + (test-org-agenda-auto-refresh--time 9 4 59) 300)))) + +(ert-deftest test-org-agenda-config-next-mark-lands-on-a-multiple () + "Normal: TIME plus the result is always a whole multiple of PERIOD. +This is the property that makes the refresh land on :00/:05 rather than +five minutes after whenever the agenda happened to open." + (dolist (seconds '(0 1 59 60 61 149 150 299)) + (let* ((time (test-org-agenda-auto-refresh--time 9 0 0)) + (start (+ (floor (float-time time)) seconds)) + (delay (cj/--org-agenda-seconds-to-next-mark start 300))) + (should (zerop (mod (+ start delay) 300)))))) + +(ert-deftest test-org-agenda-config-next-mark-rejects-nonpositive-period () + "Error: a zero or negative period is a caller bug, not a silent no-op." + (should-error (cj/--org-agenda-seconds-to-next-mark (current-time) 0)) + (should-error (cj/--org-agenda-seconds-to-next-mark (current-time) -300))) + +;; -- cj/--org-agenda-refresh-window ------------------------------------------ + +(ert-deftest test-org-agenda-config-refresh-window-finds-displayed-agenda () + "Normal: the lookup returns the window showing an agenda buffer." + (test-org-agenda-auto-refresh--with-agenda-window + (should (eq (cj/--org-agenda-refresh-window) (selected-window))))) + +(ert-deftest test-org-agenda-config-refresh-window-nil-when-not-displayed () + "Boundary: an agenda buffer that exists but is off-screen is not a target. +Rebuilding an invisible agenda costs time and shows nobody anything." + (let ((buffer (get-buffer-create "*Org Agenda*"))) + (unwind-protect + (progn + (with-current-buffer buffer (setq major-mode 'org-agenda-mode)) + (should-not (cj/--org-agenda-refresh-window))) + (kill-buffer buffer)))) + +(ert-deftest test-org-agenda-config-refresh-window-nil-with-no-agenda () + "Boundary: no agenda buffer anywhere returns nil rather than erroring." + (should-not (cj/--org-agenda-refresh-window))) + +;; -- cj/--org-agenda-auto-refresh (the timer body) --------------------------- + +(ert-deftest test-org-agenda-config-auto-refresh-noop-without-agenda () + "Boundary: the tick does nothing, and signals nothing, with no agenda up." + (let ((called nil)) + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (setq called t)))) + (cj/--org-agenda-auto-refresh) + (should-not called)))) + +(ert-deftest test-org-agenda-config-auto-refresh-redoes-visible-agenda () + "Normal: the tick redoes the agenda shown on screen." + (let ((called nil)) + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (setq called t)))) + (test-org-agenda-auto-refresh--with-agenda-window + (cj/--org-agenda-auto-refresh)) + (should called)))) + +(ert-deftest test-org-agenda-config-auto-refresh-contains-errors () + "Error: a failing redo must not escape the timer body. +An unguarded signal in a repeating timer resignals on every tick, which is +how a five-minute timer turns into an endless backtrace." + (cl-letf (((symbol-function 'org-agenda-redo) + (lambda (&rest _) (error "simulated redo failure"))) + ((symbol-function 'cj/log-silently) (lambda (&rest _) nil))) + (test-org-agenda-auto-refresh--with-agenda-window + (should (progn (cj/--org-agenda-auto-refresh) t))))) + +(ert-deftest test-org-agenda-config-auto-refresh-restores-point-line () + "Normal: the tick leaves point on the line it started on. +A refresh that scrolls the reader back to the top every five minutes is +worse than no refresh." + (cl-letf (((symbol-function 'org-agenda-redo) (lambda (&rest _) nil))) + (test-org-agenda-auto-refresh--with-agenda-window + (with-current-buffer "*Org Agenda*" + (erase-buffer) + (dotimes (i 10) (insert (format "agenda line %d\n" i))) + (goto-char (point-min)) + (forward-line 4)) + (cj/--org-agenda-auto-refresh) + (with-current-buffer "*Org Agenda*" + (should (= 5 (line-number-at-pos))))))) + +;; -- start / stop ------------------------------------------------------------ + +(ert-deftest test-org-agenda-config-auto-refresh-start-owns-one-timer () + "Normal: starting twice leaves exactly one timer, not two. +Re-loading the module in a live daemon re-runs the arming form, so a +non-idempotent start would stack a second ticker on every reload." + (let ((cj/--org-agenda-refresh-timer nil)) + (unwind-protect + (progn + (cj/org-agenda-auto-refresh-start) + (let ((first cj/--org-agenda-refresh-timer)) + (cj/org-agenda-auto-refresh-start) + (should (timerp cj/--org-agenda-refresh-timer)) + (should-not (memq first timer-list)) + (should (memq cj/--org-agenda-refresh-timer timer-list)))) + (cj/org-agenda-auto-refresh-stop)))) + +(ert-deftest test-org-agenda-config-auto-refresh-stop-clears-timer () + "Normal: stopping cancels the timer and clears the handle." + (let ((cj/--org-agenda-refresh-timer nil)) + (cj/org-agenda-auto-refresh-start) + (let ((timer cj/--org-agenda-refresh-timer)) + (cj/org-agenda-auto-refresh-stop) + (should-not cj/--org-agenda-refresh-timer) + (should-not (memq timer timer-list))))) + +(ert-deftest test-org-agenda-config-auto-refresh-stop-is-safe-when-stopped () + "Boundary: stopping an already-stopped refresh is a no-op, not an error." + (let ((cj/--org-agenda-refresh-timer nil)) + (should (progn (cj/org-agenda-auto-refresh-stop) t)) + (should-not cj/--org-agenda-refresh-timer))) + +(provide 'test-org-agenda-config--auto-refresh) +;;; test-org-agenda-config--auto-refresh.el ends here diff --git a/tests/test-org-agenda-config-display.el b/tests/test-org-agenda-config-display.el index af4c7ea0..f039985d 100644 --- a/tests/test-org-agenda-config-display.el +++ b/tests/test-org-agenda-config-display.el @@ -2,6 +2,8 @@ ;;; Commentary: ;; Tests for the display-buffer rule used by the F8 org agenda view. +;; The agenda takes the whole frame; these pin that, and pin the two ways +;; it previously failed to (a fraction of the frame, or shrunk to fit). ;;; Code: @@ -10,39 +12,58 @@ (add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) (require 'org-agenda-config) -(ert-deftest test-org-agenda-config-display-rule-uses-configured-height () - "Normal: the agenda display rule uses the configured frame fraction." - (let ((cj/org-agenda-window-height 0.75)) - (should (equal (cdr (assoc 'window-height - (cddr (cj/--org-agenda-display-rule)))) - 0.75)))) +(defun test-org-agenda-config-display--actions () + "Return the display-action function list from the agenda rule." + (car (cdr (cj/--org-agenda-display-rule)))) + +(defun test-org-agenda-config-display--alist () + "Return the action alist from the agenda rule." + (cddr (cj/--org-agenda-display-rule))) + +(ert-deftest test-org-agenda-config-display-rule-takes-full-frame () + "Normal: the agenda display rule claims the whole frame." + (should (memq 'display-buffer-full-frame + (test-org-agenda-config-display--actions)))) + +(ert-deftest test-org-agenda-config-display-rule-reuses-agenda-window () + "Normal: an agenda already on screen is reused rather than re-displayed." + (should (memq 'display-buffer-reuse-mode-window + (test-org-agenda-config-display--actions)))) + +(ert-deftest test-org-agenda-config-display-rule-sets-no-window-height () + "Regression: no height fraction survives. +The rule used to hand the agenda 0.75 of the frame; a leftover +`window-height' entry would cap the full-frame window right back down." + (should-not (assoc 'window-height (test-org-agenda-config-display--alist)))) (ert-deftest test-org-agenda-config-display-rule-does-not-fit-to-buffer () "Regression: F8 agenda should not shrink to fit compact agenda contents." - (let ((cj/org-agenda-window-height 0.75)) - (should-not (eq (cdr (assoc 'window-height - (cddr (cj/--org-agenda-display-rule)))) - 'fit-window-to-buffer)))) - -(ert-deftest test-org-agenda-config-display-rule-creates-large-window () - "Integration: the agenda rule creates a window near the configured height." - (let ((cj/org-agenda-window-height 0.75) - (display-buffer-alist (list (cj/--org-agenda-display-rule))) + (should-not (eq (cdr (assoc 'window-height + (test-org-agenda-config-display--alist))) + 'fit-window-to-buffer))) + +(ert-deftest test-org-agenda-config-display-rule-window-not-dedicated () + "Regression: the agenda window must not be dedicated. +With the agenda owning the only window, a dedicated one leaves RET on an +item (`org-agenda-switch-to') nowhere to put the file, so it splits or +opens a frame instead of replacing the agenda." + (should-not (cdr (assoc 'dedicated (test-org-agenda-config-display--alist))))) + +(ert-deftest test-org-agenda-config-display-rule-creates-sole-window () + "Integration: displaying the agenda leaves it as the frame's only window." + (let ((display-buffer-alist (list (cj/--org-agenda-display-rule))) (buffer (get-buffer-create "*Org Agenda*"))) (unwind-protect (save-window-excursion (delete-other-windows) + (split-window-below) (with-current-buffer buffer (erase-buffer) - (dotimes (_ 3) - (insert "agenda line\n"))) - (let* ((before-height (window-total-height)) - (window (display-buffer buffer)) - (actual-ratio (/ (float (window-total-height window)) - before-height))) - (should (= 2 (length (window-list)))) - (should (> actual-ratio 0.65)) - (should (< actual-ratio 0.85)))) + (dotimes (_ 3) (insert "agenda line\n"))) + (let ((window (display-buffer buffer))) + (should (= 1 (length (window-list)))) + (should (eq window (car (window-list)))) + (should (eq (window-buffer window) buffer)))) (kill-buffer buffer)))) (provide 'test-org-agenda-config-display) diff --git a/tests/test-org-agenda-frame.el b/tests/test-org-agenda-frame.el deleted file mode 100644 index 167cf2ff..00000000 --- a/tests/test-org-agenda-frame.el +++ /dev/null @@ -1,1167 +0,0 @@ -;;; test-org-agenda-frame.el --- Tests for the fullscreen agenda frame -*- lexical-binding: t; -*- - -;;; Commentary: -;; Phase 1 of the org-agenda fullscreen frame (spec: -;; docs/specs/2026-07-17-org-agenda-fullscreen-frame-spec.org). Frame lookup -;; is mocked (frame-list / frame-live-p / frame-parameter), the house pattern -;; from test-dirvish-config-popup.el, since --batch can't create real frames. - -;;; Code: - -(require 'ert) -(require 'cl-lib) - -(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) -(require 'org-agenda-frame) - -;; org-agenda isn't loaded in batch (no package-initialize), so declare the -;; command list special and bound for the registration tests to let-bind. -(defvar org-agenda-custom-commands nil) - -;;; cj/--agenda-frame — locate the marked frame - -(ert-deftest test-org-agenda-frame-find-returns-marked-live-frame () - "Normal: returns the live frame carrying the `cj/agenda-frame' marker." - (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb fc))) - ((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'fb))))) - (should (eq (cj/--agenda-frame) 'fb)))) - -(ert-deftest test-org-agenda-frame-find-nil-when-none-marked () - "Boundary: no frame carries the marker -> nil." - (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fc))) - ((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'frame-parameter) (lambda (_f _p) nil))) - (should (null (cj/--agenda-frame))))) - -(ert-deftest test-org-agenda-frame-find-ignores-dead-marked-frame () - "Error: a marked but dead frame is not returned." - (cl-letf (((symbol-function 'frame-list) (lambda () '(fa fb))) - ((symbol-function 'frame-live-p) (lambda (f) (not (eq f 'fb)))) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'fb))))) - (should (null (cj/--agenda-frame))))) - -;;; cj/--agenda-frame-p — is FRAME a live agenda frame - -(ert-deftest test-org-agenda-frame-p-true-for-live-marked () - "Normal: a live marked frame is an agenda frame." - (cl-letf (((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'fa))))) - (should (cj/--agenda-frame-p 'fa)))) - -(ert-deftest test-org-agenda-frame-p-nil-for-unmarked () - "Boundary: a live unmarked frame is not an agenda frame." - (cl-letf (((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'frame-parameter) (lambda (_f _p) nil))) - (should (null (cj/--agenda-frame-p 'fa))))) - -(ert-deftest test-org-agenda-frame-p-nil-for-dead-marked () - "Error: a dead marked frame is not an agenda frame." - (cl-letf (((symbol-function 'frame-live-p) (lambda (_f) nil)) - ((symbol-function 'frame-parameter) - (lambda (_f p) (eq p 'cj/agenda-frame)))) - (should (null (cj/--agenda-frame-p 'fa))))) - -;;; cj/--agenda-frame-working-frame — route source files to a non-agenda frame - -(ert-deftest test-org-agenda-working-frame-returns-non-agenda-frame () - "Normal: with no recorded launch frame, returns the first live non-agenda frame." - (let ((cj/--agenda-frame-launch-frame nil)) - (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda work))) - ((symbol-function 'frame-live-p) (lambda (f) (memq f '(agenda work)))) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) - (should (eq (cj/--agenda-frame-working-frame) 'work))))) - -(ert-deftest test-org-agenda-working-frame-prefers-live-launch-frame () - "Normal: the recorded launch frame wins when live and non-agenda." - (let ((cj/--agenda-frame-launch-frame 'w2)) - (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda w1 w2))) - ((symbol-function 'frame-live-p) (lambda (f) (memq f '(agenda w1 w2)))) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) - (should (eq (cj/--agenda-frame-working-frame) 'w2))))) - -(ert-deftest test-org-agenda-working-frame-falls-back-when-launch-dead () - "Boundary: a dead recorded launch frame falls back to another non-agenda frame." - (let ((cj/--agenda-frame-launch-frame 'gone)) - (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda work))) - ((symbol-function 'frame-live-p) (lambda (f) (memq f '(agenda work)))) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) - (should (eq (cj/--agenda-frame-working-frame) 'work))))) - -(ert-deftest test-org-agenda-working-frame-nil-when-only-agenda () - "Error: the agenda frame is the only live frame -> nil (caller creates one)." - (let ((cj/--agenda-frame-launch-frame nil)) - (cl-letf (((symbol-function 'frame-list) (lambda () '(agenda))) - ((symbol-function 'frame-live-p) (lambda (f) (eq f 'agenda))) - ((symbol-function 'frame-parameter) - (lambda (f p) (and (eq p 'cj/agenda-frame) (eq f 'agenda))))) - (should (null (cj/--agenda-frame-working-frame)))))) - -;;; cj/--agenda-frame-command — the dedicated F seven-day view - -(defun test-org-agenda-frame--block-settings () - "Return the per-block settings alist of the agenda-frame command." - (let* ((cmd (cj/--agenda-frame-command)) - (blocks (nth 2 cmd)) - (agenda-block (car blocks))) - (nth 2 agenda-block))) - -(defun test-org-agenda-frame--general-settings () - "Return the general (view-wide) settings alist of the agenda-frame command." - (nth 3 (cj/--agenda-frame-command))) - -(ert-deftest test-org-agenda-frame-command-key-is-F () - "Normal: the command's key is F (collision-free with the existing d)." - (should (equal (nth 0 (cj/--agenda-frame-command)) "F"))) - -(ert-deftest test-org-agenda-frame-command-today-anchored-7-day () - "Normal: the default span is seven days anchored to today, not Monday. -The span is the frame-span variable (default 7), evaluated the way org -evaluates custom-command settings." - (let ((s (test-org-agenda-frame--block-settings))) - (should (equal (default-value 'cj/--agenda-frame-span) 7)) - (should (equal (eval (cadr (assq 'org-agenda-span s)) t) - (default-value 'cj/--agenda-frame-span))) - (should (equal (cadr (assq 'org-agenda-start-day s)) "0d")) - ;; start-on-weekday nil is what un-anchors the span from Monday. - (should (assq 'org-agenda-start-on-weekday s)) - (should (null (cadr (assq 'org-agenda-start-on-weekday s)))))) - -(ert-deftest test-org-agenda-frame-command-span-follows-variable () - "Normal: the block span reads `cj/--agenda-frame-span', so d/w can change it -and a redo -- which re-evaluates the lprops -- picks up the new span." - (let ((cj/--agenda-frame-span 1)) - (should (equal (eval (cadr (assq 'org-agenda-span - (test-org-agenda-frame--block-settings))) - t) - 1))) - (let ((cj/--agenda-frame-span 7)) - (should (equal (eval (cadr (assq 'org-agenda-span - (test-org-agenda-frame--block-settings))) - t) - 7)))) - -(ert-deftest test-org-agenda-frame-day-view-sets-span-1-and-redoes () - "Normal: d sets the span to one day and refreshes via the safe redo." - (let ((cj/--agenda-frame-span 7) redone) - (cl-letf (((symbol-function 'cj/--agenda-frame-safe-redo) - (lambda (&rest _) (setq redone t)))) - (cj/--agenda-frame-day-view) - (should (equal cj/--agenda-frame-span 1)) - (should redone)))) - -(ert-deftest test-org-agenda-frame-week-view-sets-span-7-and-redoes () - "Normal: w restores the seven-day span and refreshes." - (let ((cj/--agenda-frame-span 1) redone) - (cl-letf (((symbol-function 'cj/--agenda-frame-safe-redo) - (lambda (&rest _) (setq redone t)))) - (cj/--agenda-frame-week-view) - (should (equal cj/--agenda-frame-span 7)) - (should redone)))) - -(ert-deftest test-org-agenda-frame-command-tight-prefix-format () - "Normal: the view sets its own prefix format with a narrow category column. -Without it the global agenda format applies, whose 25-char category pad -leaves a wide blank gutter between the source name and the item." - (let ((s (test-org-agenda-frame--block-settings))) - (should (assq 'org-agenda-prefix-format s)) - (should (string-match-p "%-10:c" - (cadr (assq 'org-agenda-prefix-format s)))))) - -(ert-deftest test-org-agenda-frame-command-skips-done-items () - "Normal: completed tasks never appear in the Full Agenda. -The global agenda deliberately shows scheduled done items, so the dedicated -view needs its own skip function to exclude every done-state keyword." - (let* ((settings (test-org-agenda-frame--block-settings)) - (skip (assq 'org-agenda-skip-function settings))) - (should skip) - (should (equal (eval (cadr skip) t) - '(org-agenda-skip-entry-if 'todo 'done))))) - -(ert-deftest test-org-agenda-frame-command-render-excludes-scheduled-done () - "Boundary: a scheduled high-priority DONE item is absent from rendered output. -An equally scheduled active task remains, proving the whole date was not -skipped." - (require 'org-agenda) - (let* ((file (make-temp-file "agenda-frame-done-" nil ".org")) - (today (format-time-string "%Y-%m-%d %a")) - (org-agenda-files (list file)) - (org-agenda-custom-commands (list (cj/--agenda-frame-command))) - (org-agenda-sticky nil) - (agenda-buffer "*Org Agenda*")) - (unwind-protect - (progn - (with-temp-file file - (insert "#+TODO: TODO | DONE\n" - "* DONE [#A] completed-scheduled-marker\n" - "SCHEDULED: <" today ">\n" - "* TODO [#A] active-scheduled-marker\n" - "SCHEDULED: <" today ">\n")) - (org-agenda nil cj/--agenda-frame-command-key) - (with-current-buffer agenda-buffer - (should-not (string-match-p "completed-scheduled-marker" - (buffer-string))) - (should (string-match-p "active-scheduled-marker" - (buffer-string))))) - (when (get-buffer agenda-buffer) - (kill-buffer agenda-buffer)) - (delete-file file)))) - -(ert-deftest test-org-agenda-frame-do-redo-leaves-sticky-alone () - "Normal: the redo binds current-window but never touches sticky. -org-agenda-redo handles the in-place rebuild itself (it binds sticky nil -and redirects the buffer name); a sticky t reaching org-agenda-prepare -mid-redo makes it throw \\='exit with no catch and the tick fails." - (let ((org-agenda-sticky nil) - seen-sticky seen-setup (params '())) - (with-temp-buffer - (insert "agenda line\n") - (cl-letf (((symbol-function 'org-agenda-redo) - (lambda (&rest _) - (setq seen-sticky org-agenda-sticky - seen-setup org-agenda-window-setup))) - ((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) - ((symbol-function 'set-frame-parameter) - (lambda (_f p v) (setf (alist-get p params) v)))) - (cj/--agenda-frame-do-redo 'af (current-buffer) nil) - (should (null seen-sticky)) - (should (eq seen-setup 'current-window)))))) - -(ert-deftest test-org-agenda-frame-command-follow-mode-off () - "Boundary: follow-mode is forced off locally so a global default can't split." - (let ((s (test-org-agenda-frame--block-settings))) - (should (assq 'org-agenda-start-with-follow-mode s)) - (should (null (cadr (assq 'org-agenda-start-with-follow-mode s)))))) - -(ert-deftest test-org-agenda-frame-command-sticky-and-current-window () - "Normal: current-window in the settings; sticky deliberately NOT there. -The general settings are baked into the buffer's series-redo-cmd and -re-applied on every redo; a sticky t there makes org-agenda-use-sticky-p -true mid-redo (the buffer exists), and org-agenda-prepare throws \\='exit -with no catch -- every refresh tick fails. Stickiness belongs only in -the spawn wrapper, where it names the buffer." - (let ((g (test-org-agenda-frame--general-settings))) - (should-not (assq 'org-agenda-sticky g)) - ;; org evaluates custom-command setting values via org-let, so the stored - ;; form is (quote current-window); eval it the way org would. - (should (eq (eval (cadr (assq 'org-agenda-window-setup g)) t) - 'current-window)))) - -;;; cj/--agenda-frame-register-command — idempotent registration - -(ert-deftest test-org-agenda-frame-register-adds-entry () - "Normal: registration inserts the F entry into org-agenda-custom-commands." - (let ((org-agenda-custom-commands '(("d" "Daily" nil)))) - (cj/--agenda-frame-register-command) - (should (assoc "F" org-agenda-custom-commands)) - (should (assoc "d" org-agenda-custom-commands)))) - -(ert-deftest test-org-agenda-frame-register-is-idempotent () - "Boundary: registering twice leaves exactly one F entry." - (let ((org-agenda-custom-commands nil)) - (cj/--agenda-frame-register-command) - (cj/--agenda-frame-register-command) - (should (= 1 (seq-count (lambda (e) (equal (car e) "F")) - org-agenda-custom-commands))))) - -;;; Default-deny policy — denial handlers - -(ert-deftest test-org-agenda-frame-denied-readonly-messages () - "Normal: the read-only denial shows the read-only message and acts on nothing." - (let (captured) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) - (cj/--agenda-frame-denied-readonly)) - (should (string-match-p "read-only" captured)) - (should (string-match-p "working frame" captured)))) - -(ert-deftest test-org-agenda-frame-denied-fixed-view-messages () - "Normal: the view-change denial shows the fixed-view message." - (let (captured) - (cl-letf (((symbol-function 'message) - (lambda (fmt &rest args) (setq captured (apply #'format fmt args))))) - (cj/--agenda-frame-denied-fixed-view)) - (should (string-match-p "day (d) and week (w)" captured)))) - -;;; Default-deny policy — the keymap - -(ert-deftest test-org-agenda-frame-map-catch-all-is-readonly-deny () - "Normal: the [t] default binding denies with the read-only handler." - (should (eq (lookup-key cj/agenda-frame-mode-map [t]) - 'cj/--agenda-frame-denied-readonly))) - -(ert-deftest test-org-agenda-frame-map-navigation-allowed () - "Normal: navigation keys resolve to their org-agenda commands." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "n")) 'org-agenda-next-line)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "p")) 'org-agenda-previous-line)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-g")) 'keyboard-quit))) - -(ert-deftest test-org-agenda-frame-map-point-motion-and-isearch-allowed () - "Normal: read-only point motion and isearch work in the frame. -C-a/C-e/C-f/C-b move point and C-s/C-r search; all are read-only and -must not hit the deny catch-all." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-a")) 'move-beginning-of-line)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-e")) 'move-end-of-line)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-f")) 'forward-char)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-b")) 'backward-char)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-s")) 'isearch-forward)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-r")) 'isearch-backward))) - -(ert-deftest test-org-agenda-frame-map-engage-routed () - "Normal: RET and TAB route to the working-frame engage command." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "RET")) - 'cj/--agenda-frame-engage-open)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "TAB")) - 'cj/--agenda-frame-engage-open))) - -(ert-deftest test-org-agenda-frame-map-engage-gui-function-keys () - "Boundary: the GUI [return]/[tab] events engage too, not the [t] deny handler. -Without these, the catch-all suppresses their translation to RET/TAB in a -graphical frame and RET would be denied instead of opening the item." - (should (eq (lookup-key cj/agenda-frame-mode-map [return]) - 'cj/--agenda-frame-engage-open)) - (should (eq (lookup-key cj/agenda-frame-mode-map [tab]) - 'cj/--agenda-frame-engage-open))) - -(ert-deftest test-org-agenda-frame-map-lifecycle-keys () - "Normal: q/Q/x close the frame; r and g take the safe-redo path. -g is the muscle-memory agenda refresh; it must refresh, not hit the -fixed-view deny handler." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "q")) 'cj/--agenda-frame-close)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "Q")) 'cj/--agenda-frame-close)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "x")) 'cj/--agenda-frame-close)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "r")) 'cj/--agenda-frame-safe-redo)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "g")) 'cj/--agenda-frame-safe-redo))) - -(ert-deftest test-org-agenda-frame-map-view-changers-fixed-view-deny () - "Boundary: view-changing keys are explicitly denied with the fixed-view message, -not caught by the read-only catch-all." - (dolist (key '("y" "f" "b" "j")) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd key)) - 'cj/--agenda-frame-denied-fixed-view)))) - -(ert-deftest test-org-agenda-frame-map-day-week-view-keys () - "Normal: d and w toggle the span (day / week) rather than being denied. -d shrinks the frame to the current day, w restores the seven-day span." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "d")) - 'cj/--agenda-frame-day-view)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "w")) - 'cj/--agenda-frame-week-view))) - -(ert-deftest test-org-agenda-frame-map-controlled-task-mutations () - "Normal: status and priority changes are the frame's controlled mutations. -C-c t is Craig's requested status chord, C-c C-t keeps Org's standard agenda -chord, and both Meta and the configured Super arrows support the same -priority/status operations." - (dolist (binding '(("C-c t" . org-agenda-todo) - ("C-c C-t" . org-agenda-todo) - ("M-<up>" . org-agenda-priority-up) - ("M-<down>" . org-agenda-priority-down) - ("M-<left>" . org-agenda-todo-previousset) - ("M-<right>" . org-agenda-todo-nextset) - ("s-<up>" . org-agenda-priority-up) - ("s-<down>" . org-agenda-priority-down) - ("s-<left>" . org-agenda-todo-previousset) - ("s-<right>" . org-agenda-todo-nextset))) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd (car binding))) - (cdr binding))))) - -(ert-deftest test-org-agenda-frame-shadow-denies-org-mutations-preserves-allowlist () - "Boundary: with the frame mode active over `org-agenda-mode-map', mutating -org-agenda keys are denied and the allowlist still works. -The `[t]' default cannot shadow org-agenda-mode-map's explicit bindings, so -the shadow walk must add explicit denies for every non-allowlisted key -- -single keys (t/I/k/z/s/.), the C-c mutators (schedule/deadline/clock), and -C-x (save-all) -- while leaving the allowlist (navigation, engage, refresh, -d/w, C-c C-o) intact." - (require 'org-agenda) - (cj/--agenda-frame-shadow-mutations) - (with-temp-buffer - (use-local-map org-agenda-mode-map) - (cj/agenda-frame-mode 1) - ;; escaping mutators are now explicitly denied (not org's commands) - (dolist (chord '("t" "I" "k" "z" "s" "." "C-c C-s" "C-c C-d" - "C-c C-x C-i" "C-x C-s")) - (should (eq (key-binding (kbd chord)) - 'cj/--agenda-frame-denied-readonly))) - ;; the allowlist survives the walk - (should (eq (key-binding (kbd "n")) 'org-agenda-next-line)) - (should (eq (key-binding (kbd "p")) 'org-agenda-previous-line)) - (should (eq (key-binding (kbd "RET")) 'cj/--agenda-frame-engage-open)) - (should (eq (key-binding (kbd "g")) 'cj/--agenda-frame-safe-redo)) - (should (eq (key-binding (kbd "d")) 'cj/--agenda-frame-day-view)) - (should (eq (key-binding (kbd "w")) 'cj/--agenda-frame-week-view)) - (should (eq (key-binding (kbd "C-c t")) 'org-agenda-todo)) - (should (eq (key-binding (kbd "C-c C-t")) 'org-agenda-todo)) - (should (eq (key-binding (kbd "M-<up>")) 'org-agenda-priority-up)) - (should (eq (key-binding (kbd "M-<right>")) 'org-agenda-todo-nextset)) - (should (eq (key-binding (kbd "s-<down>")) 'org-agenda-priority-down)) - (should (eq (key-binding (kbd "s-<left>")) 'org-agenda-todo-previousset)) - (should (eq (key-binding (kbd "C-c C-o")) 'cj/--agenda-frame-open-link)) - (should (eq (key-binding (kbd "q")) 'cj/--agenda-frame-close)))) - -(ert-deftest test-org-agenda-frame-map-frame-controls-bound () - "Normal: the frame's own controls work from inside the frame. -S-<f8> must close/toggle and C-M-<f8> must force-rescan; unbound, the -catch-all denies them and the frame can't be closed by its own key." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "S-<f8>")) - 'cj/agenda-frame-toggle)) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-M-<f8>")) - 'cj/org-agenda-refresh-files))) - -(ert-deftest test-org-agenda-frame-map-C-x-C-c-closes-frame () - "Normal: C-x C-c in the agenda frame closes the frame, not the daemon. -The global save-buffers-kill-terminal would kill Emacs itself here (a -make-frame frame has no client), so the intuitive close gesture must be -remapped to the frame close." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "C-x C-c")) - 'cj/--agenda-frame-close))) - -(ert-deftest test-org-agenda-frame-map-machinery-punched-through () - "Boundary: input machinery is punched through the [t] catch-all. -switch-frame events, mouse-wheel scrolling, mouse-1 clicks, and the help -prefix must fall through to their global bindings (an explicit nil shadows -the default in this map); otherwise every frame-focus change and every -scroll spams the deny message." - (dolist (key (list [switch-frame] - [wheel-up] [wheel-down] [wheel-left] [wheel-right] - [double-wheel-up] [double-wheel-down] - [triple-wheel-up] [triple-wheel-down] - [mouse-1] [down-mouse-1] [drag-mouse-1] - (kbd "C-h"))) - ;; accept-default t: a punched key returns nil (falls through to the - ;; global map); an unpunched key returns the catch-all deny handler. - (should (null (lookup-key cj/agenda-frame-mode-map key t))))) - -(ert-deftest test-org-agenda-frame-map-global-escape-chords-denied () - "Boundary: global chords bound elsewhere (M-SPC / M-S-SPC swap ai-term -agents) are denied by an explicit binding, not left to the [t] catch-all. -A keymap's default binding does not shadow an explicit binding in a -lower-priority map, so without an explicit deny here M-SPC follows its -global binding and escapes the read-only frame into ai-term." - (dolist (key '("M-SPC" "M-S-SPC")) - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd key)) - 'cj/--agenda-frame-denied-readonly)))) - -(ert-deftest test-org-agenda-frame-map-unpunched-still-denied () - "Normal: an ordinary unbound key still hits the catch-all after the punches." - (should (eq (lookup-key cj/agenda-frame-mode-map (kbd "t") t) - 'cj/--agenda-frame-denied-readonly))) - -(ert-deftest test-org-agenda-frame-maybe-enable-readds-kill-buffer-hook () - "Normal: the finalize re-enable also re-adds the buffer-local kill hook. -org-agenda-redo's kill-all-local-variables strips the hook installed at -spawn; without the re-add, killing the buffer after the first refresh tick -orphans the frame." - (with-temp-buffer - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'agenda)) - ((symbol-function 'get-buffer-window) (lambda (_b _f) 'win))) - (cj/--agenda-frame-maybe-enable-mode) - (should (memq 'cj/--agenda-frame-on-kill-buffer - (buffer-local-value 'kill-buffer-hook (current-buffer))))))) - -(ert-deftest test-org-agenda-frame-overlay-removable-after-local-var-wipe () - "Error: the failure overlay is found by property, not a buffer-local var. -kill-all-local-variables (every redo) wipes buffer-local vars while the -overlay object survives erase-buffer, so a var-held overlay could never be -removed after a later success -- the failure banner would stick forever." - (with-temp-buffer - (insert "x\n") - (cj/--agenda-frame-show-failure-overlay (current-buffer)) - ;; Simulate the org-agenda-mode reset between failure and success. - (kill-all-local-variables) - (cj/--agenda-frame-remove-overlay (current-buffer)) - ;; The visible banner (a before-string overlay) must be gone. - (should (= 0 (seq-count (lambda (o) (overlay-get o 'before-string)) - (overlays-in (point-min) (point-max))))))) - -(ert-deftest test-org-agenda-frame-map-mutation-keys-denied () - "Boundary: a mutation key (t = org-agenda-todo) is denied, never allowlisted. -It is denied two ways depending on whether the shadow walk has run: the `[t]' -catch-all handles it (lookup returns nil) before the walk, and the walk binds -it explicitly to the deny handler once `org-agenda-mode-map' is present. Both -are a read-only denial; the test asserts the outcome, not which path produced -it, so it holds whether or not org-agenda is loaded in the test process." - (let ((b (lookup-key cj/agenda-frame-mode-map (kbd "t")))) - (should (or (null b) (eq b 'cj/--agenda-frame-denied-readonly))))) - -;;; Default-deny policy — the minor mode + finalize re-enable - -(ert-deftest test-org-agenda-frame-mode-toggles () - "Normal: the minor mode turns on and off in a buffer." - (with-temp-buffer - (cj/agenda-frame-mode 1) - (should cj/agenda-frame-mode) - (cj/agenda-frame-mode -1) - (should-not cj/agenda-frame-mode))) - -(ert-deftest test-org-agenda-frame-maybe-enable-in-agenda-frame () - "Normal: after a build in the agenda frame, the policy is re-enabled." - (with-temp-buffer - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'agenda)) - ((symbol-function 'get-buffer-window) (lambda (_b _f) 'win))) - (cj/--agenda-frame-maybe-enable-mode) - (should cj/agenda-frame-mode)))) - -(ert-deftest test-org-agenda-frame-maybe-enable-skips-other-buffers () - "Boundary: a build not shown in the agenda frame leaves the policy off." - (with-temp-buffer - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'agenda)) - ((symbol-function 'get-buffer-window) (lambda (_b _f) nil))) - (cj/--agenda-frame-maybe-enable-mode) - (should-not cj/agenda-frame-mode)))) - -(ert-deftest test-org-agenda-frame-maybe-enable-no-frame () - "Boundary: no agenda frame at all -> policy stays off, no error." - (with-temp-buffer - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil))) - (cj/--agenda-frame-maybe-enable-mode) - (should-not cj/agenda-frame-mode)))) - -;;; Engage routing — frame target + open - -(ert-deftest test-org-agenda-frame-target-frame-uses-working-frame () - "Normal: the engage target is the working frame when one exists." - (cl-letf (((symbol-function 'cj/--agenda-frame-working-frame) (lambda () 'work)) - ((symbol-function 'make-frame) (lambda (&rest _) (error "should not create")))) - (should (eq (cj/--agenda-frame-target-frame) 'work)))) - -(ert-deftest test-org-agenda-frame-target-frame-creates-when-none () - "Boundary: no working frame -> a normal frame is created." - (cl-letf (((symbol-function 'cj/--agenda-frame-working-frame) (lambda () nil)) - ((symbol-function 'make-frame) (lambda (&rest _) 'new))) - (should (eq (cj/--agenda-frame-target-frame) 'new)))) - -(ert-deftest test-org-agenda-frame-engage-open-no-item-errors () - "Error: engaging on a line with no source item signals a user-error." - (cl-letf (((symbol-function 'cj/--agenda-frame-item-marker) (lambda () nil))) - (should-error (cj/--agenda-frame-engage-open) :type 'user-error))) - -(ert-deftest test-org-agenda-frame-engage-open-routes-to-source () - "Normal: engage opens the item's source buffer at the item's position." - (let ((source (generate-new-buffer " *frame-engage-source*"))) - (unwind-protect - (progn - (with-current-buffer source (insert "line one\nline two\nline three\n")) - (let ((marker (set-marker (make-marker) 10 source)) - focused opened) - (cl-letf (((symbol-function 'cj/--agenda-frame-item-marker) (lambda () marker)) - ((symbol-function 'cj/--agenda-frame-target-frame) (lambda () 'work)) - ((symbol-function 'select-frame-set-input-focus) - (lambda (f &rest _) (setq focused f))) - ((symbol-function 'pop-to-buffer-same-window) - (lambda (b &rest _) (setq opened b) (set-buffer b))) - ((symbol-function 'org-fold-show-context) (lambda (&rest _) nil))) - (cj/--agenda-frame-engage-open) - (should (eq focused 'work)) - (should (eq opened source)) - (should (eq (current-buffer) source)) - (should (= (point) (line-beginning-position)))))) - (kill-buffer source)))) - -;;; Frame lifecycle — sticky buffer, timer-cancel, teardown cleanup - -(ert-deftest test-org-agenda-frame-sticky-buffer-name () - "Normal: the sticky buffer is *Org Agenda(F)*; nil when absent." - (should (null (cj/--agenda-frame-sticky-buffer))) - (let ((buf (get-buffer-create "*Org Agenda(F)*"))) - (unwind-protect - (should (eq (cj/--agenda-frame-sticky-buffer) buf)) - (kill-buffer buf)))) - -(ert-deftest test-org-agenda-frame-cancel-timer-safe-when-none () - "Boundary: cancelling with no timer set does nothing and does not error." - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil))) - (should-not (cj/--agenda-frame-cancel-timer)))) - -;;; Frame lifecycle — toggle dispatch - -(ert-deftest test-org-agenda-frame-toggle-spawns-when-none () - "Normal: with no agenda frame, toggle spawns one." - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-spawn) (lambda () 'spawned))) - (should (eq (cj/--agenda-frame-toggle) 'spawned)))) - -(ert-deftest test-org-agenda-frame-toggle-deletes-when-selected () - "Normal: toggle from within the agenda frame deletes it." - (let (deleted) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'selected-frame) (lambda () 'af)) - ((symbol-function 'cj/--agenda-frame-delete) - (lambda () (setq deleted t)))) - (cj/--agenda-frame-toggle) - (should deleted)))) - -(ert-deftest test-org-agenda-frame-toggle-raises-when-unfocused () - "Normal: toggle from a working frame raises the existing agenda frame." - (let (raised) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'selected-frame) (lambda () 'work)) - ((symbol-function 'cj/--agenda-frame-raise) - (lambda (f) (setq raised f)))) - (cj/--agenda-frame-toggle) - (should (eq raised 'af))))) - -;;; Frame lifecycle — delete - -(ert-deftest test-org-agenda-frame-delete-deletes-live-frame () - "Normal: delete removes the live agenda frame." - (let (deleted) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'frame-live-p) (lambda (f) (eq f 'af))) - ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) - (cj/--agenda-frame-delete) - (should (eq deleted 'af))))) - -(ert-deftest test-org-agenda-frame-delete-noop-when-none () - "Boundary: delete with no agenda frame does nothing." - (let (called) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () nil)) - ((symbol-function 'delete-frame) (lambda (_f &rest _) (setq called t)))) - (cj/--agenda-frame-delete) - (should-not called)))) - -;;; Frame lifecycle — cleanup on frame death and buffer kill - -(ert-deftest test-org-agenda-frame-on-delete-cancels-and-kills-buffer () - "Normal: deleting the agenda frame cancels its timer and kills the sticky buffer." - (let ((buf (get-buffer-create "*Org Agenda(F)*")) - cancelled) - (unwind-protect - (cl-letf (((symbol-function 'cj/--agenda-frame-p) (lambda (_f) t)) - ((symbol-function 'cj/--agenda-frame-cancel-timer) - (lambda (&optional _f) (setq cancelled t)))) - (cj/--agenda-frame-on-delete-frame 'af) - (should cancelled) - (should-not (buffer-live-p buf))) - (when (buffer-live-p buf) (kill-buffer buf))))) - -(ert-deftest test-org-agenda-frame-on-delete-ignores-non-agenda-frame () - "Boundary: a non-agenda frame deletion triggers no cleanup." - (let (cancelled) - (cl-letf (((symbol-function 'cj/--agenda-frame-p) (lambda (_f) nil)) - ((symbol-function 'cj/--agenda-frame-cancel-timer) - (lambda (&optional _f) (setq cancelled t)))) - (cj/--agenda-frame-on-delete-frame 'work) - (should-not cancelled)))) - -(ert-deftest test-org-agenda-frame-on-kill-buffer-deletes-frame () - "Normal: killing the dedicated buffer deletes the frame." - (let (deleted) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'frame-live-p) (lambda (f) (eq f 'af))) - ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) - (cj/--agenda-frame-on-kill-buffer) - (should (eq deleted 'af))))) - -(ert-deftest test-org-agenda-frame-on-kill-buffer-guarded-during-teardown () - "Boundary: during a teardown the buffer-kill hook does not re-delete the frame." - (let (deleted (cj/--agenda-frame-tearing-down t)) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) - (cj/--agenda-frame-on-kill-buffer) - (should-not deleted)))) - -;;; Auto-dim suspension while the agenda frame lives - -(ert-deftest test-org-agenda-frame-spawn-suspends-auto-dim () - "Normal: spawning the frame turns auto-dim off and remembers it was on. -The refresh tick's selection swing marks the working window non-selected; -auto-dim's debounced dim then lands after the tick and the working frame -visibly dims every five minutes." - (defvar auto-dim-other-buffers-mode) - (let ((auto-dim-other-buffers-mode t) - (cj/--agenda-frame-dim-was-on nil) - calls) - (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) - (lambda (arg) (push arg calls))) - ((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'af)) - ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) (lambda (&rest _) nil)) - ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) - (cj/--agenda-frame-spawn) - (should (equal calls '(-1))) - (should cj/--agenda-frame-dim-was-on)))) - -(ert-deftest test-org-agenda-frame-spawn-leaves-auto-dim-when-off () - "Boundary: auto-dim already off -> spawn doesn't touch it, no restore later." - (defvar auto-dim-other-buffers-mode) - (let ((auto-dim-other-buffers-mode nil) - (cj/--agenda-frame-dim-was-on nil) - calls) - (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) - (lambda (arg) (push arg calls))) - ((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'af)) - ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) (lambda (&rest _) nil)) - ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) - (cj/--agenda-frame-spawn) - (should (null calls)) - (should-not cj/--agenda-frame-dim-was-on)))) - -(ert-deftest test-org-agenda-frame-on-delete-restores-auto-dim () - "Normal: closing the frame restores auto-dim when spawn had turned it off." - (let ((cj/--agenda-frame-dim-was-on t) - calls) - (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) - (lambda (arg) (push arg calls))) - ((symbol-function 'cj/--agenda-frame-p) (lambda (_f) t)) - ((symbol-function 'cj/--agenda-frame-cancel-timer) - (lambda (&optional _f) nil))) - (cj/--agenda-frame-on-delete-frame 'af) - (should (equal calls '(1))) - (should-not cj/--agenda-frame-dim-was-on)))) - -(ert-deftest test-org-agenda-frame-on-delete-no-dim-restore-when-untouched () - "Boundary: closing without a suspended auto-dim doesn't enable it." - (let ((cj/--agenda-frame-dim-was-on nil) - calls) - (cl-letf (((symbol-function 'auto-dim-other-buffers-mode) - (lambda (arg) (push arg calls))) - ((symbol-function 'cj/--agenda-frame-p) (lambda (_f) t)) - ((symbol-function 'cj/--agenda-frame-cancel-timer) - (lambda (&optional _f) nil))) - (cj/--agenda-frame-on-delete-frame 'af) - (should (null calls))))) - -;;; Frame lifecycle — transactional spawn rollback - -(ert-deftest test-org-agenda-frame-spawn-rolls-back-on-failure () - "Error: a failure after make-frame deletes the partial frame, restores the -working frame, and signals a user-error." - (let (deleted focus) - (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'pf)) - ((symbol-function 'select-frame-set-input-focus) - (lambda (f &rest _) (setq focus f))) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) (lambda (&rest _) (error "boom"))) - ((symbol-function 'frame-live-p) (lambda (f) (memq f '(pf launch)))) - ((symbol-function 'delete-frame) (lambda (f &rest _) (setq deleted f)))) - (should-error (cj/--agenda-frame-spawn) :type 'user-error) - (should (eq deleted 'pf)) - (should (eq focus 'launch))))) - -;;; Phase 2 — wall-clock alignment - -(ert-deftest test-org-agenda-frame-seconds-to-next-mark-aligned () - "Normal: a time exactly on a 5-minute boundary yields a full period." - ;; 1000000200 is divisible by 300 (a :00/:05 wall-clock mark). - (should (= (cj/--agenda-frame-seconds-to-next-mark 1000000200 300) 300))) - -(ert-deftest test-org-agenda-frame-seconds-to-next-mark-midway () - "Boundary: partway through a period returns the remainder to the next mark." - ;; 1000000200 + 120 -> 180 seconds remain to the next 300 mark. - (should (= (cj/--agenda-frame-seconds-to-next-mark 1000000320 300) 180))) - -;;; Phase 2 — deterministic point restoration - -(defun test-org-agenda-frame--make-agenda-buffer (lines source) - "Insert LINES into the current buffer; each is (TEXT . SRC-POS). -A non-nil SRC-POS puts an org-marker into SOURCE at that position on the line." - (dolist (spec lines) - (let ((start (point))) - (insert (car spec) "\n") - (when (cdr spec) - (put-text-property start (1+ start) 'org-marker - (set-marker (make-marker) (cdr spec) source)))))) - -(ert-deftest test-org-agenda-frame-restore-point-duplicate-nearest () - "Normal: a source marker occurring twice restores the occurrence nearest the old line." - (let ((src (generate-new-buffer " *rp-src*"))) - (unwind-protect - (with-temp-buffer - (with-current-buffer src (insert "aaaaaaaaaa\n")) - (test-org-agenda-frame--make-agenda-buffer - '(("header" . nil) ("item @2" . 3) ("filler" . nil) - ("filler" . nil) ("item @5" . 3)) - src) - (let ((old (set-marker (make-marker) 3 src))) - (cj/--agenda-frame-restore-point old 4)) - ;; lines 2 and 5 both point at src pos 3; nearest to old-line 4 is line 5. - (should (= (line-number-at-pos) 5))) - (kill-buffer src)))) - -(ert-deftest test-org-agenda-frame-restore-point-missing-clamps () - "Boundary: a gone marker clamps the old line into range and lands on an item." - (let ((src (generate-new-buffer " *rp-src*"))) - (unwind-protect - (with-temp-buffer - (with-current-buffer src (insert "aaaaaaaaaa\n")) - (test-org-agenda-frame--make-agenda-buffer - '(("header" . nil) ("item" . 3) ("item" . 5)) - src) - ;; old-line 99 is past the end; clamp to last line (an item). - (let ((gone (set-marker (make-marker) 99 src))) - (cj/--agenda-frame-restore-point gone 99)) - (should (get-text-property (line-beginning-position) 'org-marker))) - (kill-buffer src)))) - -(ert-deftest test-org-agenda-frame-restore-point-header-goes-to-first-item () - "Boundary: with no marker match, a header line moves to the first item." - (let ((src (generate-new-buffer " *rp-src*"))) - (unwind-protect - (with-temp-buffer - (with-current-buffer src (insert "aaaaaaaaaa\n")) - (test-org-agenda-frame--make-agenda-buffer - '(("header" . nil) ("item one" . 3) ("item two" . 5)) - src) - (cj/--agenda-frame-restore-point nil 1) ; line 1 is the header - (should (= (line-number-at-pos) 2)) - (should (get-text-property (line-beginning-position) 'org-marker))) - (kill-buffer src)))) - -(ert-deftest test-org-agenda-frame-restore-point-empty-buffer-start () - "Error: an empty (item-less) view leaves point at buffer start." - (with-temp-buffer - (test-org-agenda-frame--make-agenda-buffer - '(("only a header" . nil) ("no items here" . nil)) nil) - (cj/--agenda-frame-restore-point nil 2) - (should (= (point) (point-min))))) - -;;; Phase 2 — snapshot marker cloning - -(ert-deftest test-org-agenda-frame-clone-and-reinstall-markers () - "Normal: cloned markers survive nulling the originals and reinstall live." - (let ((src (generate-new-buffer " *clone-src*"))) - (unwind-protect - (let (clones) - (with-temp-buffer - (with-current-buffer src (insert "0123456789\n")) - (test-org-agenda-frame--make-agenda-buffer '(("item" . 4)) src) - (setq clones (cj/--agenda-frame-snapshot-markers (current-buffer))) - ;; Simulate org-agenda-reset-markers nulling the buffer's originals. - (let ((orig (get-text-property (point-min) 'org-marker))) - (set-marker orig nil))) - ;; Reinstall into a fresh buffer copy; the clone must still be live. - (with-temp-buffer - (test-org-agenda-frame--make-agenda-buffer '(("item" . nil)) nil) - (cj/--agenda-frame-reinstall-markers (current-buffer) clones) - (let ((m (get-text-property (point-min) 'org-marker))) - (should (markerp m)) - (should (eq (marker-buffer m) src)) - (should (= (marker-position m) 4))))) - (kill-buffer src)))) - -;;; Phase 2 — failure latch (report once per consecutive-failure run) - -(ert-deftest test-org-agenda-frame-failure-latch-reports-once () - "Normal: the first failure of a run reports; subsequent ones stay silent." - (let ((params '())) - (cl-letf (((symbol-function 'frame-parameter) - (lambda (_f p) (alist-get p params))) - ((symbol-function 'set-frame-parameter) - (lambda (_f p v) (setf (alist-get p params) v)))) - (should (cj/--agenda-frame-record-failure 'af)) ; 0 -> 1, report - (should-not (cj/--agenda-frame-record-failure 'af)) ; 1 -> 2, silent - (cj/--agenda-frame-clear-failure 'af) - (should (cj/--agenda-frame-record-failure 'af))))) ; reset -> report again - -;;; Phase 2 — timer start + duplicate prevention - -(ert-deftest test-org-agenda-frame-start-timer-sets-timer () - "Normal: start-timer schedules and stores a timer when none exists." - (let (stored) - (cl-letf (((symbol-function 'frame-parameter) (lambda (_f _p) nil)) - ((symbol-function 'run-at-time) (lambda (&rest _) 'the-timer)) - ((symbol-function 'set-frame-parameter) - (lambda (_f _p v) (setq stored v)))) - (should (eq (cj/--agenda-frame-start-timer 'af) 'the-timer)) - (should (eq stored 'the-timer))))) - -(ert-deftest test-org-agenda-frame-start-timer-no-duplicate () - "Boundary: a frame already carrying a live timer is not given a second one." - (let (called) - (cl-letf (((symbol-function 'frame-parameter) (lambda (_f _p) 'existing)) - ((symbol-function 'timerp) (lambda (x) (eq x 'existing))) - ((symbol-function 'run-at-time) (lambda (&rest _) (setq called t) 'new))) - (cj/--agenda-frame-start-timer 'af) - (should-not called)))) - -;;; Phase 2 — do-redo orchestration (success and failure branches) - -(ert-deftest test-org-agenda-frame-do-redo-success-clears-and-releases () - "Normal: a successful redo clears the failure latch and releases the snapshot." - (let ((params (list (cons 'cj/agenda-frame-fail-count 3))) - released) - (with-temp-buffer - (insert "agenda line\n") - (cl-letf (((symbol-function 'org-agenda-redo) (lambda (&rest _) nil)) - ((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) - ((symbol-function 'set-frame-parameter) - (lambda (_f p v) (setf (alist-get p params) v))) - ((symbol-function 'cj/--agenda-frame-release-snapshot) - (lambda (_s) (setq released t)))) - (cj/--agenda-frame-do-redo 'af (current-buffer) nil) - (should (equal (alist-get 'cj/agenda-frame-fail-count params) 0)) - (should released))))) - -(ert-deftest test-org-agenda-frame-do-redo-error-restores-reenables-reports () - "Error: a redo that fails mid-rebuild restores the last-good buffer verbatim, -re-enables the policy, shows one overlay, and reports once." - (let ((params '()) msgs) - (with-temp-buffer - (insert "good agenda content\n") - (unwind-protect - (cl-letf (((symbol-function 'org-agenda-redo) - (lambda (&rest _) (erase-buffer) (insert "PARTIAL") (error "boom"))) - ((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) - ((symbol-function 'set-frame-parameter) - (lambda (_f p v) (setf (alist-get p params) v))) - ((symbol-function 'message) - (lambda (fmt &rest a) (push (apply #'format fmt a) msgs)))) - (cj/--agenda-frame-do-redo 'af (current-buffer) nil) - (should cj/agenda-frame-mode) ; policy re-enabled - (should (= 1 (length (cj/--agenda-frame-failure-overlays - (current-buffer))))) ; overlay shown - (should (string-match-p "good agenda content" (buffer-string))) ; restored - (should-not (string-match-p "PARTIAL" (buffer-string))) - (should (= 1 (seq-count (lambda (m) (string-match-p "refresh failed" m)) - msgs)))) - (cj/agenda-frame-mode -1) - (cj/--agenda-frame-remove-overlay (current-buffer)))))) - -(ert-deftest test-org-agenda-frame-do-redo-follows-item-across-shift () - "Normal: on a successful redo, point follows the same source item even when -lines shift and the buffer's own markers are nulled (the reset-markers case). -Guards against restoring by raw line number after the item moved." - (let ((src (generate-new-buffer " *shift-src*")) - (params '())) - (unwind-protect - (with-temp-buffer - (with-current-buffer src (insert "0123456789\n")) - ;; Before: item B (src pos 5) sits on line 3, and point is on it. - (test-org-agenda-frame--make-agenda-buffer - '(("header" . nil) ("item A" . 3) ("item B" . 5)) src) - (goto-char (point-min)) (forward-line 2) ; line 3, item B - (cl-letf (((symbol-function 'frame-parameter) (lambda (_f p) (alist-get p params))) - ((symbol-function 'set-frame-parameter) - (lambda (_f p v) (setf (alist-get p params) v))) - ((symbol-function 'org-agenda-redo) - (lambda (&rest _) - ;; Null the buffer's originals (as org-agenda-reset-markers - ;; does), then rebuild with item B shifted to line 4. - (save-excursion - (goto-char (point-min)) - (while (not (eobp)) - (let ((m (get-text-property (line-beginning-position) 'org-marker))) - (when (markerp m) (set-marker m nil))) - (forward-line 1))) - (erase-buffer) - (test-org-agenda-frame--make-agenda-buffer - '(("header" . nil) ("new item" . 1) ("item A" . 3) ("item B" . 5)) - src)))) - (cj/--agenda-frame-do-redo 'af (current-buffer) nil)) - ;; Point should be on the rebuilt item B (src pos 5), now line 4 -- - ;; not clamped to old line 3 (which is now item A, src pos 3). - (let ((m (get-text-property (line-beginning-position) 'org-marker))) - (should (markerp m)) - (should (= (marker-position m) 5)))) - (kill-buffer src)))) - -;;; Phase 2 — snapshot round-trip, release, safe-redo window contract, overlay - -(ert-deftest test-org-agenda-frame-restore-snapshot-round-trip () - "Normal: snapshot then restore reinstates text and a live cloned marker." - (let ((src (generate-new-buffer " *ss-src*"))) - (unwind-protect - (with-temp-buffer - (with-current-buffer src (insert "0123456789\n")) - (test-org-agenda-frame--make-agenda-buffer '(("item alpha" . 4)) src) - (let ((snap (cj/--agenda-frame-snapshot (current-buffer) nil))) - (erase-buffer) - (insert "CORRUPT") - (cj/--agenda-frame-restore-snapshot (current-buffer) snap nil) - (should (string-match-p "item alpha" (buffer-string))) - (let ((m (get-text-property (point-min) 'org-marker))) - (should (markerp m)) - (should (eq (marker-buffer m) src)) - (should (= (marker-position m) 4))) - (cj/--agenda-frame-release-snapshot snap) - (should-not (marker-buffer (cdr (car (plist-get snap :markers))))))) - (kill-buffer src)))) - -(ert-deftest test-org-agenda-frame-safe-redo-selects-and-restores-window () - "Normal: the active tick runs the redo and restores the prior window (no focus theft)." - (let (redone (prev (selected-window))) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) - (lambda () (current-buffer))) - ((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'get-buffer-window) (lambda (&rest _) prev)) - ((symbol-function 'cj/--agenda-frame-do-redo) - (lambda (&rest _) (setq redone t)))) - (cj/--agenda-frame-safe-redo) - (should redone) - (should (eq (selected-window) prev))))) - -(ert-deftest test-org-agenda-frame-overlay-idempotent () - "Boundary: showing the failure overlay twice keeps a single overlay." - (with-temp-buffer - (insert "x\n") - (unwind-protect - (progn - (cj/--agenda-frame-show-failure-overlay (current-buffer)) - (let ((first (car (cj/--agenda-frame-failure-overlays (current-buffer))))) - (cj/--agenda-frame-show-failure-overlay (current-buffer)) - (should (equal (cj/--agenda-frame-failure-overlays (current-buffer)) - (list first))) - (should (= 1 (seq-count (lambda (o) (overlay-get o 'before-string)) - (overlays-in (point-min) (point-max))))))) - (cj/--agenda-frame-remove-overlay (current-buffer))))) - -;;; Phase 2 — public command + F8-family rebind - -(ert-deftest test-org-agenda-frame-public-toggle-wraps-private () - "Normal: the interactive command delegates to the private toggle." - (let (called) - (cl-letf (((symbol-function 'cj/--agenda-frame-toggle) - (lambda () (setq called t)))) - (call-interactively 'cj/agenda-frame-toggle) - (should called)))) - -(ert-deftest test-org-agenda-frame-parameters-normal-tiled-frame () - "Boundary: the agenda frame is a normal frame (the tiling WM places it -side by side with the working frame), carrying the marker and a distinct name." - (let ((params (cj/--agenda-frame-make-parameters))) - (should (assq cj/--agenda-frame-parameter params)) - (should (equal (cdr (assq 'name params)) "Full Agenda")) - ;; No fullscreen request -- a fullboth frame would cover the whole output - ;; instead of tiling beside the working frame. - (should-not (assq 'fullscreen params)))) - -(ert-deftest test-org-agenda-frame-spawn-binds-sticky-and-current-window () - "Normal: spawn dynamically binds sticky + current-window around the render. -The custom command's own settings apply too late to name the buffer, so -without these bindings the buffer is plain *Org Agenda* -- which matches -the 0.75 below-selected display rule and splits the new frame with the -working buffer left on top." - (let (seen-sticky seen-setup) - (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'af)) - ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) - (lambda (&rest _) - (setq seen-sticky org-agenda-sticky - seen-setup org-agenda-window-setup))) - ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) - (cj/--agenda-frame-spawn) - (should (eq seen-sticky t)) - (should (eq seen-setup 'current-window))))) - -(ert-deftest test-org-agenda-frame-spawn-forces-single-window () - "Boundary: spawn collapses the frame to one window after rendering. -A display rule that still splits the frame must not leave a second window -showing the launch buffer." - (let (collapsed) - (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'af)) - ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) (lambda (&rest _) nil)) - ((symbol-function 'delete-other-windows) - (lambda (&rest _) (setq collapsed t))) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) - (cj/--agenda-frame-spawn) - (should collapsed)))) - -(ert-deftest test-org-agenda-frame-spawn-resets-span-to-7 () - "Normal: a fresh spawn opens at the documented seven-day default, even when a -prior frame's session left `cj/--agenda-frame-span' at the day view." - (let ((cj/--agenda-frame-span 1)) - (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'af)) - ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) (lambda (&rest _) nil)) - ((symbol-function 'delete-other-windows) (lambda (&rest _) nil)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-start-timer) (lambda (_f) nil))) - (cj/--agenda-frame-spawn) - (should (equal cj/--agenda-frame-span 7))))) - -(ert-deftest test-org-agenda-frame-spawn-starts-timer () - "Normal: a successful spawn starts the refresh timer for the new frame." - (let (timed) - (cl-letf (((symbol-function 'selected-frame) (lambda () 'launch)) - ((symbol-function 'make-frame) (lambda (&rest _) 'af)) - ((symbol-function 'select-frame-set-input-focus) (lambda (_f &rest _) nil)) - ((symbol-function 'cj/build-org-agenda-list) (lambda (&rest _) nil)) - ((symbol-function 'org-agenda) (lambda (&rest _) nil)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'cj/--agenda-frame-start-timer) - (lambda (f) (setq timed f)))) - (should (eq (cj/--agenda-frame-spawn) 'af)) - (should (eq timed 'af))))) - -(ert-deftest test-org-agenda-frame-safe-redo-inhibits-redisplay () - "Normal: the tick runs with redisplay inhibited. -The rebuild takes visible time; without this, the agenda window is the -selected window for the whole rebuild and the user watches their cursor -go hollow every five minutes -- indistinguishable from focus theft." - (let (seen (prev (selected-window))) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) - (lambda () (current-buffer))) - ((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'get-buffer-window) (lambda (&rest _) prev)) - ((symbol-function 'cj/--agenda-frame-do-redo) - (lambda (&rest _) (setq seen inhibit-redisplay)))) - (cj/--agenda-frame-safe-redo) - (should (eq seen t))))) - -(ert-deftest test-org-agenda-frame-safe-redo-skips-during-minibuffer () - "Boundary: a tick while a minibuffer is active is skipped entirely. -Reselecting windows under an active minibuffer session can break it; the -next tick catches up." - (let (redone (prev (selected-window))) - (cl-letf (((symbol-function 'active-minibuffer-window) (lambda () 'mini)) - ((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) - (lambda () (current-buffer))) - ((symbol-function 'frame-live-p) (lambda (_f) t)) - ((symbol-function 'get-buffer-window) (lambda (&rest _) prev)) - ((symbol-function 'cj/--agenda-frame-do-redo) - (lambda (&rest _) (setq redone t)))) - (cj/--agenda-frame-safe-redo) - (should-not redone)))) - -(ert-deftest test-org-agenda-frame-safe-redo-noop-when-not-shown () - "Boundary: a tick with the buffer not shown in the frame does not redo or error." - (let (redone) - (cl-letf (((symbol-function 'cj/--agenda-frame) (lambda () 'af)) - ((symbol-function 'cj/--agenda-frame-sticky-buffer) (lambda () nil)) - ((symbol-function 'get-buffer-window) (lambda (&rest _) nil)) - ((symbol-function 'cj/--agenda-frame-do-redo) - (lambda (&rest _) (setq redone t)))) - (cj/--agenda-frame-safe-redo) - (should-not redone)))) - -(ert-deftest test-org-agenda-frame-install-keys-rebinds-f8-family () - "Normal: S-<f8> toggles the frame; the force-rescan moves to C-M-<f8>." - (let ((map (make-sparse-keymap))) - (cj/--agenda-frame-install-keys map) - (should (eq (lookup-key map (kbd "S-<f8>")) 'cj/agenda-frame-toggle)) - (should (eq (lookup-key map (kbd "C-M-<f8>")) 'cj/org-agenda-refresh-files)))) - -(provide 'test-org-agenda-frame) -;;; test-org-agenda-frame.el ends here |