Welcome to the CHICKEN Scheme pasting service
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)))))))