summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorGary Houston <ghouston@arglist.com>1999-07-24 19:52:13 +0000
committerGary Houston <ghouston@arglist.com>1999-07-24 19:52:13 +0000
commit69bc9ff335d5f32b1262dcc96d3109321248f8cc (patch)
treee40bcba0a4ea0728f8fe012e93608f1b902a525c
parenteb9ef08b772597d002e1f183750881cc7662e0bf (diff)
downloadguile-69bc9ff335d5f32b1262dcc96d3109321248f8cc.tar.gz
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.
-rw-r--r--NEWS6
-rw-r--r--libguile/ChangeLog10
-rw-r--r--libguile/filesys.c31
-rw-r--r--libguile/filesys.h1
-rw-r--r--libguile/gdbint.c4
-rw-r--r--libguile/ports.c69
-rw-r--r--libguile/ports.h2
7 files changed, 59 insertions, 64 deletions
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 <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.
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);
-
- {
- off_t c_length = scm_num2long (length, (char *)SCM_ARG2, s_ftruncate);
+ 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);
- 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));