diff --git a/NEWS b/NEWS index 87bfba30d..0d2d4861b 100644 --- a/NEWS +++ b/NEWS @@ -989,9 +989,9 @@ work on any kind of port, not just ports which are open on a file. ** now 'l' in a port mode requests line buffering. -** new procedure: ftruncate PORT [LENGTH] -Truncates PORT after LENGTH bytes, or at the current position if -LENGTH is omitted. Works on random-access file and string ports. +** The procedure truncate-file now works on string ports as well +as file ports. If the size argument is omitted, the current +file position is now used. ** new procedure: lseek PORT/FDES OFFSET WHENCE The arguments are the same as for the old fseek procedure, but it diff --git a/libguile/ChangeLog b/libguile/ChangeLog index 7ca0130ff..096c98933 100644 --- a/libguile/ChangeLog +++ b/libguile/ChangeLog @@ -1,3 +1,13 @@ +1999-07-24 Gary Houston + + * gdbint.c (gdb_print, gdb_read): call scm_truncate_file. + + * ports.c (scm_truncate_file): renamed from scm_ftruncate. + allow the 1st argument to be a fdes or filename as well as a + port (as in the filesys.c version). + + * filesys.c (scm_truncate_file): removed. + 1999-07-24 Mikael Djurfeldt * readline.c, readline.h: Removed. diff --git a/libguile/filesys.c b/libguile/filesys.c index 39e40b8cd..a4a493ec0 100644 --- a/libguile/filesys.c +++ b/libguile/filesys.c @@ -513,37 +513,6 @@ scm_delete_file (str) return SCM_UNSPECIFIED; } -SCM_PROC (s_truncate_file, "truncate-file", 2, 0, 0, scm_truncate_file); -SCM -scm_truncate_file (SCM object, SCM size) -{ - int rv; - scm_sizet csize; - int fdes; - - object = SCM_COERCE_OUTPORT (object); - - csize = (scm_sizet) scm_num2long (size, (char *) SCM_ARG2, s_truncate_file); - if (SCM_INUMP (object) || (SCM_NIMP (object) && SCM_OPFPORTP (object))) - { - if (SCM_INUMP (object)) - fdes = SCM_INUM (object); - else - fdes = SCM_FPORT_FDES (object); - SCM_SYSCALL (rv = ftruncate (fdes, csize)); - } - else - { - SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object), - object, SCM_ARG1, s_chown); - SCM_COERCE_SUBSTR (object); - SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), csize)); - } - if (rv == -1) - scm_syserror (s_truncate_file); - return SCM_UNSPECIFIED; -} - SCM_PROC (s_mkdir, "mkdir", 1, 1, 0, scm_mkdir); SCM diff --git a/libguile/filesys.h b/libguile/filesys.h index cf0803e3c..17cee89c4 100644 --- a/libguile/filesys.h +++ b/libguile/filesys.h @@ -64,7 +64,6 @@ extern SCM scm_stat SCM_P ((SCM object)); extern SCM scm_link SCM_P ((SCM oldpath, SCM newpath)); extern SCM scm_rename SCM_P ((SCM oldname, SCM newname)); extern SCM scm_delete_file SCM_P ((SCM str)); -extern SCM scm_truncate_file (SCM object, SCM size); extern SCM scm_mkdir SCM_P ((SCM path, SCM mode)); extern SCM scm_rmdir SCM_P ((SCM path)); extern SCM scm_opendir SCM_P ((SCM dirname)); diff --git a/libguile/gdbint.c b/libguile/gdbint.c index b40493e61..677996aee 100644 --- a/libguile/gdbint.c +++ b/libguile/gdbint.c @@ -207,7 +207,7 @@ gdb_read (str) unmark_port (gdb_input_port); scm_lseek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); scm_puts (str, gdb_input_port); - scm_ftruncate (gdb_input_port, SCM_UNDEFINED); + scm_truncate_file (gdb_input_port, SCM_UNDEFINED); scm_lseek (gdb_input_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); /* Read one object */ tok_buf_mark_p = SCM_GC8MARKP (tok_buf); @@ -269,7 +269,7 @@ gdb_print (obj) /* Reset stream */ scm_lseek (gdb_output_port, SCM_INUM0, SCM_MAKINUM (SEEK_SET)); scm_write (obj, gdb_output_port); - scm_ftruncate (gdb_output_port, SCM_UNDEFINED); + scm_truncate_file (gdb_output_port, SCM_UNDEFINED); SEND_STRING (SCM_CHARS (SCM_STREAM (gdb_output_port))); SCM_END_FOREIGN_BLOCK; return 0; diff --git a/libguile/ports.c b/libguile/ports.c index 1e1595ff0..4e27a0c55 100644 --- a/libguile/ports.c +++ b/libguile/ports.c @@ -978,40 +978,57 @@ scm_lseek (SCM object, SCM offset, SCM whence) return scm_long2num (rv); } -SCM_PROC (s_ftruncate, "ftruncate", 1, 1, 0, scm_ftruncate); +SCM_PROC (s_truncate_file, "truncate-file", 1, 1, 0, scm_truncate_file); SCM -scm_ftruncate (SCM port, SCM length) +scm_truncate_file (SCM object, SCM length) { - scm_port *pt; - scm_ptobfuns *ptob; + int rv; + off_t c_length; + + /* object can be a port, fdes or filename. */ - port = SCM_COERCE_OUTPORT (port); - SCM_ASSERT (SCM_NIMP (port) && SCM_OPOUTPORTP (port), port, SCM_ARG1, - s_ftruncate); - pt = SCM_PTAB_ENTRY (port); - ptob = scm_ptobs + SCM_PTOBNUM (port); - if (!ptob->ftruncate) - scm_misc_error (s_ftruncate, "port is not truncatable", - scm_cons (port, SCM_EOL)); if (SCM_UNBNDP (length)) { - length = scm_lseek (port, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); + /* must supply length if object is a filename. */ + if (SCM_NIMP (object) && SCM_ROSTRINGP (object)) + scm_wrong_num_args (scm_makfrom0str (s_truncate_file)); + + length = scm_lseek (object, SCM_INUM0, SCM_MAKINUM (SEEK_CUR)); } - if (pt->rw_active == SCM_PORT_READ) - scm_read_flush (port); - else if (pt->rw_active == SCM_PORT_WRITE) - ptob->fflush (port); + c_length = scm_num2long (length, (char *)SCM_ARG2, s_truncate_file); + if (c_length < 0) + scm_misc_error (s_truncate_file, "negative offset", SCM_EOL); - { - off_t c_length = scm_num2long (length, (char *)SCM_ARG2, s_ftruncate); - - if (c_length < 0) - scm_misc_error (s_ftruncate, "negative offset", - scm_cons (length, SCM_EOL)); - - ptob->ftruncate (port, c_length); - } + object = SCM_COERCE_OUTPORT (object); + if (SCM_INUMP (object)) + { + SCM_SYSCALL (rv = ftruncate (SCM_INUM (object), c_length)); + } + else if (SCM_NIMP (object) && SCM_OPOUTPORTP (object)) + { + scm_port *pt = SCM_PTAB_ENTRY (object); + scm_ptobfuns *ptob = scm_ptobs + SCM_PTOBNUM (object); + + if (!ptob->ftruncate) + scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL); + if (pt->rw_active == SCM_PORT_READ) + scm_read_flush (object); + else if (pt->rw_active == SCM_PORT_WRITE) + ptob->fflush (object); + + ptob->ftruncate (object, c_length); + rv = 0; + } + else + { + SCM_ASSERT (SCM_NIMP (object) && SCM_ROSTRINGP (object), + object, SCM_ARG1, s_truncate_file); + SCM_COERCE_SUBSTR (object); + SCM_SYSCALL (rv = truncate (SCM_ROCHARS (object), c_length)); + } + if (rv == -1) + scm_syserror (s_truncate_file); return SCM_UNSPECIFIED; } diff --git a/libguile/ports.h b/libguile/ports.h index b08250835..69d790a1b 100644 --- a/libguile/ports.h +++ b/libguile/ports.h @@ -237,7 +237,7 @@ extern SCM scm_unread_char SCM_P ((SCM cobj, SCM port)); extern SCM scm_unread_string SCM_P ((SCM str, SCM port)); extern char *scm_generic_fgets SCM_P ((SCM port, int *len)); extern SCM scm_lseek (SCM object, SCM offset, SCM whence); -extern SCM scm_ftruncate (SCM port, SCM length); +extern SCM scm_truncate_file (SCM object, SCM length); extern SCM scm_port_line SCM_P ((SCM port)); extern SCM scm_set_port_line_x SCM_P ((SCM port, SCM line)); extern SCM scm_port_column SCM_P ((SCM port));