Implement loading raw members index.

This commit is contained in:
Dominik Pantůček 2023-03-10 22:43:53 +01:00
parent 325aca8454
commit 603ffa53bb

View file

@ -21,9 +21,16 @@
;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE. ;; CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
;; ;;
(import (chicken condition) (import (chicken condition)
(chicken process-context)
(chicken file) (chicken file)
(chicken file posix)) (chicken pathname)
(chicken file posix)
(chicken process-context))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Static default configuration
(define *members-directory* "members")
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Testing ;; Testing
@ -101,15 +108,21 @@
(print " ok.")) (print " ok."))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Members index
(define *members-directory* "members") (define (load-members-raw-index . dn)
(let ((dn (if (null? dn) *members-directory* (car dn))))
(define (displayln . x) (let loop ((fns (directory dn))
(apply display x) (rs '()))
(newline)) (if (null? fns)
rs
(define (load-members) (let* ((fn (car fns))
(directory *members-directory*)) (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)))))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Run everything ;; Run everything
@ -125,4 +138,4 @@
(newline) (newline)
;; Perform requested action ;; Perform requested action
(displayln (load-members)) (print (load-members-raw-index))