diff options
| -rw-r--r-- | modules/music-config.el | 137 | ||||
| -rw-r--r-- | tests/test-music-config--radio-tags.el | 79 | ||||
| -rw-r--r-- | tests/test-music-config--radio.el | 59 | ||||
| -rw-r--r-- | tests/test-music-config--renumber-rows.el | 90 |
4 files changed, 347 insertions, 18 deletions
diff --git a/modules/music-config.el b/modules/music-config.el index 3559930b..b57d910a 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -322,13 +322,58 @@ modification date so marginalia can show them." (completion-ignore-case . t)) (complete-with-action action candidates string pred))))) +(defvar-local cj/music--renumber-timer nil + "Pending idle timer for the playlist row renumber, or nil.") + +(defun cj/music--renumber-rows (&optional buffer) + "Number every playlist row in BUFFER (default: current buffer) via overlays. +Each non-blank line gets an \"NNN \" before-string so the cursor stays +visible when it sits on a cover-art thumbnail and the row's position in +the list is readable at a glance. Overlays rebuild from scratch, so the +numbering survives kills, inserts, and reorders; the buffer text itself is +untouched (EMMS owns it). A dead BUFFER is a silent no-op, since the +debounce timer can outlive the playlist buffer." + (let ((buf (or buffer (current-buffer)))) + (when (buffer-live-p buf) + (with-current-buffer buf + (remove-overlays (point-min) (point-max) 'cj-music-row-number t) + (save-excursion + (goto-char (point-min)) + (let ((n 0)) + (while (not (eobp)) + (unless (looking-at-p "[ \t]*$") + (setq n (1+ n)) + ;; Span one char rather than zero: `overlays-in' (and so + ;; `remove-overlays') can miss an empty overlay sitting + ;; exactly at the region start. + (let ((ov (make-overlay (line-beginning-position) + (1+ (line-beginning-position))))) + (overlay-put ov 'cj-music-row-number t) + (overlay-put ov 'before-string + (propertize (format "%3d " n) + 'face 'cj/music-keyhint-face)))) + (forward-line 1)))))))) + +(defun cj/music--schedule-renumber (&rest _) + "Debounced renumber of the current playlist buffer after a text change. +Wired buffer-locally into `after-change-functions' by +`cj/music--ensure-playlist-buffer'; the idle delay coalesces a burst of +inserts or kills into one renumber pass." + (when (timerp cj/music--renumber-timer) + (cancel-timer cj/music--renumber-timer)) + (setq cj/music--renumber-timer + (run-with-idle-timer 0.2 nil #'cj/music--renumber-rows (current-buffer)))) + (defun cj/music--ensure-playlist-buffer () "Ensure EMMS playlist buffer exists and is in playlist mode. Return buffer." (let ((buffer (get-buffer-create cj/music-playlist-buffer-name))) (with-current-buffer buffer (unless (eq major-mode 'emms-playlist-mode) (emms-playlist-mode)) - (setq emms-playlist-buffer-p t)) + (setq emms-playlist-buffer-p t) + ;; Row numbering: renumber after every playlist change, debounced. + (add-hook 'after-change-functions #'cj/music--schedule-renumber nil t)) + (cj/music--renumber-rows buffer) ;; Set this as the current EMMS playlist buffer (setq emms-playlist-buffer buffer) buffer)) @@ -1434,6 +1479,15 @@ On a connection failure the client falls back to a host from /json/servers.") "User-Agent sent with radio-browser requests. The project asks clients to identify themselves.") +(defvar cj/music-radio-tag-limit 500 + "Maximum number of tags fetched from radio-browser for tag completion. +The /json/tags endpoint is fetched ordered by station count, so the limit +keeps the popular tags and drops the long tail of one-station noise tags.") + +(defvar cj/music-radio--tags-cache nil + "Session cache of radio-browser tag names, or nil before the first fetch. +A failed fetch leaves it nil so the next tag search retries.") + (defvar cj/music-radio-search-limit 30 "Maximum number of stations a radio-browser search returns.") @@ -1504,14 +1558,16 @@ TAGS is a comma-separated string or nil; nil or empty yields the empty string." (defun cj/music-radio--format-candidate (st) "Marginalia annotation for station ST. -Variant B: codec, bitrate, country, votes, and the first few tags." +Variant B: codec, bitrate, country, votes, and the first few tags. Every +field pads to a fixed width (votes included) so the listing reads as +aligned columns across stations." (let ((codec (or (plist-get st :codec) "")) (bitrate (let ((b (plist-get st :bitrate))) (if (and (integerp b) (> b 0)) (format "%dk" b) ""))) (cc (or (plist-get st :countrycode) "")) (votes (or (plist-get st :votes) 0)) (tags (cj/music-radio--tags-snippet (plist-get st :tags) 3))) - (format "%-4s %-5s %-2s ♥%d %s" codec bitrate cc votes tags))) + (format "%-4s %-5s %-2s %-7s %s" codec bitrate cc (format "♥%d" votes) tags))) (defun cj/music-radio--search-url (server query &optional field) "Build the radio-browser station-search URL for QUERY against SERVER. @@ -1570,6 +1626,24 @@ to one station. Pure helper." (puthash disp t seen) (push (cons disp st) out))))) +(defun cj/music-radio--affixate (cands candidates) + "Affixation triples for CANDS with annotations aligned to one column. +CANDIDATES is the (DISPLAY . STATION) alist. Station names vary in width, +so each suffix pads out to the widest candidate plus a gutter; with the +fixed-width fields in `cj/music-radio--format-candidate' the listing reads +as aligned columns. The \"[done]\" sentinel has no station and gets no +annotation rather than a bogus zero row." + (let ((width (apply #'max 0 (mapcar #'string-width cands)))) + (mapcar (lambda (c) + (let ((st (cdr (assoc c candidates)))) + (list c "" + (if st + (concat (make-string (+ 3 (- width (string-width c))) ?\s) + (propertize (cj/music-radio--format-candidate st) + 'face 'completions-annotations)) + "")))) + cands))) + (defun cj/music-radio--completion-table (candidates) "Completion table over CANDIDATES carrying the Variant-B marginalia affix." (lambda (string pred action) @@ -1577,17 +1651,7 @@ to one station. Pure helper." `(metadata (category . cj-radio-station) (affixation-function - . ,(lambda (cands) - (mapcar (lambda (c) - (let ((st (cdr (assoc c candidates)))) - ;; The "[done]" sentinel has no station, so it gets - ;; no annotation rather than a bogus "0" row. - (list c "" (if st - (concat " " - (propertize (cj/music-radio--format-candidate st) - 'face 'completions-annotations)) - "")))) - cands)))) + . ,(lambda (cands) (cj/music-radio--affixate cands candidates)))) (complete-with-action action (mapcar #'car candidates) string pred)))) (defun cj/music-radio--pick-loop (candidates) @@ -1617,8 +1681,10 @@ bitrate, country, votes, and tags), lets you pick several one at a time, adds each to the playlist as a url track carrying its station metadata, and plays the first pick (interrupting whatever was playing). Nothing is written to disk; save the queue with the normal playlist save, where the station name -pre-fills the prompt." - (when (string-empty-p (string-trim query)) +pre-fills the prompt. QUERY is trimmed of surrounding whitespace first -- +a stray trailing space otherwise reaches the API as %20 and matches nothing." + (setq query (string-trim query)) + (when (string-empty-p query) (user-error "Empty search")) (cj/emms--setup) (let* ((stations (cj/music-radio--search query field)) @@ -1650,9 +1716,44 @@ pre-fills the prompt." (interactive "sRadio search (name): ") (cj/music-radio--search-and-play query "name")) +(defun cj/music-radio--tags-url (server) + "Build the radio-browser tag-list URL against SERVER. +Ordered by station count descending so the limit keeps the popular tags." + (format "https://%s/json/tags?order=stationcount&reverse=true&limit=%d" + server cj/music-radio-tag-limit)) + +(defun cj/music-radio--parse-tags (json-text) + "Parse a radio-browser JSON-TEXT tag array into a clean list of tag names. +Names come back whitespace-trimmed with empties and duplicates dropped -- +the source data is user-generated and carries all three. Signals +`user-error' on unreadable JSON (via `cj/music-radio--parse-search')." + (let ((names '())) + (dolist (tag (cj/music-radio--parse-search json-text)) + (let ((name (string-trim (or (plist-get tag :name) "")))) + (unless (or (string-empty-p name) (member name names)) + (push name names)))) + (nreverse names))) + +(defun cj/music-radio--available-tags () + "Return cached radio-browser tag names, fetching once per session. +Returns nil when the fetch or parse fails, leaving the cache empty so a +later call retries; the tag prompt then falls back to free-form input." + (or cj/music-radio--tags-cache + (setq cj/music-radio--tags-cache + (ignore-errors + (when-let ((body (cj/music-radio--http-get + (cj/music-radio--tags-url cj/music-radio-server)))) + (cj/music-radio--parse-tags body)))))) + (defun cj/music-radio-search-by-tag (tag) - "Search radio-browser.info by tag/genre, then queue and play a selection." - (interactive "sRadio search (tag): ") + "Search radio-browser.info by tag/genre, then queue and play a selection. +The prompt completes over the popular tags fetched from radio-browser +\(cached per session), so you pick from tags that exist instead of +guessing. Free-form input still works for an unlisted tag, and the prompt +degrades to plain input when the tag fetch fails." + (interactive + (list (completing-read "Radio search (tag): " + (cj/music-radio--available-tags)))) (cj/music-radio--search-and-play tag "tag")) ;; ------------------------------- Cover art ----------------------------------- diff --git a/tests/test-music-config--radio-tags.el b/tests/test-music-config--radio-tags.el new file mode 100644 index 00000000..60e1c9d8 --- /dev/null +++ b/tests/test-music-config--radio-tags.el @@ -0,0 +1,79 @@ +;;; test-music-config--radio-tags.el --- Tests for radio-browser tag pre-population -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; The tag-search prompt completes over the popular tags fetched from +;; radio-browser's /json/tags endpoint (cached per session). These tests cover +;; the pure pieces: the endpoint URL, the parse (trim + drop-empty + dedupe, +;; since the source data is user-generated and dirty), and the session cache. +;; The network GET is mocked at the boundary. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'music-config) + +(defconst test-music-radio-tags--fixture + (concat "[{\"name\":\"jazz \",\"stationcount\":300}," + "{\"name\":\" jazz\",\"stationcount\":5}," + "{\"name\":\"\",\"stationcount\":2}," + "{\"name\":\"rock\",\"stationcount\":100}]") + "A recorded /json/tags response with whitespace, empty, and duplicate names.") + +;;; Normal Cases + +(ert-deftest test-music-radio-tags-url-shape () + "Normal: the tags URL targets /json/tags ordered by station count with the limit." + (let* ((cj/music-radio-tag-limit 500) + (u (cj/music-radio--tags-url "de1.api.radio-browser.info"))) + (should (string-match-p "/json/tags" u)) + (should (string-match-p "order=stationcount" u)) + (should (string-match-p "limit=500" u)))) + +(ert-deftest test-music-radio-parse-tags-trims-dedupes-drops-empty () + "Normal: tag names come back trimmed, deduped, and without empties." + (should (equal (cj/music-radio--parse-tags test-music-radio-tags--fixture) + '("jazz" "rock")))) + +(ert-deftest test-music-radio-available-tags-caches-per-session () + "Normal: the fetch runs once; later calls serve the cache." + (let ((cj/music-radio--tags-cache nil) + (calls 0)) + (cl-letf (((symbol-function 'cj/music-radio--http-get) + (lambda (_url) (cl-incf calls) test-music-radio-tags--fixture))) + (should (equal (cj/music-radio--available-tags) '("jazz" "rock"))) + (should (equal (cj/music-radio--available-tags) '("jazz" "rock"))) + (should (= calls 1))))) + +;;; Boundary Cases + +(ert-deftest test-music-radio-parse-tags-empty-array () + "Boundary: an empty tag array parses to nil." + (should-not (cj/music-radio--parse-tags "[]"))) + +;;; Error Cases + +(ert-deftest test-music-radio-available-tags-fetch-failure-returns-nil-and-retries () + "Error: a failed fetch yields nil, leaves the cache empty, and retries next call." + (let ((cj/music-radio--tags-cache nil) + (calls 0)) + (cl-letf (((symbol-function 'cj/music-radio--http-get) + (lambda (_url) (cl-incf calls) nil))) + (should-not (cj/music-radio--available-tags)) + (should-not cj/music-radio--tags-cache) + (should-not (cj/music-radio--available-tags)) + (should (= calls 2))))) + +(ert-deftest test-music-radio-parse-tags-malformed-user-errors () + "Error: a non-JSON body signals user-error, not a raw parse error." + (should-error (cj/music-radio--parse-tags "<html>502</html>") + :type 'user-error)) + +(provide 'test-music-config--radio-tags) +;;; test-music-config--radio-tags.el ends here diff --git a/tests/test-music-config--radio.el b/tests/test-music-config--radio.el index 3923a599..db917a03 100644 --- a/tests/test-music-config--radio.el +++ b/tests/test-music-config--radio.el @@ -134,5 +134,64 @@ (should (= (length cands) 2)) (should (= (length (delete-dups (copy-sequence keys))) 2)))) +;;; --------------------------- query whitespace -------------------------------- + +(ert-deftest test-music-radio-search-and-play-trims-query () + "Normal: surrounding whitespace on the query is stripped before the search. +A trailing space in the minibuffer otherwise reaches the API as %20 and +matches nothing." + (let (captured) + (cl-letf (((symbol-function 'cj/emms--setup) #'ignore) + ((symbol-function 'cj/music-radio--search) + (lambda (query _field) (setq captured query) nil))) + (should-error (cj/music-radio--search-and-play " jazz " "tag") + :type 'user-error)) + (should (equal captured "jazz")))) + +(ert-deftest test-music-radio-search-and-play-whitespace-only-no-search () + "Error: a whitespace-only query errors out before any network search." + (let (searched) + (cl-letf (((symbol-function 'cj/emms--setup) #'ignore) + ((symbol-function 'cj/music-radio--search) + (lambda (&rest _) (setq searched t) nil))) + (should-error (cj/music-radio--search-and-play " " "tag") + :type 'user-error)) + (should-not searched))) + +;;; --------------------------- column alignment -------------------------------- + +(ert-deftest test-music-radio-format-candidate-votes-column-fixed-width () + "Normal: the votes field pads to a fixed width so the tags column aligns +across stations with different vote counts." + (let* ((low (cj/music-radio--format-candidate + '(:codec "MP3" :bitrate 128 :countrycode "US" :votes 7 :tags "jazz"))) + (high (cj/music-radio--format-candidate + '(:codec "MP3" :bitrate 128 :countrycode "US" :votes 174208 :tags "jazz")))) + (should (= (string-match "jazz" low) (string-match "jazz" high))))) + +(ert-deftest test-music-radio-affixate-aligns-annotation-column () + "Normal: every annotation starts at the same display column regardless of +how long the station name is." + (let* ((candidates '(("Short" . (:codec "MP3" :bitrate 128 :countrycode "US" + :votes 5 :tags "a")) + ("A Much Longer Station Name" . (:codec "AAC" :bitrate 64 + :countrycode "FR" :votes 9 :tags "b")))) + (triples (cj/music-radio--affixate (mapcar #'car candidates) candidates)) + (cols (mapcar (lambda (triple) + (let ((cand (nth 0 triple)) + (suffix (nth 2 triple))) + (string-match "[^ ]" suffix) + (+ (string-width cand) (match-beginning 0)))) + triples))) + (should (= (length triples) 2)) + (should (apply #'= cols)))) + +(ert-deftest test-music-radio-affixate-done-sentinel-no-annotation () + "Boundary: the [done] sentinel has no station and gets an empty suffix." + (let* ((candidates '(("[done]") ("Station" . (:codec "MP3" :bitrate 128 + :countrycode "US" :votes 1 :tags "x")))) + (triples (cj/music-radio--affixate (mapcar #'car candidates) candidates))) + (should (equal (nth 2 (car triples)) "")))) + (provide 'test-music-config--radio) ;;; test-music-config--radio.el ends here diff --git a/tests/test-music-config--renumber-rows.el b/tests/test-music-config--renumber-rows.el new file mode 100644 index 00000000..8abe1704 --- /dev/null +++ b/tests/test-music-config--renumber-rows.el @@ -0,0 +1,90 @@ +;;; test-music-config--renumber-rows.el --- Tests for playlist row numbering -*- coding: utf-8; lexical-binding: t; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; Playlist rows carry a numeric overlay prefix so the cursor stays visible +;; when it sits on a cover-art thumbnail and each row's position in the list +;; is readable. The renumber walks the buffer and rebuilds the overlays; a +;; buffer-local after-change hook debounces it behind an idle timer. Overlays +;; leave the buffer text untouched (EMMS owns it), so these tests drive plain +;; temp buffers. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +(defvar cj/custom-keymap (make-sparse-keymap) + "Stub keymap for testing.") + +(require 'music-config) + +(defun test-music-renumber--numbers (buffer) + "Return the overlay number strings in BUFFER, in position order." + (with-current-buffer buffer + (mapcar (lambda (ov) (overlay-get ov 'before-string)) + (sort (seq-filter (lambda (ov) (overlay-get ov 'cj-music-row-number)) + (overlays-in (point-min) (point-max))) + (lambda (a b) (< (overlay-start a) (overlay-start b))))))) + +;;; Normal Cases + +(ert-deftest test-music-renumber-rows-numbers-each-line () + "Normal: every non-blank line gets a sequential number overlay." + (with-temp-buffer + (insert "track one\ntrack two\ntrack three\n") + (cj/music--renumber-rows (current-buffer)) + (should (equal (mapcar #'substring-no-properties + (test-music-renumber--numbers (current-buffer))) + '(" 1 " " 2 " " 3 "))))) + +(ert-deftest test-music-renumber-rows-idempotent () + "Normal: renumbering twice leaves one overlay per line, not two." + (with-temp-buffer + (insert "track one\ntrack two\n") + (cj/music--renumber-rows (current-buffer)) + (cj/music--renumber-rows (current-buffer)) + (should (= 2 (length (test-music-renumber--numbers (current-buffer))))))) + +;;; Boundary Cases + +(ert-deftest test-music-renumber-rows-skips-blank-lines () + "Boundary: blank lines are not numbered and don't advance the count." + (with-temp-buffer + (insert "track one\n\ntrack two\n") + (cj/music--renumber-rows (current-buffer)) + (should (equal (mapcar #'substring-no-properties + (test-music-renumber--numbers (current-buffer))) + '(" 1 " " 2 "))))) + +(ert-deftest test-music-renumber-rows-empty-buffer-no-overlays () + "Boundary: an empty buffer gets no overlays and no error." + (with-temp-buffer + (cj/music--renumber-rows (current-buffer)) + (should-not (test-music-renumber--numbers (current-buffer))))) + +;;; Error Cases + +(ert-deftest test-music-renumber-rows-dead-buffer-noop () + "Error: renumbering a killed buffer is a silent no-op (the debounce timer +can fire after the playlist buffer is gone)." + (let ((buf (generate-new-buffer " *test-renumber-dead*"))) + (kill-buffer buf) + (should-not (cj/music--renumber-rows buf)))) + +;;; Hook wiring + +(ert-deftest test-music-renumber-ensure-playlist-buffer-wires-hook () + "Normal: the playlist buffer gets the debounced renumber on after-change." + (let (created) + (cl-letf (((symbol-function 'emms-playlist-mode) #'ignore)) + (unwind-protect + (progn + (setq created (cj/music--ensure-playlist-buffer)) + (with-current-buffer created + (should (member #'cj/music--schedule-renumber after-change-functions)))) + (when (buffer-live-p created) (kill-buffer created)))))) + +(provide 'test-music-config--renumber-rows) +;;; test-music-config--renumber-rows.el ends here |