s

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)))
+         ;; Laatste .ext apart houden.
-                (if (or (< (char->integer ch) 32)
+         ;; Bewust eenvoudig: .flac, .opus, .jpg, .pdf, enz.
-                        (memq ch '(#\< #\> #\: #\" #\/ #\\ #\| #\? #\*)))
+         ;; Namen als "Gypsy Festival vol. 2" matchen niet als extensie,
-                    #\-
+         ;; want daar zit een spatie na de punt.
-                    ch))))
+         (m (regexp-match #px"^(.*)(\\.[A-Za-z0-9][A-Za-z0-9_-]{0,15})$" s0))
-         (s2 (regexp-replace* #px"\\s+" s1 " "))
+         (stem0 (if m (list-ref m 1) s0))
-         (s3 (regexp-replace* #px"[- ]+" s2 " "))
+         (ext (if m (list-ref m 2) ""))
-         (s4 (string-trim s3 " .-_"))
+
-         (device-name (let* ((parts (string-split s4 "."))
+         ;; Ongeldige OS-tekens vervangen door '-'.
-                             (first-part (if (null? parts) s4 (car parts))))
+         (stem1 (list->string
-                        first-part))
+                 (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))
+                     stem3))
-         (s5 (cond
+
-               ((string=? s4 "") "_")
+         (stem4 (cond
-               (reserved? (string-append "_" s4))
+                  ((string=? stem3 "") "_")
-               (else s4))))
+                  (reserved? (string-append "_" stem3))
-    s5))
+                  (else stem3))))
+    (string-append stem4 ext)))