diff options
| -rw-r--r-- | modules/org-agenda-frame.el | 16 | ||||
| -rw-r--r-- | tests/test-integration-org-agenda-frame-load-order.el | 80 | ||||
| -rw-r--r-- | tests/test-org-agenda-frame.el | 13 |
3 files changed, 103 insertions, 6 deletions
diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el index 8fbcb390..f0de99ce 100644 --- a/modules/org-agenda-frame.el +++ b/modules/org-agenda-frame.el @@ -359,8 +359,14 @@ re-running rebinds the same denials. Runs from `with-eval-after-load' once #'cj/--agenda-frame-denied-readonly)))))))) source))) -(with-eval-after-load 'org-agenda - (cj/--agenda-frame-shadow-mutations)) +;; 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. @@ -831,5 +837,11 @@ force-refresh idea in the F8 family." ;; 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 new file mode 100644 index 00000000..6541d250 --- /dev/null +++ b/tests/test-integration-org-agenda-frame-load-order.el @@ -0,0 +1,80 @@ +;;; 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 +;; - a real mutation key (t) is still denied (the read-only guarantee holds) +;; +;;; 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 keys keep their commands and a mutation key 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")))) + (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)))) + ;; 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-frame.el b/tests/test-org-agenda-frame.el index fd8bd839..3c56d361 100644 --- a/tests/test-org-agenda-frame.el +++ b/tests/test-org-agenda-frame.el @@ -418,10 +418,15 @@ removed after a later success -- the failure banner would stick forever." (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-not-explicitly-bound () - "Boundary: a mutation key (t = org-agenda-todo) is not explicitly bound, so the -[t] catch-all denies it as read-only." - (should (null (lookup-key cj/agenda-frame-mode-map (kbd "t"))))) +(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 |