commit - bf5177b65a99d5e54854d1582bed66cd26a1b191
commit + 9e2db7b073ec8f5efc39c7f57b0a0b28f0b40933
blob - bd5958dd78c5d3c24a0377bfa5e02d9c0ec13c79
blob + 12eb1fd97f8fe1a0dfca57d4d536a28209f7b8f7
--- Makefile
+++ Makefile
$(SCHEME) --libdirs $(LIBDIR) --compile-imported-libraries --program tools/build.ss
test:
- MCOL_INPUT="$(INPUT)" $(RUN) test/test.ss
+ $(RUN) test/test.ss
install: build/mcol.so
install -d "$(DESTDIR)$(BINDIR)" "$(DESTDIR)$(LIBEXECDIR)/lib/mcol" \
@printf '%s\n' \
'make tui Run the ANSI terminal browser' \
'make build Compile the Chez Scheme program' \
- 'make test Run fixture and repository tests' \
+ 'make test Run fixture and demo tests' \
'make install Install mcol and its manual' \
'make uninstall Remove installed files' \
'make clean Remove generated artifacts' \
blob - /dev/null
blob + a3a75596d444e0e8f8f8ac573fff05562e86c7ac (mode 644)
--- /dev/null
+++ LICENSE
+MIT License
+
+Copyright (c) 2026 mtmn
+
+Permission is hereby granted, free of charge, to any person obtaining a copy
+of this software and associated documentation files (the "Software"), to deal
+in the Software without restriction, including without limitation the rights
+to use, copy, modify, merge, publish, distribute, sublicense, and/or sell
+copies of the Software, and to permit persons to whom the Software is
+furnished to do so, subject to the following conditions:
+
+The above copyright notice and this permission notice shall be included in all
+copies or substantial portions of the Software.
+
+THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS OR
+IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF MERCHANTABILITY,
+FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. IN NO EVENT SHALL THE
+AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, DAMAGES OR OTHER
+LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR OTHERWISE, ARISING FROM,
+OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE
+SOFTWARE.
blob - 73d03f6f42c37dd0d01d033814130591f837d5a8
blob + 14e6c56e3ed6701066aae734fe37cd43cda677dd
--- README.md
+++ README.md
Terminal browser for an MPD release archive, written in Chez Scheme.
-The input directory must contain `all.txt`. Its non-empty lines are
-slash-separated release paths, read as:
+mcol scans dated release lists and builds its release list from their
+slash-separated paths, read as:
- `artist/album`
- `label/artist/release` (or a longer label/artist/release path)
-Parent paths are not counted as releases. mcol scans the catalog and recognized
+Blank lines and parent paths are not counted as releases. mcol scans recognized
dated lists without a date cutoff:
- `YEAR/MONTH/dailies/YYYY-MM-DD.txt`, or historical `DD_MM_YYYY.txt`
- `YEAR/dailies/stdin_playlist_YYYYMMDD*.txt` as a fallback when no daily exists
- `YEAR/MONTH/1_..._....txt` through `YEAR/MONTH/4_..._....txt` for weekly lists
-`MONTH` is a full English month name. Multiple session playlists for a date are
-merged. Weekly and daily totals are compared in the Weeks view, never combined.
-Files below `mixes/` or `labels/` are ignored. `--strict` rejects malformed
-filenames in recognized daily and weekly locations.
-
## Run
Requires Chez Scheme 10.4 or newer. Playback requires `mpc`.
Input is chosen from `--input`, then `MCOL_INPUT`, then the current directory:
```sh
-export MCOL_INPUT=~/src/mtmn.name/releases
+export MCOL_INPUT=/path/to/releases
make tui
```
p play release q queue release
nn next page pp prev page b back
? help / filter
+x exit
```
Enter a row number to open it. Commands such as `:month 2026-08`,
-`:day 2026-08-11`, `:label Warp`, `:artist Autechre`, and `:search Autechre`
+`:day 2026-08-11`, `:label Warp`, `:artist Autechre`, `:release Label/Artist/Release`, and
+`:search Autechre`
are also accepted.
`r` prompts for a random-release count (default: 5). Use `p 4 5 2` to append
```sh
make build
-make test INPUT=/path/to/releases
+make test
make install # /usr/local
make install PREFIX=~/.local
```
blob - 63a094f0efcff0274c7d0b113ca7eb84f699559e
blob + 7c7972f063378a9abe92944ab1d65489f697428e
--- bin/mcol.ss
+++ bin/mcol.ss
(define (usage port)
(display "Usage: mcol [--input PATH] [--strict]\n" port)
(display "Input: --input PATH, then MCOL_INPUT, then the current directory.\n" port)
+ (display "PATH is scanned for recognized dated daily, session, and weekly release lists.\n" port)
(display "Runs the interactive ANSI terminal browser. Set NO_COLOR=1 to disable color.\n" port))
(define arguments (cdr (command-line)))
blob - a26e5133697c62ba42413cd19c29659bddee9cea
blob + 00a8b5821d650fb018b6a35d398931f226d39fc7
--- demo/README.md
+++ demo/README.md
make tui INPUT=demo
```
-The dated lists demonstrate daily, legacy, session, and weekly activity
-sources. mcol derives its browsable release library from these files.
+The dated lists demonstrate daily, legacy, session, and weekly sources. mcol
+builds its release list from these files.
blob - 95e2464c6878a517eb2e5fe7da0f74b22d682ad1
blob + 7379731b83ccd1cc1a32ff103eb6d085a7d17ac8
--- doc/mcol.1
+++ doc/mcol.1
.RB [ \-\-strict ]
.SH DESCRIPTION
.B mcol
-is a terminal browser for a directory of release lists.
-The directory must contain an
-.I all.txt
-catalog. Each non-empty line is a slash-separated release path. Two-part
-paths are interpreted as artist/album; paths with three or more parts are
-interpreted as label/artist/release, with any remaining parts retained in the
-release name. Parent paths are not counted as releases.
+is a terminal browser for a directory of dated release lists. It builds its
+release list from recognized files. Each non-empty line is one
+slash-separated release path. Two-part paths are interpreted as artist/album;
+paths with three or more parts are interpreted as label/artist/release, with
+any remaining parts retained in the release name. Blank lines and parent paths
+are not counted as releases.
.PP
The input directory comes from
.BR \-\-input ,
.BR MCOL_INPUT ,
or the current directory, in that order.
-The catalog and recognized dated lists are scanned without a date cutoff.
+Recognized dated lists are scanned without a date cutoff.
Playback uses
.BR mpc (1).
.SH ARCHIVE LAYOUT
-In addition to
-.IR all.txt ,
-mcol recognizes these text-list locations beneath the input directory:
+mcol recognizes these dated text-list locations beneath the input directory:
.TP
.I YEAR/MONTH/dailies/YYYY-MM-DD.txt
Daily additions, where MONTH is a full English month name. The historical
only when no daily list exists for that date.
.TP
.I YEAR/MONTH/1_..._....txt through YEAR/MONTH/4_..._....txt
-Weekly lists. Weekly and daily totals are shown side by side and are not
-combined.
+Weekly lists.
.PP
Other text files, including files below directories named
.IR mixes
blob - 346232c998df4635eafb80515b5c8c5a405e7d4a
blob + 48c89f1ba7d2310515cb27fa3f798c06fe4257fd
--- src/mcol/core.sls
+++ src/mcol/core.sls
summarize
normalize-path
days-in-month
- report-ref)
+ report-ref
+ string-prefix?
+ string-suffix?
+ unlabeled-artist-album)
(import (chezscheme))
(define-record-type entry (fields normalized components))
(define-record-type source (fields path kind date period-start period-end entries))
(and year month day (<= 1 month 12) (<= 1 day (days-in-month year month))))
(define (date-string year month day)
(format "~4,'0d-~2,'0d-~2,'0d" year month day))
- (define (date<=? a b)
- (or (string=? a b) (string<? a b)))
(define month-names
'(("january" . 1) ("february" . 2)
("march" . 3)
=>
cdr]
[else #f]))
+ (define unlabeled-artist-album "(artist / album)")
(define (path-join left right)
(cond
[(string=? left "") right]
(substring file 0 (- (string-length file) 4))
file)])
(cond
- [(string=? relative "all.txt") (values 'catalog #f #f #f #f)]
[(or (< (length parts) 2) (string=? (car parts) "mixes")) (values 'ignored #f #f #f #f)]
[else
(let ([year (integer-safe (car parts))])
(define (scan-database root . options)
(unless (file-directory? root)
(error 'scan-database "input is not a directory" root))
- (unless (file-regular? (path-join root "all.txt"))
- (error 'scan-database "input does not contain all.txt" root))
(let ([strict? (and (pair? options) (car options))])
(let loop ([files (sort (lambda (a b) (string<? (cdr a) (cdr b))) (collect-text-files root))]
[sources '()]
[else (loop (cdr remaining) single two (+ three 1))])))))
(define (object . pairs)
pairs)
- (define (field object
- key)
- (cond
- [(assq key object)
- =>
- cdr]
- [else #f]))
+ (define field report-ref)
(define (entry->item item)
(let ([parts (entry-components item)])
(cond
table))
(define (canonical-days canonical)
(map (lambda (date) (file-summary (hashtable-ref canonical date #f))) (sorted-keys canonical)))
+ (define (dated-catalog canonical database)
+ (append (fold-left (lambda (entries date)
+ (append entries
+ (source-entries (hashtable-ref canonical date #f))))
+ '()
+ (sorted-keys canonical))
+ (fold-left (lambda (entries item)
+ (append entries (source-entries item)))
+ '()
+ (sources-of-kind database 'weekly))))
(define (expected-month-days period)
(let ([year (string->number (substring period 0 4))])
(days-in-month year (string->number (substring period 5 7)))))
(hashtable-set! counts (car parts) (+ 1 (hashtable-ref counts (car parts) 0)))]
[(= (length parts) 2)
(hashtable-set! counts
- "(artist / album)"
- (+ 1 (hashtable-ref counts "(artist / album)" 0)))])))
+ unlabeled-artist-album
+ (+ 1 (hashtable-ref counts unlabeled-artist-album 0)))])))
(terminal-entries (source-entries (hashtable-ref canonical date #f)))))
(table-keys canonical))
(sort (lambda (a b)
(map (lambda (item)
(let* ([row (file-summary item)]
[daily-total (fold-left (lambda (sum day)
- (if (and (date<=? (source-period-start item)
+ (if (and (string<=? (source-period-start item)
(field day
'date))
- (date<=? (field day
+ (string<=? (field day
'date)
(source-period-end item)))
(+ sum
(sources-of-kind database 'weekly)))
(define (summarize database)
(let* ([canonical (canonical-sources database)]
- [days (canonical-days canonical)])
- (let* ([catalog-sources (sources-of-kind database 'catalog)]
- [catalog-source (and (pair? catalog-sources) (car catalog-sources))]
- [catalog (if catalog-source
- (source-entries catalog-source)
- '())])
+ [days (canonical-days canonical)]
+ [catalog (dated-catalog canonical database)])
(let-values ([(leaves single two three) (leaf-counts catalog)])
(object (cons 'current
(object (cons 'paths (length (unique-entries catalog)))
(cons 'days days)
(cons 'months (aggregate-months days))
(cons 'weeks (weekly-summary database days))
- (cons 'labels (label-summary canonical))))))))
+ (cons 'labels (label-summary canonical)))))))
blob - 42ac9878c65171a6ebc00b799178faead66c7330
blob + aed87331336bdae87ea7b7e8eafcdc103b6f5a0c
--- src/mcol/tui.sls
+++ src/mcol/tui.sls
(display "[2J")
(display esc)
(display "[H"))
- (define (field object
- key)
- (report-ref object key))
- (define (string-prefix? prefix text)
- (and (<= (string-length prefix) (string-length text))
- (string=? prefix (substring text 0 (string-length prefix)))))
+ (define field report-ref)
(define (fmt number)
(format "~:d" (or number 0)))
(define (string-contains? text query)
[(> (+ at (string-length query)) (string-length text)) #f]
[(string=? query (substring text at (+ at (string-length query)))) #t]
[else (loop (+ at 1))]))))
- (define (string-suffix? suffix text)
- (and (<= (string-length suffix) (string-length text))
- (string=?
- suffix
- (substring text (- (string-length text) (string-length suffix)) (string-length text)))))
(define (trim-newlines text)
(let loop ([end (string-length text)])
(if (and (> end 0) (memv (string-ref text (- end 1)) '(#\newline #\return)))
(define (view-label)
(let* ([matches? (lambda (item)
- (if (string=? value "(artist / album)")
+ (if (string=? value unlabeled-artist-album)
(string=? (field item
'type)
"artist-album")
[(and (string=? verb "artist") (not (string=? argument ""))) (open 'artist argument)]
[(and (string=? verb "release") (not (string=? argument ""))) (open 'release argument)]
[(and (string=? verb "search") (not (string=? argument ""))) (open 'search argument)]
- [else (set! status-message (string-append "unknown command: " input))])))
+ [else (status! (string-append "unknown command: " input) #t)])))
(define (string-index text character)
(let loop ([at 0])
(cond
(let ([count (string->number answer)])
(cond
[(or (not count) (not (integer? count)) (<= count 0))
- (set! status-message "random play expects a positive number")]
+ (status! "random play expects a positive number" #t)]
[(> count (length search-items))
- (set! status-message (format "only ~a releases available" (length search-items)))]
+ (status! (format "only ~a releases available" (length search-items)) #t)]
[else (play-releases (random-releases count))]))]))]
[(string=? verb "p") (batch-release-action "p" arguments play-releases)]
[(string=? verb "q") (batch-release-action "q" arguments queue-releases)]
(let ([needle (get-line (current-input-port))])
(cond
[(eof-object? needle) (set! running? #f)]
- [(string=? needle "") (set! status-message "search query cannot be empty")]
+ [(string=? needle "") (status! "search query cannot be empty" #t)]
[else (open 'search needle)]))]
[(string=? input "nn") (set! page (+ page 1))]
[(string=? input "pp") (set! page (max 0 (- page 1)))]
(<= 1 number (length current-actions))
(row-action (list-ref current-actions (- number 1))))
((row-action (list-ref current-actions (- number 1))))
- (set! status-message "no selectable row with that number")))]
- [else (set! status-message (string-append "unknown input: " input))]))))
+ (status! "no selectable row with that number" #t)))]
+ [else (status! (string-append "unknown input: " input) #t)]))))
(dynamic-wind (lambda ()
(display esc)
blob - a13565512953dcf6c09df4dc49b0a90e039ce9a5
blob + 165a4525ba0b0223d72675436d2236c62af10e0c
--- test/test.ss
+++ test/test.ss
(define (fixture-test)
(let ([root (format "/tmp/mcol-test-~a" (time-nanosecond (current-time)))])
(mkdir-p root)
- (write-lines root "all.txt" '("Label/Artist/Release" "Artist/Album" "Solo"))
(write-lines root
"2026/may/dailies/2026-05-02.txt"
'("Label" "Label/Artist" "Label/Artist/Release/" "Artist" "Artist/Album" "." ""))
(field current
'labelReleases))
"three-part classification")
- (check (= 1
+ (check (= 4
(field current
'artistAlbums))
- "two-part classification")
- (check (= 1
+ "two-part dated records are catalogued")
+ (check (= 0
(field current
'single))
- "single classification")
+ "no undated catalog-only records")
(check (= 3 (length days)) "all dated sources scanned")
(check (string=? "2026-05-20"
(field (cadr days)
(length (field (car days)
'items)))
"day exposes selectable releases")
- (check (= 3
+ (check (= 5
(length (field report
'catalog)))
- "catalog exposes terminal records")
+ "catalog is derived from dated records")
(check (= 2
(field (caddr days)
'additions))
(check (= 29 (days-in-month 2024 2)) "leap year")
(check (= 28 (days-in-month 2025 2)) "common year"))
-(define (repository-test)
- (let ([root (or (getenv "MCOL_INPUT") ".")])
- (when (file-exists? (string-append root "/all.txt"))
- (let* ([report (summarize (scan-database root))]
- [current (field report
- 'current)])
- (check (= 48572
- (field current
- 'paths))
- "repository paths")
- (check (= 7057
- (field current
- 'roots))
- "repository roots")))))
+(define (demo-test)
+ (let* ([report (summarize (scan-database "demo"))]
+ [current (field report 'current)])
+ (check (= 10 (field current 'paths)) "demo paths")
+ (check (= 0 (field current 'roots)) "demo roots")
+ (check (= 2 (field current 'artistAlbums)) "demo artist-albums")
+ (check (= 8 (field current 'labelReleases)) "demo label-releases")
+ (check (= 10 (field current 'terminalAdditions)) "demo terminal additions")
+ (check (= 6 (length (field report 'days))) "demo days")
+ (check (= 3 (length (field report 'months))) "demo months")
+ (check (= 2 (length (field report 'weeks))) "demo weeks")
+ (check (= 9 (length (field report 'labels))) "demo labels")))
(utility-test)
(fixture-test)
-(repository-test)
+(demo-test)
(format #t "mcol: ~a checks passed~%" checks)
