select chickens pasted by C-Keen on Wed Sep 28 12:47:37 2011

#! /bin/csi -s
(use filepath srfi-1 posix)
(define chicken-coop (or (get-environment-variable "CHICKENS") "~/chickens"))
(define chicken-link "use_this")

(define (available-chickens path)
  (assert (directory? path))
  (filter (lambda (p) (not (equal? chicken-link p)))
          (directory path)))

(define (current-chicken path link)
  (let ((p (filepath:join-path (list path link))))
    (and (symbolic-link? p)
         (read-symbolic-link p))))

(define (set-current-chicken chicken link)
  (let ((symlink (filepath:join-path (list chicken-coop link))))
    (delete-file symlink)
    (create-symbolic-link chicken symlink)))

(let* ((all-chicks (available-chickens chicken-coop))
      (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
          (print "Select a new chicken, press 'q' to abort:")
          (for-each (lambda (c n)
                       (printf "~a ~a: ~a~%"
                               (if (equal? n current) "*" " ")
                               n c))
                    all-chicks
                    (iota (length all-chicks)))
          (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)))))))

select chickens without filepath egg added by C-Keen on Wed Sep 28 13:00:20 2011

#! /bin/csi -s
(use srfi-1 posix)
(define chicken-coop (or (get-environment-variable "CHICKENS") "~/chickens"))
(define chicken-link "use_this")

(define (available-chickens path)
  (assert (directory? path))
  (filter (lambda (p) (not (equal? chicken-link p)))
          (directory path)))

(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)))
    (delete-file symlink)
    (create-symbolic-link chicken symlink)))

(let* ((all-chicks (available-chickens chicken-coop))
      (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
          (print "Select a new chicken, press 'q' to abort:")
          (for-each (lambda (c n)
                       (printf "~a ~a: ~a~%"
                               (if (equal? n current) "*" " ")
                               n c))
                    all-chicks
                    (iota (length all-chicks)))
          (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)))))))