#!/usr/bin/csi -s (use srfi-1 posix) (include "chicken-env") (assert-chicken-coop-exists) (define (available-chickens) (filter (lambda (p) (not (equal? chicken-link p))) (directory chicken-coop))) (define (current-chicken path link) (let ((p (make-pathname path link))) (and (symbolic-link? p) (read-symbolic-link p)))) (define (set-current-chicken chicken link) (let ((symlink (make-pathname chicken-coop link))) (when (file-exists? symlink) (delete-file symlink)) (create-symbolic-link chicken symlink))) (let* ((all-chicks (available-chickens)) (current (list-index (cut equal? (current-chicken chicken-coop chicken-link) <>) all-chicks))) (let select ((abort #f)) (if (equal? abort #\q) (begin (print "Aborted.") (exit 0)) (begin (for-each (lambda (c n) (printf "~a ~a: ~a~%" (if (equal? n current) "*" " ") n c)) all-chicks (iota (length all-chicks))) (newline) (print "Select a new Chicken, press 'q' to abort:") (let* ((choice-raw (read-char)) (num (string->number (string choice-raw)))) (if (and num (<= 0 num) (< num (length all-chicks))) (begin (print "Setting current Chicken to " (list-ref all-chicks num)) (set-current-chicken (list-ref all-chicks num) chicken-link)) (select choice-raw)))))))