path-equal? built
This commit is contained in:
@@ -426,7 +426,7 @@
|
||||
(set! nr (+ nr 1))
|
||||
(list (format "row-~a" nr) (build-path current-music-path e) (format "path-~a" nr)))
|
||||
(directory-list current-music-path)))))
|
||||
(unless (equal? (format "~a" current-music-path) (format "~a" music-library))
|
||||
(unless (path-equal? current-music-path music-library)
|
||||
(set! l (cons (list "lib-up" "↰" "lib-up") l))
|
||||
)
|
||||
(let ((html (mktable l 'music-library library-formatter)))
|
||||
|
||||
@@ -20,6 +20,7 @@
|
||||
fatal-rktplayer
|
||||
(all-from-out simple-log)
|
||||
list-drop!
|
||||
path-equal?
|
||||
)
|
||||
|
||||
|
||||
@@ -117,3 +118,22 @@
|
||||
(call-with-values (λ () (split-path file))
|
||||
(λ (dir file d) dir))
|
||||
file)))
|
||||
|
||||
(define (path-equal? p1 p2)
|
||||
(let ((p1* (build-path p1))
|
||||
(p2* (build-path p2))
|
||||
)
|
||||
(let ((e1 (explode-path (normal-case-path p1)))
|
||||
(e2 (explode-path (normal-case-path p2))))
|
||||
(if (= (length e1) (length e2))
|
||||
(letrec ((f (λ (l1 l2)
|
||||
(if (null? l1)
|
||||
#t
|
||||
(if (string=? (format "~a" (car l1)) (format "~a" (car l2)))
|
||||
(f (cdr l1) (cdr l2))
|
||||
#f)))))
|
||||
(f e1 e2))
|
||||
#f)
|
||||
)
|
||||
)
|
||||
)
|
||||
Reference in New Issue
Block a user