diff --git a/brmsaptool.scm b/brmsaptool.scm index 40dfc7b..c7fe709 100644 --- a/brmsaptool.scm +++ b/brmsaptool.scm @@ -30,7 +30,7 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Static default configuration -(define *members-directory* "members") +(define *members-directory* (make-parameter "members")) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Testing @@ -110,19 +110,37 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Members index -(define (load-members-raw-index . dn) - (let ((dn (if (null? dn) *members-directory* (car dn)))) - (let loop ((fns (directory dn)) - (rs '())) - (if (null? fns) - rs - (let* ((fn (car fns)) - (ffn (make-pathname dn fn)) - (sl (if (symbolic-link? ffn) (read-symbolic-link ffn) #f))) - (loop (cdr fns) - (if sl - (cons (cons fn sl) rs) - rs))))))) +(define (load-members-raw-index) + (let loop ((fns (directory (*members-directory*))) + (rs '())) + (if (null? fns) + rs + (let* ((fn (car fns)) + (ffn (make-pathname (*members-directory*) fn)) + (sl (if (symbolic-link? ffn) (read-symbolic-link ffn) #f))) + (loop (cdr fns) + (if sl + (cons (cons fn sl) rs) + rs)))))) + +(define (members-expand-raw-index ri) + (let loop ((ri ri) + (ds '())) + (if (null? ri) + ds + (let* ((mp (car ri)) + (lnk (car mp)) + (dfn (cdr mp)) + (lnkn (string->number lnk)) + (dfnn (string->number dfn)) + (id (or dfnn lnkn)) + (name (if lnkn dfn lnk))) + (loop (cdr ri) + (cons (list (cons 'id id) + (cons 'name name) + (cons 'file dfn)) + ds)))))) + ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; Run everything @@ -138,4 +156,4 @@ (newline) ;; Perform requested action -(print (load-members-raw-index)) +(print (members-expand-raw-index (load-members-raw-index)))