From 9da363f35b2b9ebc5ffefb41cf092b006c56a695 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Mon, 27 Jul 2026 14:19:32 -0500 Subject: refactor(agenda): replace the dedicated frame with a full-frame F8 - F8 now fills the whole frame instead of three quarters. - The agenda rebuilds itself on every five-minute wall-clock mark. - Quitting restores the window layout it took over. - The dedicated agenda frame and its tests are gone. - S- returns to the force-rescan. The frame bought live shared state. It paid for that with a read-only deny policy, engage-routing and a snapshot failure path. All of it existed only because the agenda shared a process with my working frames. A full-frame F8 needs none of it. The refresh rebuilds only a visible agenda. It keeps point on its line. The body is guarded, because a signal in a repeating timer resignals every tick. --- modules/org-agenda-frame.el | 874 -------------------------------------------- 1 file changed, 874 deletions(-) delete mode 100644 modules/org-agenda-frame.el (limited to 'modules/org-agenda-frame.el') 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 - -;;; 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 "") #'org-agenda-next-line) - (define-key map (kbd "") #'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 "") #'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- 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-" "s-")) - (define-key map (kbd key) #'org-agenda-priority-up)) - (dolist (key '("M-" "s-")) - (define-key map (kbd key) #'org-agenda-priority-down)) - (dolist (key '("M-" "s-")) - (define-key map (kbd key) #'org-agenda-todo-previousset)) - (dolist (key '("M-" "s-")) - (define-key map (kbd key) #'org-agenda-todo-nextset)) - (define-key map (kbd "S-") #'cj/agenda-frame-toggle) - (define-key map (kbd "C-M-") #'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-." - (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- 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- 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- toggles the agenda frame; the force-rescan -\(`cj/org-agenda-refresh-files') moves to C-M-, keeping the whole -force-refresh idea in the F8 family." - (let ((map (or map (current-global-map)))) - (define-key map (kbd "S-") #'cj/agenda-frame-toggle) - (define-key map (kbd "C-M-") #'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 -- cgit v1.2.3