1999-07-24 Gary Houston <ghouston@easynet.co.uk>

* 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.

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]
+** The procedure truncate-file now works on string ports as well
-Truncates PORT after LENGTH bytes, or at the current position if
+as file ports.  If the size argument is omitted, the current
-LENGTH is omitted.  Works on random-access file and string ports.
+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

libguile/ChangeLog

@@ -1,3 +1,13 @@
+1999-07-24  Gary Houston  <ghouston@easynet.co.uk>
+
+	* 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  <mdj@thalamus.nada.kth.se>
 
 	* readline.c, readline.h: Removed.

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 

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));

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;

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;
+  int rv;
-  scm_ptobfuns *ptob;
+  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)
+  c_length = scm_num2long (length, (char *)SCM_ARG2, s_truncate_file);
-    scm_read_flush (port);
+  if (c_length < 0)
-  else if (pt->rw_active == SCM_PORT_WRITE)
+    scm_misc_error (s_truncate_file, "negative offset", SCM_EOL);
-    ptob->fflush (port);
 
-  {
+  object = SCM_COERCE_OUTPORT (object);
-    off_t c_length = scm_num2long (length, (char *)SCM_ARG2, s_ftruncate);
+  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 (c_length < 0)
+      if (!ptob->ftruncate)
-      scm_misc_error (s_ftruncate, "negative offset", 
+	scm_misc_error (s_truncate_file, "port is not truncatable", SCM_EOL);
-		      scm_cons (length, 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 (port, c_length);
+      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;
 }
 

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));