Load and expand raw members index.

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)
+(define (load-members-raw-index)
-  (let ((dn (if (null? dn) *members-directory* (car dn))))
+  (let loop ((fns (directory (*members-directory*)))
-    (let loop ((fns (directory dn))
+	     (rs '()))
-	       (rs '()))
+    (if (null? fns)
-      (if (null? fns)
+	rs
-	  rs
+	(let* ((fn (car fns))
-	  (let* ((fn (car fns))
+	       (ffn (make-pathname (*members-directory*) fn))
-		 (ffn (make-pathname dn fn))
+	       (sl (if (symbolic-link? ffn) (read-symbolic-link ffn) #f)))
-		 (sl (if (symbolic-link? ffn) (read-symbolic-link ffn) #f)))
+	  (loop (cdr fns)
-	    (loop (cdr fns)
+		(if sl
-		  (if sl
+		    (cons (cons fn sl) rs)
-		      (cons (cons fn sl) rs)
+		    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)))