diff --git a/private/file-walker.rkt b/private/file-walker.rkt index 2c6a566..a06184f 100644 --- a/private/file-walker.rkt +++ b/private/file-walker.rkt @@ -222,23 +222,39 @@ (define (clean-os-basename name) (let* ((s0 (format "~a" name)) - (s1 (list->string - (for/list ((ch (in-string s0))) - (if (or (< (char->integer ch) 32) - (memq ch '(#\< #\> #\: #\" #\/ #\\ #\| #\? #\*))) - #\- - ch)))) - (s2 (regexp-replace* #px"\\s+" s1 " ")) - (s3 (regexp-replace* #px"[- ]+" s2 " ")) - (s4 (string-trim s3 " .-_")) - (device-name (let* ((parts (string-split s4 ".")) - (first-part (if (null? parts) s4 (car parts)))) - first-part)) + + ;; Laatste .ext apart houden. + ;; Bewust eenvoudig: .flac, .opus, .jpg, .pdf, enz. + ;; Namen als "Gypsy Festival vol. 2" matchen niet als extensie, + ;; want daar zit een spatie na de punt. + (m (regexp-match #px"^(.*)(\\.[A-Za-z0-9][A-Za-z0-9_-]{0,15})$" s0)) + (stem0 (if m (list-ref m 1) s0)) + (ext (if m (list-ref m 2) "")) + + ;; Ongeldige OS-tekens vervangen door '-'. + (stem1 (list->string + (for/list ((ch (in-string stem0))) + (if (or (< (char->integer ch) 32) + (memq ch '(#\< #\> #\: #\" #\/ #\\ #\| #\? #\*))) + #\- + ch)))) + + ;; Whitespace normaliseren. + (stem2 (regexp-replace* #px"\\s+" stem1 " ")) + + ;; Alleen de stem trimmen. + ;; Spatie/punt zijn Windows-probleem aan het einde. + ;; '-' trimmen we hier ook zodat foo:bar?.opus -> foo-bar.opus. + (stem3 (string-trim stem2 " .-")) + + ;; Windows reserved device names gelden ook met extensie, + ;; dus CON.flac blijft probleem als stem CON is. (reserved? (regexp-match? #px"(?i:^(con|prn|aux|nul|com[1-9]|lpt[1-9])$)" - device-name)) - (s5 (cond - ((string=? s4 "") "_") - (reserved? (string-append "_" s4)) - (else s4)))) - s5)) \ No newline at end of file + stem3)) + + (stem4 (cond + ((string=? stem3 "") "_") + (reserved? (string-append "_" stem3)) + (else stem3)))) + (string-append stem4 ext))) \ No newline at end of file