From a2d3e77f82ccf5701d9490c1d1fc2d3c75916eae Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Mon, 27 Jul 2026 10:25:16 -0500 Subject: fix: restore Full Agenda controls and clean startup I restored controlled agenda task mutations and filtered completed items from the dedicated frame. I replaced the treesit-auto revision setter that aborted startup with a runtime slot lookup. --- modules/org-agenda-frame.el | 43 ++++++++++++--- modules/prog-general.el | 27 ++++++---- ...test-integration-org-agenda-frame-load-order.el | 15 ++++-- tests/test-org-agenda-frame.el | 63 ++++++++++++++++++++++ .../test-prog-general--pin-go-treesit-revision.el | 51 ++++++++++++++++++ 5 files changed, 179 insertions(+), 20 deletions(-) create mode 100644 tests/test-prog-general--pin-go-treesit-revision.el diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el index f0de99ce..471b246b 100644 --- a/modules/org-agenda-frame.el +++ b/modules/org-agenda-frame.el @@ -42,6 +42,11 @@ (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)) @@ -121,6 +126,11 @@ a non-nil global default can't open a second window at build time." (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. @@ -273,6 +283,22 @@ The default binding for every key not on the allowlist." ;; 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 @@ -280,7 +306,7 @@ The default binding for every key not on the allowlist." ;; 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) - ;; (d) Input machinery punched through the catch-all. An explicit nil + ;; (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 @@ -292,7 +318,7 @@ The default binding for every key not on the allowlist." [mouse-1] [down-mouse-1] [drag-mouse-1] (kbd "C-h"))) (define-key map key nil)) - ;; (e) Global chords that would pull focus out of the frame must be + ;; (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 / @@ -307,16 +333,17 @@ The default binding for every key not on the allowlist." 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, so a future Org binding -is denied by default and there is nothing to keep in sync.") +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 - "Read-only, focus-locked policy for the dedicated agenda frame. + "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. Every other key/mouse command is denied. The enforcement -boundary is keys and mouse; a direct \\[execute-extended-command] is out -of contract." +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) diff --git a/modules/prog-general.el b/modules/prog-general.el index a1377160..77ff88a5 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -39,6 +39,7 @@ ;;; Code: (require 'user-constants) ;; code-dir, projects-dir, snippets-dir +(require 'cl-lib) (defvar display-line-numbers-type) (defvar outline-minor-mode-map) @@ -57,6 +58,7 @@ (declare-function dired-get-filename "dired") (declare-function global-treesit-auto-mode "treesit-auto") (declare-function treesit-auto-add-to-auto-mode-alist "treesit-auto") +(declare-function treesit-auto-install-all "treesit-auto") (declare-function treesit-auto-recipe-lang "treesit-auto") (declare-function highlight-indent-guides-mode "highlight-indent-guides") (declare-function electric-pair-default-inhibit "elec-pair") @@ -120,20 +122,27 @@ REGEXP must be a string or an rx form." ;; build mid-edit. Batch/test runs never load treesit-auto (no package ;; init), so they can never install. Fresh-machine bootstrap is the ;; explicit `cj/install-treesit-grammars' command below. +(defun cj/treesit-auto-pin-go-revision (recipes) + "Pin the Go grammar revision in treesit-auto RECIPES. +Return the updated Go recipe, or nil when RECIPES has no Go entry. +Discover the `revision' slot at runtime because treesit-auto is not loaded +when this file's `use-package' form is macro-expanded." + (when-let ((go-recipe + (cl-find-if + (lambda (recipe) + (eq (treesit-auto-recipe-lang recipe) 'go)) + recipes))) + (aset go-recipe + (cl-struct-slot-offset 'treesit-auto-recipe 'revision) + "v0.19.1") + go-recipe)) + (use-package treesit-auto :custom (treesit-auto-install 'prompt) :config - (require 'cl-lib) ;; Pin Go grammar to v0.19.1 for compatibility with Emacs 30.2 font-lock queries - (let* ((go-idx (cl-position-if (lambda (recipe) - (eq (treesit-auto-recipe-lang recipe) 'go)) - treesit-auto-recipe-list)) - (go-recipe (and go-idx (nth go-idx treesit-auto-recipe-list)))) - (when go-recipe - ;; Use the struct accessor so a treesit-auto slot reorder can't silently - ;; write the pin into the wrong field. - (setf (treesit-auto-recipe-revision go-recipe) "v0.19.1"))) + (cj/treesit-auto-pin-go-revision treesit-auto-recipe-list) (treesit-auto-add-to-auto-mode-alist 'all) (global-treesit-auto-mode)) diff --git a/tests/test-integration-org-agenda-frame-load-order.el b/tests/test-integration-org-agenda-frame-load-order.el index 6541d250..a8eeaa47 100644 --- a/tests/test-integration-org-agenda-frame-load-order.el +++ b/tests/test-integration-org-agenda-frame-load-order.el @@ -23,7 +23,8 @@ ;; ;; Validates: ;; - d/w/g/r keep their allowlist commands in the org-first load order -;; - a real mutation key (t) is still denied (the read-only guarantee holds) +;; - the controlled status/priority mutations survive the shadow walk +;; - a non-allowlisted mutation key (t) is still denied ;; ;;; Code: @@ -65,14 +66,22 @@ Returns an alist of (KEY . BINDING-SYMBOL-NAME-OR-nil)." (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 keys keep their commands and a mutation key stays denied." +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" "t")))) + (let ((got (test-oaf--lookup-in-subprocess + '("d" "w" "g" "r" "C-c t" "C-c C-t" + "M-" "M-" "s-" "s-" "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-" got)))) + (should (equal "org-agenda-todo-nextset" (cdr (assoc "M-" got)))) + (should (equal "org-agenda-priority-down" (cdr (assoc "s-" got)))) + (should (equal "org-agenda-todo-previousset" (cdr (assoc "s-" 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)))))) diff --git a/tests/test-org-agenda-frame.el b/tests/test-org-agenda-frame.el index 3c56d361..167cf2ff 100644 --- a/tests/test-org-agenda-frame.el +++ b/tests/test-org-agenda-frame.el @@ -174,6 +174,45 @@ leaves a wide blank gutter between the source name and the item." (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 @@ -315,6 +354,24 @@ d shrinks the frame to the current day, w restores the seven-day span." (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-" . org-agenda-priority-up) + ("M-" . org-agenda-priority-down) + ("M-" . org-agenda-todo-previousset) + ("M-" . org-agenda-todo-nextset) + ("s-" . org-agenda-priority-up) + ("s-" . org-agenda-priority-down) + ("s-" . org-agenda-todo-previousset) + ("s-" . 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. @@ -340,6 +397,12 @@ d/w, C-c C-o) intact." (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-")) 'org-agenda-priority-up)) + (should (eq (key-binding (kbd "M-")) 'org-agenda-todo-nextset)) + (should (eq (key-binding (kbd "s-")) 'org-agenda-priority-down)) + (should (eq (key-binding (kbd "s-")) '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)))) diff --git a/tests/test-prog-general--pin-go-treesit-revision.el b/tests/test-prog-general--pin-go-treesit-revision.el new file mode 100644 index 00000000..42845b4f --- /dev/null +++ b/tests/test-prog-general--pin-go-treesit-revision.el @@ -0,0 +1,51 @@ +;;; test-prog-general--pin-go-treesit-revision.el --- Go grammar pinning -*- lexical-binding: t; -*- + +;;; Commentary: +;; The treesit-auto Go recipe is pinned for compatibility with Emacs 30.2. +;; Keep the mutation independent of cl-defstruct's compile-time setter +;; expansion: prog-general is loaded before treesit-auto defines that setter +;; during a normal startup. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +;; Deliberately put `revision' at a different offset from treesit-auto's real +;; struct. The production helper must discover the slot rather than hard-code +;; the package's current vector layout. +(cl-defstruct treesit-auto-recipe lang revision url) + +(add-to-list 'load-path (expand-file-name "modules" user-emacs-directory)) +(require 'prog-general) + +(ert-deftest test-prog-general-pin-go-treesit-revision-updates-go () + "Normal: the Go recipe receives the supported grammar revision." + (let* ((go (make-treesit-auto-recipe + :lang 'go :revision "main" :url "https://example.test/go")) + (python (make-treesit-auto-recipe + :lang 'python :revision "main" + :url "https://example.test/python"))) + (cj/treesit-auto-pin-go-revision (list python go)) + (should (equal (treesit-auto-recipe-revision go) "v0.19.1")) + (should (equal (treesit-auto-recipe-revision python) "main")))) + +(ert-deftest test-prog-general-pin-go-treesit-revision-no-go-is-no-op () + "Boundary: a recipe list without Go remains unchanged." + (let ((python (make-treesit-auto-recipe + :lang 'python :revision "main" + :url "https://example.test/python"))) + (should-not (cj/treesit-auto-pin-go-revision (list python))) + (should (equal (treesit-auto-recipe-revision python) "main")))) + +(ert-deftest test-prog-general-pin-go-treesit-revision-empty-is-no-op () + "Boundary: an empty recipe list does not signal an error." + (should-not (cj/treesit-auto-pin-go-revision nil))) + +(ert-deftest test-prog-general-pin-go-treesit-revision-malformed-recipe-errors () + "Error: a malformed recipe signals instead of silently skipping the pin." + (should-error (cj/treesit-auto-pin-go-revision '(not-a-recipe)) + :type 'wrong-type-argument)) + +(provide 'test-prog-general--pin-go-treesit-revision) +;;; test-prog-general--pin-go-treesit-revision.el ends here -- cgit v1.2.3