Welcome to the CHICKEN Scheme pasting service

thread-aware FD ports pasted by DerGuteMoritz on Wed Oct 24 20:56:39 2012

(define (open-input-fd fd)
  (make-input-port
   (lambda ()
     (thread-wait-for-i/o! fd #:input)
     (string-ref (car (file-read fd 1)) 0))
   (lambda ()
     (nth-value 0 (file-select fd #f 0)))
   (lambda ()
     (file-close fd))))

(define (open-output-fd fd)
  (let ((port (open-output-file* fd)))
    (make-output-port
     (lambda (buffer)
       (let loop ((buffer buffer) (len (string-length buffer)))
         (thread-wait-for-i/o! fd #:output)
         (let ((written (file-write fd buffer)))
           (unless (= written len)
             (loop (substring written len) (- len written))))))
     (lambda ()
       (close-output-port port))
     (lambda ()
       (flush-output port)))))

fixed open-file-fd pasted by DerGuteMoritz on Wed Oct 24 21:00:45 2012

(define (open-output-fd fd)
  (let ((port (open-output-file* fd)))
    (make-output-port
     (lambda (buffer)
       (let loop ((buffer buffer) (len (string-length buffer)))
         (thread-wait-for-i/o! fd #:output)
         (let ((written (file-write fd buffer)))
           (unless (= written len)
             (loop (substring buffer written len) (- len written))))))
     (lambda ()
       (close-output-port port))
     (lambda ()
       (flush-output port)))))

open-output-fd with error handling pasted by DerGuteMoritz on Wed Oct 24 21:18:55 2012

(define (open-output-fd fd)
  (let ((port (open-output-file* fd)))
    (make-output-port
     (lambda (buffer)
       (let loop ((buffer buffer) (len (string-length buffer)))
         (thread-wait-for-i/o! fd #:output)
         (let ((written (file-write fd buffer)))
           (if (negative? written)
               (case (errno)
                 ((errno/intr errno/again)
                  (loop buffer len))
                 (else (error "Error writing to fd" fd (errno))))
               (unless (= written len)
                 (loop (substring buffer written len) (- len written)))))))
     (lambda ()
       (close-output-port port))
     (lambda ()
       (flush-output port)))))

possibly really handling errors this time pasted by DerGuteMoritz on Wed Oct 24 21:27:21 2012

(define (open-output-fd fd)
  (let ((port (open-output-file* fd)))
    (make-output-port
     (lambda (buffer)
       (let loop ((buffer buffer) (len (string-length buffer)))
         (thread-wait-for-i/o! fd #:output)
         (let ((written (file-write fd buffer)))
           (if (negative? written)
               (select (errno)
                 ((errno/intr errno/again)
                  (loop buffer len))
                 (else (error "Error writing to fd" fd (errno))))
               (unless (= written len)
                 (loop (substring buffer written len) (- len written)))))))
     (lambda ()
       (close-output-port port))
     (lambda ()
       (flush-output port)))))

it's starting to turn into a monster added by DerGuteMoritz on Wed Oct 24 22:38:13 2012

(define (open-input-fd fd)
  (make-input-port
   (lambda ()
     (let loop ()
       (thread-wait-for-i/o! fd #:input)
       (or (condition-case
               (string-ref (car (file-read fd 1)) 0)
             (exn (exn i/o file)
                  (select (errno)
                    ((errno/intr errno/again errno/wouldblock)
                     #f)
                    (else (signal exn)))))
           (loop buffer len))))
   (lambda ()
     (nth-value 0 (file-select fd #f 0)))
   (lambda ()
     (file-close fd))))

(define (open-output-fd fd)
  (let ((port (open-output-file* fd)))
    (make-output-port
     (lambda (buffer)
       (let loop ((buffer buffer) (len (string-length buffer)))
         (thread-wait-for-i/o! fd #:output)
         (let ((written (condition-case
                            (file-write fd buffer)
                          (exn (exn i/o file)
                               (select (errno)
                                 ((errno/intr errno/again errno/wouldblock)
                                  #f)
                                 (else (signal exn)))))))
           (if written
               (unless (= written len)
                 (loop (substring buffer written len) (- len written)))
               (loop buffer len)))))
     (lambda ()
       (close-output-port port))
     (lambda ()
       (flush-output port)))))

Your annotation:

Enter a new annotation:

Your nick:
The title of your paste:
Your paste (mandatory) :
What does `(string-chomp "foobar")' produce?
Visually impaired? Let me spell it for you (wav file) download WAV