Skip to content
This repository

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
branch: master
Fetching contributors…

Octocat-spinner-32-eaf2f5

Cannot retrieve contributors at this time

file 64 lines (54 sloc) 1.659 kb
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63
;; io.lsp --- Input/Output functions for newLISP

;; http://en.wikipedia.org/wiki/Standard_streams
(setq stdin 0 stdout 1 stderr 2)
#include <stdio.h>
(define STDIN_FILENO 0)
(define STDOUT_FILENO 1)
(define STDERR_FILENO 2)

(define (open! )
  (or (apply open (args))
      (throw-error (list (args) (sys-error)))))

;; call-with-{input,output}-file @scheme
(define (with-file-handler filename proc (mode "r"))
  (let ((fd (open! (namestring filename) mode)))
    (unwind-protect
        (proc fd)
      (close fd))))

(define (with-output-file filename proc) (with-file-handler filename proc "w"))
(define (with-input-file filename proc) (with-file-handler filename proc "r"))

(define (echo (in stdin) (out stdout))
  (let ((buf "")
        (len 0))
    (cond
      ;; socket?
      ((and (integer? in) (net-local in))
       (setq len (net-peek in))
       (when (!= len 0)
         (net-receive in buf len)
         (write-line out buf)))
      (true
       ;; (while (read-line in) (write-line out))
       (while (read in buf 0x1000) ; or (peek in)
         (write out buf)
         (++ len (length buf)))))
    (if (string? out)
        out
        len)))
;; (echo stdin "") => [make strings from input]

;; == (define cat (lambda (file) (print (read-file file))))
(define (cat filename)
  (with-input-file filename echo))

(define (tee filename buffer)
  "Write BUFFER contents to standard-output and FILENAME."
  (append-file filename buffer)
  (print buffer))

(unless peek
;; for Win32
(define (peek fd)
  (or (net-peek fd)
      (let ((ptr (seek fd)))
        (when ptr
          (- (seek fd -1) (seek fd ptr))))))
)

(context MAIN)
;;; EOF
Something went wrong with that request. Please try again.