mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-06-12 23:00:22 +02:00
Code Activity

* fports.c (prinfport): Moved code from ports.c.

Browse source 
(local_free): Added.
(scm_fptob): Removed.  Instead use new interface.
(scm_make_fptob): Added.  (Need to create basic ports in a
specific order in ports.c.)
This commit is contained in:
Mikael Djurfeldt 1999-07-24 23:08:29 +00:00
parent f8b16091fc
commit b3ec3c64a5
1 changed files with 42 additions and 26 deletions
Download patch file Download diff file Expand all files Collapse all files

68
libguile/fports.c
View file

@ -357,23 +357,32 @@ prinfport (exp, port, pstate)
SCM port; SCM port;
scm_print_state *pstate; scm_print_state *pstate;
{ {
SCM name; scm_puts ("#<", port);
char * c; scm_print_port_mode (exp, port);
if (SCM_CLOSEDP (exp)) if (SCM_OPFPORTP (exp))
{ {
c = "file"; int fdes;
SCM name = SCM_PTAB_ENTRY (exp)->file_name;
scm_puts (SCM_NIMP (name) && SCM_ROSTRINGP (name)
? SCM_ROCHARS (name)
: SCM_PTOBNAME (SCM_PTOBNUM (exp)),
port);
scm_putc (' ', port);
fdes = (SCM_FSTREAM (exp))->fdes;
if (isatty (fdes))
scm_puts (ttyname (fdes), port);
else
scm_intprint (fdes, 10, port);
} }
else else
{ {
name = SCM_PTAB_ENTRY (exp)->file_name; scm_puts (SCM_PTOBNAME (SCM_PTOBNUM (exp)), port);
if (SCM_NIMP (name) && SCM_ROSTRINGP (name)) scm_putc (' ', port);
c = SCM_ROCHARS (name); scm_intprint (SCM_CDR (exp), 16, port);
else
c = "file";
} }
scm_putc ('>', port);
scm_prinport (exp, port, c); return 1;
return !0;
} }
#ifdef GUILE_ISELECT #ifdef GUILE_ISELECT
@ -546,20 +555,27 @@ local_fclose (SCM port)
return rv; return rv;
} }
scm_ptobfuns scm_fptob = static scm_sizet
{ local_free (SCM port)
0, {
local_fclose, local_fclose (port);
prinfport, return 0;
0, }
local_fflush,
local_read_flush, void scm_make_fptob (void); /* Called from ports.c */
local_fclose,
fport_fill_buffer, void
local_seek, scm_make_fptob ()
local_ftruncate, {
fport_input_waiting_p, long tc = scm_make_port_type ("file", fport_fill_buffer, local_fflush);
}; scm_set_ptob_free (tc, local_free);
scm_set_ptob_print (tc, prinfport);
scm_set_ptob_flush_input (tc, local_read_flush);
scm_set_ptob_close (tc, local_fclose);
scm_set_ptob_seek (tc, local_seek);
scm_set_ptob_truncate (tc, local_ftruncate);
scm_set_ptob_input_waiting_p (tc, fport_input_waiting_p);
}
void void
scm_init_fports () scm_init_fports ()