aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--modules/org-agenda-frame.el43
-rw-r--r--modules/prog-general.el27
-rw-r--r--tests/test-integration-org-agenda-frame-load-order.el15
-rw-r--r--tests/test-org-agenda-frame.el63
-rw-r--r--tests/test-prog-general--pin-go-treesit-revision.el51
5 files changed, 179 insertions, 20 deletions
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-<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
@@ -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-<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))))))
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-<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.
@@ -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-<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))))
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