;*=====================================================================*/
;*    serrano/prgm/project/bigloo/runtime/Ieee/port.scm                */
;*    -------------------------------------------------------------    */
;*    Author      :  Manuel Serrano                                    */
;*    Creation    :  Mon Feb 20 16:53:27 1995                          */
;*    Last change :  Tue May 13 18:24:26 2003 (serrano)                */
;*    -------------------------------------------------------------    */
;*    6.10.1 Ports (page 29, r4)                                       */
;*    -------------------------------------------------------------    */
;*    Source documentation:                                            */
;*       @path ../../manuals/body.texi@                                */
;*       @node Input And Output@                                       */
;*=====================================================================*/

;*---------------------------------------------------------------------*/
;*    Le module                                                        */
;*---------------------------------------------------------------------*/
(module __r4_ports_6_10_1
   
   (import  __error)
   
   (use     __type
	    __bigloo
	    __tvector
	    __bexit
	    __socket
	    __os
	    __r4_vectors_6_8
	    __r4_strings_6_7
	    __r4_characters_6_6
	    __r4_control_features_6_9
	    __r4_numbers_6_5_fixnum
	    __r4_numbers_6_5_flonum
	    __r4_equivalence_6_2
	    __r4_booleans_6_1
	    __r4_symbols_6_4
	    __r4_pairs_and_lists_6_3
	    __r4_output_6_10_3
	    
	    __evenv)
   
   (extern  (macro c-input-port?::bool  (::obj)
		   "INPUT_PORTP")
	    (macro c-input-string-port?::bool  (::obj)
		   "INPUT_STRING_PORTP")
	    (macro c-input-procedure-port?::bool (::obj)
		   "INPUT_PROCEDURE_PORTP")
	    (macro c-output-port?::bool (::obj)
		   "OUTPUT_PORTP")
	    (macro c-output-string-port?::bool (::obj)
		   "OUTPUT_STRING_PORTP")
	    
	    (macro c-current-output-port::output-port ()
		   "BGL_CURRENT_OUTPUT_PORT")
	    (macro c-current-error-port::output-port ()
		   "BGL_CURRENT_ERROR_PORT")
	    (macro c-current-input-port::input-port ()
		   "BGL_CURRENT_INPUT_PORT")
	    
	    (macro c-current-output-port-set!::void (::output-port)
		   "BGL_CURRENT_OUTPUT_PORT_SET")
	    (macro c-current-error-port-set!::void (::output-port)
		   "BGL_CURRENT_ERROR_PORT_SET")
	    (macro c-current-input-port-set!::void (::input-port)
		   "BGL_CURRENT_INPUT_PORT_SET")
	    
	    (c-open-input-file::obj (::bstring ::obj) "open_input_file")
	    (c-open-input-pipe::obj (::bstring ::obj) "open_input_pipe")
 	    (c-open-input-c-string::obj (::string) "open_input_c_string")
	    (c-reopen-input-c-string::obj (::input-port ::string) "reopen_input_c_string")
	    (c-open-input-string::obj (::bstring) "open_input_string")
	    (c-open-input-procedure::obj (::procedure) "open_input_procedure")
	    (c-open-output-file::obj (::bstring) "open_output_file")
	    (c-append-output-file::obj (::bstring) "append_output_file")
	    (c-open-output-string::obj () "open_output_string")
	    (c-close-input-port::obj (::obj) "close_input_port")
	    (c-input-port-reopen!::obj (::input-port) "bgl_input_port_reopen")
	    (c-set-input-port-position!::obj (::input-port ::int) "bgl_input_port_seek")
	    (macro c-input-port-position::int (::input-port)
		   "INPUT_PORT_FILEPOS")
	    (macro c-input-port-bufsiz::int (::input-port)
		   "INPUT_PORT_BUFSIZ")

	    (macro c-output-port-position::int (::output-port)
		   "BGL_OUTPUT_PORT_FILEPOS")
	    (c-set-output-port-position!::obj (::output-port ::int) "bgl_output_port_seek")
	    
	    (macro c-closed-input-port?::bool (::obj)
		   "!RGC_BUFFER")
	    (c-close-output-port::obj (::obj) "close_output_port")
	    (c-get-output-string::bstring (::output-port)"get_output_string")
	    (c-default-io-bufsiz::int "default_io_bufsiz")
	    (c-reset-eof::bool (::obj) "reset_eof")
	    (macro c-flush-output-port::obj (::output-port)
		   "FLUSH_OUTPUT_PORT")
	    
	    (c-fexists?::bool (::string) "fexists")
	    (macro c-delete-file::bool (::string) "unlink")
	    (macro c-delete-directory::bool  (::string) "rmdir")
	    (macro c-rename-file::int (::string ::string) "rename")
	    (macro c-mkdir::bool (::string ::int) "!mkdir")
	    
 	    (macro c-input-port-name::string (::input-port) "INPUT_PORT_NAME")
	    
	    (__directory?::bool (::string) "directoryp")
	    (__directory->list::obj (::string) "directory_to_list")
	    (c-modification-time::elong (::string) "bgl_last_modification_time")
	    (c-file-size::int (::string) "bgl_file_size"))
   
   (java    (class foreign
	       (method static c-input-port?::bool  (::obj)
		       "INPUT_PORTP")
	       (method static c-input-string-port?::bool  (::obj)
		       "INPUT_STRING_PORTP")
	       (method static c-input-procedure-port?::bool (::obj)
		       "INPUT_PROCEDURE_PORTP")
	       (method static c-output-port?::bool (::obj)
		       "OUTPUT_PORTP")
	       (method static c-output-string-port?::bool (::obj)
		       "OUTPUT_STRING_PORTP")
	       
	       (field static c-default-io-bufsiz::int
		      "default_io_bufsiz")
	       
	       (method static c-current-output-port::output-port ()
		       "getCurrentOutputPort")
	       (method static c-current-error-port::output-port ()
		       "getCurrentErrorPort")
	       (method static c-current-input-port::input-port ()
		       "getCurrentInputPort")
	       (method static c-current-output-port-set!::void (::output-port)
		       "setCurrentOutputPort")
	       (method static c-current-error-port-set!::void (::output-port)
		       "setCurrentErrorPort")
	       (method static c-current-input-port-set!::void (::input-port)
		       "setCurrentInputPort")
   
	       (method static c-open-input-file::obj (::bstring ::bint)
		       "open_input_file")
	       (method static c-open-input-pipe::obj (::bstring ::bint)
		       "open_input_pipe")
	       (method static c-open-input-c-string::obj (::string)
		       "open_input_c_string")
	       (method static c-reopen-input-c-string::obj (::input-port ::string)
		       "reopen_input_c_string")
	       (method static c-open-input-string::obj (::bstring)
		       "open_input_string")
	       (method static c-open-input-procedure::obj (::procedure)
		       "open_input_procedure")
	       (method static c-open-output-file::obj (::bstring)
		       "open_output_file")
	       (method static c-append-output-file::obj (::bstring)
		       "append_output_file")
	       (method static c-open-output-string::obj ()
		       "open_output_string")
	       (method static c-close-input-port::obj (::input-port)
		       "close_input_port")
	       (method static c-input-port-reopen!::obj (::input-port)
		       "bgl_input_port_reopen")
	       (method static c-set-input-port-position!::obj (::input-port ::int)
		       "bgl_input_port_seek")
	       (method static c-set-output-port-position!::obj (::output-port ::int)
		       "bgl_output_port_seek")
	       (method static c-input-port-bufsiz::int (::input-port)
		       "bgl_input_port_bufsiz")
	       
	       (method static c-closed-input-port?::bool (::input-port)
		       "CLOSED_RGC_BUFFER")
	       (method static c-close-output-port::obj (::output-port)
		       "close_output_port")
	       (method static c-get-output-string::bstring (::output-port)
		       "get_output_string")
	       (method static c-reset-eof::bool (::obj)
		       "reset_eof")
	       (method static c-flush-output-port::obj (::output-port)
		       "FLUSH_OUTPUT_PORT")
	       
	       (method static c-fexists?::bool (::string)
		       "fexists")
	       (method static c-delete-file::bool (::string)
		       "unlink")
	       (method static c-delete-directory::bool  (::string)
		       "rmdir")
	       (method static c-rename-file::int (::string ::string)
		       "rename")
	       (method static c-mkdir::bool (::string ::int)
		       "mkdir")
	       
	       (method static c-output-port-position::int (::output-port)
		       "OUTPUT_PORT_FILEPOS")
	       (method static c-input-port-position::int (::input-port)
		       "INPUT_PORT_FILEPOS")
	       (method static c-input-port-name::string (::input-port)
		       "INPUT_PORT_NAME")
	       
	       (method static __directory?::bool (::string)
		       "directoryp")
	       (method static __directory->list::obj (::string)
		       "directory_to_list")
	       (method static c-modification-time::elong (::string)
		       "bgl_last_modification_time")
	       (method static c-file-size::int (::string)
		       "bgl_file_size")))
	    
   (export  (call-with-input-file ::bstring ::procedure)
	    (call-with-output-file ::bstring ::procedure)
	    
	    (inline input-port? ::obj)
	    (inline input-string-port? ::obj)
	    (inline input-procedure-port? ::obj)
	    (inline output-port? ::obj)
	    (inline port?::bool ::obj)
	    (inline output-string-port? ::obj)
	    
	    (inline current-input-port::input-port) 
	    (inline current-error-port::output-port)
	    (inline current-output-port::output-port)
	    
	    (with-input-from-file ::bstring ::procedure)
	    (with-input-from-string ::bstring ::procedure)
	    (with-input-from-port ::input-port ::procedure)
	    (with-input-from-procedure ::procedure ::procedure)
	    (with-output-to-file ::bstring ::procedure)
	    (with-output-to-string ::procedure)
	    (with-error-to-string ::procedure)
	    (with-output-to-port ::output-port ::procedure)
	    
	    (with-error-to-file ::bstring ::procedure)
	    (with-error-to-port ::output-port ::procedure)
	    
	    (open-input-file ::bstring . bufsiz)
	    (inline open-input-string ::bstring)
	    (inline open-input-procedure ::procedure)
	    (inline open-input-c-string ::string)
	    (inline reopen-input-c-string ::input-port ::string)
	    (inline open-output-file ::bstring)
	    (inline append-output-file ::bstring)
	    (inline open-output-string)
	    (inline closed-input-port?::bool ::input-port)
	    (inline close-input-port ::input-port)
	    (inline get-output-string::bstring ::output-port)
	    (inline close-output-port ::output-port)
	    (inline flush-output-port ::output-port)
	    (inline reset-eof::bool ::input-port)
	    (inline output-port-position::int ::output-port)
	    (inline set-output-port-position! ::output-port ::int)
	    (inline set-input-port-position! ::input-port ::int)
	    (inline input-port-position::int ::input-port)
	    (inline input-port-reopen! ::input-port)
	    (inline input-port-name::string ::input-port)
	    
	    (inline file-exists?::bool ::string)
	    (inline delete-file ::string)
	    (inline make-directory::bool ::string)
	    (make-directories::bool ::bstring)
	    (inline delete-directory ::string)
	    (inline rename-file ::string ::string)
	    (inline directory?::bool ::string)
	    (inline directory->list ::string)
	    (file-modification-time::elong ::string)
	    (file-size::int ::string))
   
   (pragma  (c-input-port? (predicate-of input-port) nesting)
	    (c-output-port? (predicate-of output-port) nesting)
	    (c-output-string-port? nesting)
	    (c-input-string-port? nesting)
	    (file-exists? side-effect-free nesting)))
   

;*---------------------------------------------------------------------*/
;*    call-with-input-file ...                                         */
;*---------------------------------------------------------------------*/
(define (call-with-input-file string proc)
   (let ((port (open-input-file string)))
      (if (input-port? port)
	  (let ((res (proc port)))
	     (close-input-port port)
	     res)
	  (error "call-with-input-file" "can't open file" string))))

;*---------------------------------------------------------------------*/
;*    call-with-output-file ...                                        */
;*---------------------------------------------------------------------*/
(define (call-with-output-file string proc) 
   (let ((port (open-output-file string)))
      (if (output-port? port)
	  (let ((res (proc port)))
	     (close-output-port port)
	     res)
	  (error "call-with-output-file" "can't open file" string))))

;*---------------------------------------------------------------------*/
;*    input-port? ...                                                  */
;*---------------------------------------------------------------------*/
(define-inline (input-port? obj)
   (c-input-port? obj))

;*---------------------------------------------------------------------*/
;*    input-string-port? ...                                           */
;*---------------------------------------------------------------------*/
(define-inline (input-string-port? obj)
   (c-input-string-port? obj))

;*---------------------------------------------------------------------*/
;*    input-procedure-port? ...                                        */
;*---------------------------------------------------------------------*/
(define-inline (input-procedure-port? obj)
   (c-input-procedure-port? obj))

;*---------------------------------------------------------------------*/
;*    output-port? ...                                                 */
;*---------------------------------------------------------------------*/
(define-inline (output-port? obj)
   (c-output-port? obj))

;*---------------------------------------------------------------------*/
;*    output-string-port? ...                                          */
;*---------------------------------------------------------------------*/
(define-inline (output-string-port? obj)
   (c-output-string-port? obj))

;*---------------------------------------------------------------------*/
;*    current-input-port ...                                           */
;*---------------------------------------------------------------------*/
(define-inline (current-input-port)
   (c-current-input-port))

;*---------------------------------------------------------------------*/
;*    current-output-port ...                                          */
;*---------------------------------------------------------------------*/
(define-inline (current-output-port)
   (c-current-output-port))

;*---------------------------------------------------------------------*/
;*    current-error-port ...                                           */
;*---------------------------------------------------------------------*/
(define-inline (current-error-port)
   (c-current-error-port))

;*---------------------------------------------------------------------*/
;*    @deffn input-port-reopen!@ ...                                   */
;*---------------------------------------------------------------------*/
(define-inline (input-port-reopen! port::input-port)
   (if (not (c-input-port-reopen! port))
       (error "input-port-reopen!" "Can't reopen port" port)))

;*---------------------------------------------------------------------*/
;*    @deffn with-input-from-file@ ...                                 */
;*---------------------------------------------------------------------*/
(define (with-input-from-file string thunk)
   (let ((port (open-input-file string)))
      (if (input-port? port)
	  (let ((old-input-port (current-input-port)))
	     (unwind-protect
		(begin
		   (c-current-input-port-set! port)
		   (thunk))
		(begin
		   (c-current-input-port-set! old-input-port)
		   (close-input-port port))))
	  (error "with-input-from-file" "can't open file" string))))

;*---------------------------------------------------------------------*/
;*    @deffn with-input-from-string@ ...                               */
;*---------------------------------------------------------------------*/
(define (with-input-from-string string thunk)
   (let ((port (open-input-string string)))
      (if (input-port? port)
	  (let ((old-input-port (current-input-port)))
	     (unwind-protect
		(begin
		   (c-current-input-port-set! port)
		   (thunk))
		(begin
		   (c-current-input-port-set! old-input-port)
		   (close-input-port port))))
	  (error "with-input-from-string" "can't open string" string))))

;*---------------------------------------------------------------------*/
;*    with-input-from-port ...                                         */
;*---------------------------------------------------------------------*/
(define (with-input-from-port port thunk)
   (let ((old-input-port (current-input-port)))
      (unwind-protect
	 (begin
	    (c-current-input-port-set! port)
	    (thunk))
	 (c-current-input-port-set! old-input-port))))

;*---------------------------------------------------------------------*/
;*    @deffn with-input-from-procedure@ ...                            */
;*---------------------------------------------------------------------*/
(define (with-input-from-procedure proc thunk)
   (let ((port (open-input-procedure proc)))
      (if (input-port? port)
	  (let ((old-input-port (current-input-port)))
	     (unwind-protect
		(begin
		   (c-current-input-port-set! port)
		   (thunk))
		(begin
		   (c-current-input-port-set! old-input-port)
		   (close-input-port port))))
	  (error "with-input-from-procedure" "can't open procedure" proc))))

;*---------------------------------------------------------------------*/
;*    with-output-to-file ...                                          */
;*---------------------------------------------------------------------*/
(define (with-output-to-file string thunk)
   (let ((port (open-output-file string)))
      (if (output-port? port)
	  (let ((old-output-port (current-output-port)))
	     (unwind-protect
		(begin
		   (c-current-output-port-set! port)
		   (thunk))
		(begin
		   (c-current-output-port-set! old-output-port)
		   (close-output-port port))))
	  (error "with-output-to-file" "can't open file" string))))

;*---------------------------------------------------------------------*/
;*    @deffn with-output-to-port@ ...                                  */
;*---------------------------------------------------------------------*/
(define (with-output-to-port port thunk)
   (let ((old-output-port (current-output-port)))
      (unwind-protect
	 (begin
	    (c-current-output-port-set! port)
	    (thunk))
	 (c-current-output-port-set! old-output-port))))

;*---------------------------------------------------------------------*/
;*    @deffn with-output-to-string@ ...                                */
;*---------------------------------------------------------------------*/
(define (with-output-to-string thunk)
   (let ((port (open-output-string)))
      (if (output-port? port)
	  (let ((old-output-port (current-output-port))
		(res #unspecified))
	     (unwind-protect
		(begin
		   (c-current-output-port-set! port)
		   (thunk))
		(begin
		   (c-current-output-port-set! old-output-port)
		   (set! res (close-output-port port))))
	     res)
	  (error "with-output-to-string" "can't open string" #unspecified))))

;*---------------------------------------------------------------------*/
;*    @deffn with-error-to-string@ ...                                 */
;*---------------------------------------------------------------------*/
(define (with-error-to-string thunk)
   (let ((port (open-output-string)))
      (if (output-port? port)
	  (let ((old-error-port (current-error-port))
		(res #unspecified))
	     (unwind-protect
		(begin
		   (c-current-error-port-set! port)
		   (thunk))
		(begin
		   (c-current-error-port-set! old-error-port)
		   (set! res (close-output-port port))))
	     res)
	  (error "with-error-to-string" "can't open string" #unspecified))))

;*---------------------------------------------------------------------*/
;*    @deffn with-error-to-file@ ...                                   */
;*---------------------------------------------------------------------*/
(define (with-error-to-file string thunk)
   (let ((port (open-output-file string)))
      (if (output-port? port)
	  (let ((old-output-port (current-error-port)))
	     (unwind-protect
		(begin
		   (c-current-error-port-set! port)
		   (thunk))
		(begin
		   (c-current-error-port-set! old-output-port)
		   (close-output-port port))))
	  (error "with-error-to-file" "can't open file" string))))

;*---------------------------------------------------------------------*/
;*    with-error-to-port ...                                           */
;*---------------------------------------------------------------------*/
(define (with-error-to-port port thunk)
   (let ((old-output-port (current-error-port)))
      (unwind-protect
	 (begin
	    (c-current-error-port-set! port)
	    (thunk))
	 (c-current-error-port-set! old-output-port))))

;*---------------------------------------------------------------------*/
;*    open-input-file ...                                              */
;*    -------------------------------------------------------------    */
;*    This new version of open-input-file accept extended syntax.      */
;*    It may open plain file, strings, pipes, http/ftp files. The      */
;*    syntax is inspired by Web browsers, e.g.:                        */
;*        "/etc/passwd"                                                */
;*        "file:/etc/passwd"                                           */
;*        "string:bozo"                                                */
;*        "pipe:ls -lR /"                                              */
;*        "http://kaolin.unice.fr/Bigloo"                              */
;*        "http://localhost:10000/"                                    */
;*                                                                     */
;*    it also accepts the former form for pipes:                       */
;*        "| ls -lR /"                                                 */
;*    -------------------------------------------------------------    */
;*    Implementation note: remember that STRING-LENGTH is a O-macro    */
;*    thus, (STRING-LENGTH <a-constant-string>) is replaced with the   */
;*    actual length of the constant.                                   */
;*---------------------------------------------------------------------*/
(define (open-input-file string . bufsiz)
   (let ((size (if (null? bufsiz)
		   c-default-io-bufsiz
		   (car bufsiz))))
      (if (not (fixnum? size))
	  (error "open-input-file" "not a number" size)
	  (cond
	     ((substring=? string "file:" (string-length "file:"))
	      ;; an plain file
	      (c-open-input-file (substring string
					    (string-length "file:")
					    (string-length string))
				 size))
	     ((substring=? string "| " 2)
	      ;; a former pipe
	      (c-open-input-pipe (substring string
					    2
					    (string-length string))
				 size))
	     ((substring=? string "pipe:" (string-length "pipe:"))
	      ;; a new pipe notation
	      (c-open-input-pipe (substring string
					    (string-length "pipe:")
					    (string-length string))
				 size))
	     ((substring=? string "http:" (string-length "http:"))
	      (open-input-socket (substring string
					    (string-length "http:")
					    (string-length string))))
	     ;; an http file
	     ((substring=? string "ftp:" (string-length "ftp:"))
	      ;; an ftp file
	      (open-input-socket (substring string
					    (string-length "ftp:")
					    (string-length string))))
	     ((substring=? string "string:" (string-length "string:"))
	      ;; a string port
	      (c-open-input-string (substring string
					      (string-length "string:")
					      (string-length string))))
	     (else
	      (c-open-input-file string size))))))

;*---------------------------------------------------------------------*/
;*    open-input-socket ...                                            */
;*---------------------------------------------------------------------*/
(define (open-input-socket string)
   (define (socket->port server port path)
      ;; given a server name, a port number and a file name, opens
      ;; a socket connection to that server and returns the INPUT-PORT
      ;; associated to that socket
      (let ((s (make-client-socket server port)))
	 (fprint (socket-output s) "GET " path)
	 (flush-output-port (socket-output s))
	 (socket-input s)))
   ;; find the port name (and the optional port number),
   (if (not (substring=? string "//" 2))
       #f
       (let ((len (string-length string)))
	  (let loop ((r 2)
		     (pstart #f))
	     (cond
		((>=fx r len)
		 #f)
		((char=? (string-ref string r) #\/)
		 ;; we have the name of the server 
		 (if (fixnum? pstart)
		     (let ((server (substring string 2 pstart))
			   (port (string->integer (substring string
							     (+fx 1 pstart)
							     r)))
			   (file (substring string r len)))
			(socket->port server port file))
		     (let ((server (substring string 2 r))
			   (port 80)
			   (file (substring string r len)))
			(socket->port server port file))))
		((char=? (string-ref string r) #\:)
		 ;; we have the name of the server, we have to decode
		 ;; the port number
		 (loop (+fx r 1) r))
		(else
		 (loop (+fx r 1) pstart)))))))

;*---------------------------------------------------------------------*/
;*    open-input-string ...                                            */
;*---------------------------------------------------------------------*/
(define-inline (open-input-string string)
   (c-open-input-string string))

;*---------------------------------------------------------------------*/
;*    open-input-procedure ...                                         */
;*---------------------------------------------------------------------*/
(define-inline (open-input-procedure proc)
   (c-open-input-procedure proc))

;*---------------------------------------------------------------------*/
;*    open-input-c-string ...                                          */
;*---------------------------------------------------------------------*/
(define-inline (open-input-c-string string)
   (c-open-input-c-string string))

;*---------------------------------------------------------------------*/
;*    reopen-input-c-string ...                                        */
;*---------------------------------------------------------------------*/
(define-inline (reopen-input-c-string port::input-port string)
   (c-reopen-input-c-string port string))

;*---------------------------------------------------------------------*/
;*    open-output-file ...                                             */
;*---------------------------------------------------------------------*/
(define-inline (open-output-file string)
   (c-open-output-file string))

;*---------------------------------------------------------------------*/
;*    open-output-string ...                                           */
;*---------------------------------------------------------------------*/
(define-inline (open-output-string)
   (c-open-output-string))

;*---------------------------------------------------------------------*/
;*    closed-input-port? ...                                           */
;*---------------------------------------------------------------------*/
(define-inline (closed-input-port? port)
   (c-closed-input-port? port))

;*---------------------------------------------------------------------*/
;*    close-input-port ...                                             */
;*---------------------------------------------------------------------*/
(define-inline (close-input-port port)
   (c-close-input-port port))

;*---------------------------------------------------------------------*/
;*    get-output-string ...                                            */
;*---------------------------------------------------------------------*/
(define-inline (get-output-string port)
   (c-get-output-string port))

;*---------------------------------------------------------------------*/
;*    close-output-port ...                                            */
;*---------------------------------------------------------------------*/
(define-inline (close-output-port port)
   (c-close-output-port port))

;*---------------------------------------------------------------------*/
;*    Non R5Rs functions.                                              */
;*---------------------------------------------------------------------*/
;*---------------------------------------------------------------------*/
;*    flush-output-port ...                                            */
;*---------------------------------------------------------------------*/
(define-inline (flush-output-port port)
   (c-flush-output-port port))

;*---------------------------------------------------------------------*/
;*    reset-eof ...                                                    */
;*---------------------------------------------------------------------*/
(define-inline (reset-eof port)
   (c-reset-eof port))

;*---------------------------------------------------------------------*/
;*    set-input-port-position! ...                                     */
;*---------------------------------------------------------------------*/
(define-inline (set-input-port-position! port::input-port pos::int)
   (if (not (c-set-input-port-position! port pos))
       (error "set-input-port-position!" "Can't seek port" port)))
   
;*---------------------------------------------------------------------*/
;*    input-port-position ...                                          */
;*---------------------------------------------------------------------*/
(define-inline (input-port-position port)
   (c-input-port-position port))

;*---------------------------------------------------------------------*/
;*    set-output-port-position! ...                                    */
;*---------------------------------------------------------------------*/
(define-inline (set-output-port-position! port::output-port pos::int)
   (if (not (c-set-output-port-position! port pos))
       (error "set-output-port-position!" "Can't seek port" port)))
   
;*---------------------------------------------------------------------*/
;*    output-port-position ...                                         */
;*---------------------------------------------------------------------*/
(define-inline (output-port-position port)
   (c-output-port-position port))

;*---------------------------------------------------------------------*/
;*    input-port-name ...                                              */
;*---------------------------------------------------------------------*/
(define-inline (input-port-name port)
   (c-input-port-name port))

;*---------------------------------------------------------------------*/
;*    file-exists? ...                                                 */
;*---------------------------------------------------------------------*/
(define-inline (file-exists? name)
   (c-fexists? name))
   
;*---------------------------------------------------------------------*/
;*    append-output-file ...                                           */
;*---------------------------------------------------------------------*/
(define-inline (append-output-file string)
   (c-append-output-file string))

;*---------------------------------------------------------------------*/
;*    delete-file ...                                                  */
;*---------------------------------------------------------------------*/
(define-inline (delete-file string)
   (c-delete-file string))

;*---------------------------------------------------------------------*/
;*    make-directory ...                                               */
;*---------------------------------------------------------------------*/
(define-inline (make-directory string)
   (c-mkdir string #o777))

;*---------------------------------------------------------------------*/
;*    make-directories ...                                             */
;*---------------------------------------------------------------------*/
(define (make-directories string)
   (or (make-directory string)
       (let ((dname (dirname string)))
	  (if (or (string=? dname "") (file-exists? dname))
	      #f
	      (begin
		 (make-directories dname)
		 (make-directory string))))))
      
;*---------------------------------------------------------------------*/
;*    delete-directory ...                                             */
;*---------------------------------------------------------------------*/
(define-inline (delete-directory string)
   (c-delete-directory string))

;*---------------------------------------------------------------------*/
;*    rename-file ...                                                  */
;*---------------------------------------------------------------------*/
(define-inline (rename-file string1 string2)
   (if (eq? (c-rename-file string1 string2) 0)
       #t
       #f))

;*---------------------------------------------------------------------*/
;*    port? ...                                                        */
;*---------------------------------------------------------------------*/
(define-inline (port? obj)
   (or (output-port? obj) (input-port? obj)))

;*---------------------------------------------------------------------*/
;*    directory? ...                                                   */
;*---------------------------------------------------------------------*/
(define-inline (directory? string)
   (__directory? string))

;*---------------------------------------------------------------------*/
;*    directory->list ...                                              */
;*---------------------------------------------------------------------*/
(define-inline (directory->list string)
   (__directory->list string))

;*---------------------------------------------------------------------*/
;*    @deffn file-modification-time@ ...                               */
;*---------------------------------------------------------------------*/
(define (file-modification-time file)
   (c-modification-time file))

;*---------------------------------------------------------------------*/
;*    @deffn file-size@ ...                                            */
;*---------------------------------------------------------------------*/
(define (file-size file)
   (let ((size (c-file-size file)))
      (if (<fx size 0)
          (error "file-size" "Can't find file info" file)
          size)))
