diff options
| -rw-r--r-- | modules/music-config.el | 15 | ||||
| -rw-r--r-- | modules/org-agenda-frame.el | 84 | ||||
| -rw-r--r-- | tests/test-music-config--header-text.el | 17 | ||||
| -rw-r--r-- | tests/test-music-config-create-radio-station.el | 7 | ||||
| -rw-r--r-- | tests/test-org-agenda-frame.el | 95 |
5 files changed, 198 insertions, 20 deletions
diff --git a/modules/music-config.el b/modules/music-config.el index d33c8c45..a7ec62c8 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -1377,12 +1377,12 @@ The rule uses a resize-safe :align-to span, not a hardcoded character count." (propertize "Mode " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) (funcall mode-indicator "r" "repeat" (bound-and-true-p emms-repeat-playlist)) " " - (funcall mode-indicator "s" "single" (bound-and-true-p emms-repeat-track)) " " + (funcall mode-indicator "1" "single" (bound-and-true-p emms-repeat-track)) " " (funcall mode-indicator "z" "random" (bound-and-true-p emms-random-playlist)) " " (funcall mode-indicator "x" "consume" cj/music-consume-mode) "\n" (propertize "Keys " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) - (propertize "a:add c:clear L:load v:save D:delete S:stop SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" + (propertize "a:add c:clear L:load s:save D:delete SPC:pause <>:skip ↑↓:move C-↑↓:reorder q:dismiss" 'face 'cj/music-keyhint-face) "\n" (propertize "Radio " 'face 'cj/music-header-face) (propertize " : " 'face 'cj/music-header-face) @@ -1614,7 +1614,6 @@ unless fancy." ;; Playback ("p" . emms-playlist-mode-go) ("SPC" . emms-pause) - ("s" . emms-stop) ("n" . cj/music-next) (">" . cj/music-next) ("P" . cj/music-previous) @@ -1640,7 +1639,6 @@ unless fancy." ("D" . cj/music-delete-playlist) ("E" . cj/music-playlist-edit) ("g" . cj/music-playlist-reload) - ("v" . cj/music-playlist-save) ;; Track reordering ("S-<up>" . emms-playlist-mode-shift-track-up) ("S-<down>" . emms-playlist-mode-shift-track-down) @@ -2094,14 +2092,15 @@ when there is nothing to fetch." (message "Cleared music art cache: %s" cj/music-art-cache-dir)) ;; Radio row in the playlist buffer: n = search by name, t = search by tag, -;; m = enter a station by hand. This moves the "single" mode toggle off t to s -;; and emms-stop off s to S (see the header's Mode/Keys/Radio rows). +;; m = enter a station by hand. Single-track mode is on 1 and s saves the +;; playlist; stop was dropped (SPC/pause covers it). These run after +;; use-package's :map, so they win (see the header's Mode/Keys/Radio rows). (with-eval-after-load 'emms (keymap-set emms-playlist-mode-map "n" #'cj/music-radio-search-by-name) (keymap-set emms-playlist-mode-map "t" #'cj/music-radio-search-by-tag) (keymap-set emms-playlist-mode-map "m" #'cj/music-create-radio-station) - (keymap-set emms-playlist-mode-map "s" #'emms-toggle-repeat-track) - (keymap-set emms-playlist-mode-map "S" #'emms-stop)) + (keymap-set emms-playlist-mode-map "1" #'emms-toggle-repeat-track) + (keymap-set emms-playlist-mode-map "s" #'cj/music-playlist-save)) (provide 'music-config) ;;; music-config.el ends here diff --git a/modules/org-agenda-frame.el b/modules/org-agenda-frame.el index 1a19cc1b..b783e358 100644 --- a/modules/org-agenda-frame.el +++ b/modules/org-agenda-frame.el @@ -31,6 +31,7 @@ ;; `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)) @@ -95,9 +96,18 @@ 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 seven-day span anchored to today rather than +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), @@ -105,7 +115,7 @@ 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 7) + ((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) @@ -195,7 +205,7 @@ frame stranded on a non-agenda buffer." "Shown when a mutating or buffer-opening command is denied in the frame.") (defconst cj/--agenda-frame-fixed-view-message - "Agenda frame is fixed to the 7-day view" + "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 () @@ -257,6 +267,10 @@ The default binding for every key not on the allowlist." ;; 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) (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 @@ -284,8 +298,9 @@ The default binding for every key not on the allowlist." ;; 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)) - ;; View-changers get the distinct fixed-view message, not the read-only one. - (dolist (key '("w" "d" "y" "f" "b" "j")) + ;; 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'. @@ -304,6 +319,47 @@ of contract." :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))) + +(with-eval-after-load 'org-agenda + (cj/--agenda-frame-shadow-mutations)) + (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 @@ -428,6 +484,9 @@ Returns the new agenda frame on success." (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 @@ -716,6 +775,21 @@ out-of-range window-start nor steals focus." (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). diff --git a/tests/test-music-config--header-text.el b/tests/test-music-config--header-text.el index 8de97350..c860c6d4 100644 --- a/tests/test-music-config--header-text.el +++ b/tests/test-music-config--header-text.el @@ -139,6 +139,23 @@ (should (string-match-p "consume" plain)))) (test-header--teardown))) +(ert-deftest test-music-config--header-text-boundary-key-hints-single-save-stop () + "Header key hints: single is on 1, save is on s, and stop (S) is gone. +SPC/pause covers stop, so the S:stop hint and the [s] single / v:save hints +are retired." + (unwind-protect + (progn + (test-header--setup-playlist-buffer '("/music/a.mp3")) + (let* ((header (with-current-buffer cj/music-playlist-buffer-name + (cj/music--header-text))) + (plain (test-header--strip-properties header))) + (should (string-match-p "\\[1\\] single" plain)) + (should (string-match-p "s:save" plain)) + (should-not (string-match-p "\\[s\\] single" plain)) + (should-not (string-match-p "v:save" plain)) + (should-not (string-match-p "S:stop" plain)))) + (test-header--teardown))) + ;;; Error Cases (ert-deftest test-music-config--header-text-error-empty-playlist-shows-zero-count () diff --git a/tests/test-music-config-create-radio-station.el b/tests/test-music-config-create-radio-station.el index 7d9adbed..4f49f49b 100644 --- a/tests/test-music-config-create-radio-station.el +++ b/tests/test-music-config-create-radio-station.el @@ -106,15 +106,16 @@ (ert-deftest test-music-config-menu-map-lowercase-keys () "Normal: the menu's former uppercase keys live on lowercase homes, and the -playlist buffer saves on v." +playlist buffer saves on s (single on 1, old save key v unbound)." (should (eq (lookup-key cj/music-map "v") 'cj/music-playlist-show)) (should (eq (lookup-key cj/music-map "u") 'emms-shuffle)) (should (eq (lookup-key cj/music-map "l") 'emms-toggle-repeat-playlist)) (should-not (lookup-key cj/music-map "R")) (should-not (lookup-key cj/music-map "M")) (should-not (lookup-key cj/music-map "Z")) - (should (eq (lookup-key emms-playlist-mode-map "v") 'cj/music-playlist-save)) - (should-not (eq (lookup-key emms-playlist-mode-map "w") 'cj/music-playlist-save))) + (should (eq (lookup-key emms-playlist-mode-map "s") 'cj/music-playlist-save)) + (should (eq (lookup-key emms-playlist-mode-map "1") 'emms-toggle-repeat-track)) + (should-not (lookup-key emms-playlist-mode-map "v"))) ;;; Error Cases diff --git a/tests/test-org-agenda-frame.el b/tests/test-org-agenda-frame.el index fe4cee66..fd8bd839 100644 --- a/tests/test-org-agenda-frame.el +++ b/tests/test-org-agenda-frame.el @@ -121,14 +121,50 @@ (should (equal (nth 0 (cj/--agenda-frame-command)) "F"))) (ert-deftest test-org-agenda-frame-command-today-anchored-7-day () - "Normal: the span is seven days anchored to today, not Monday." + "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 (cadr (assq 'org-agenda-span s)) 7)) + (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 @@ -212,7 +248,7 @@ the spawn wrapper, where it names the buffer." (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 "7-day view" captured)))) + (should (string-match-p "day (d) and week (w)" captured)))) ;;; Default-deny policy — the keymap @@ -267,10 +303,46 @@ fixed-view deny handler." (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 '("w" "d" "y" "f" "b" "j")) + (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-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 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 @@ -944,6 +1016,21 @@ showing the launch buffer." (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) |