mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

Merge commit 'a38024baaa'

Browse source 
Conflicts:
	libguile/ports.h
This commit is contained in:
Andy Wingo 2013-11-28 16:15:38 +01:00
commit 9b95f3ced4
3 changed files with 32 additions and 22 deletions
Download patch file Download diff file Expand all files Collapse all files

25
libguile/ports.c
View file

@ -60,6 +60,7 @@
#include "libguile/weak-set.h" #include "libguile/weak-set.h"
#include "libguile/fluids.h" #include "libguile/fluids.h"
#include "libguile/eq.h" #include "libguile/eq.h"
#include "libguile/alist.h"
#ifdef HAVE_STRING_H #ifdef HAVE_STRING_H
#include <string.h> #include <string.h>
@ -342,17 +343,29 @@ scm_i_clear_pending_eof (SCM port)
SCM_PORT_GET_INTERNAL (port)->pending_eof = 0; SCM_PORT_GET_INTERNAL (port)->pending_eof = 0;
} }
SCM SCM_DEFINE (scm_i_port_property, "%port-property", 2, 0, 0,
scm_i_port_alist (SCM port) (SCM port, SCM key),
"Return the property of @var{port} associated with @var{key}.")
#define FUNC_NAME s_scm_i_port_property
{ {
return SCM_PORT_GET_INTERNAL (port)->alist; SCM_VALIDATE_OPPORT (1, port);
return scm_assq_ref (SCM_PORT_GET_INTERNAL (port)->alist, key);
} }
#undef FUNC_NAME
void SCM_DEFINE (scm_i_set_port_property_x, "%set-port-property!", 3, 0, 0,
scm_i_set_port_alist_x (SCM port, SCM alist) (SCM port, SCM key, SCM value),
"Set the property of @var{port} associated with @var{key} to @var{value}.")
#define FUNC_NAME s_scm_i_set_port_property_x
{ {
SCM_PORT_GET_INTERNAL (port)->alist = alist; scm_t_port_internal *pti;
SCM_VALIDATE_OPPORT (1, port);
pti = SCM_PORT_GET_INTERNAL (port);
pti->alist = scm_assq_set_x (pti->alist, key, value);
return SCM_UNSPECIFIED;
} }
#undef FUNC_NAME

6
libguile/ports.h
View file

@ -362,9 +362,9 @@ SCM_API SCM scm_set_port_column_x (SCM port, SCM line);
SCM_API SCM scm_port_filename (SCM port); SCM_API SCM scm_port_filename (SCM port);
SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename); SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename);
/* Port alist. */ /* Port properties. */
SCM_INTERNAL SCM scm_i_port_alist (SCM port); SCM_INTERNAL SCM scm_i_port_property (SCM port, SCM key);
SCM_INTERNAL void scm_i_set_port_alist_x (SCM port, SCM alist); SCM_INTERNAL SCM scm_i_set_port_property_x (SCM port, SCM key, SCM value);
/* Implementation helpers for port printing functions. */ /* Implementation helpers for port printing functions. */
SCM_API int scm_port_print (SCM exp, SCM port, scm_print_state *); SCM_API int scm_port_print (SCM exp, SCM port, scm_print_state *);

23
libguile/read.c
View file

@ -2115,10 +2115,10 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
/* Per-port read options. /* Per-port read options.
We store per-port read options in the 'port-read-options' key of the We store per-port read options in the 'port-read-options' port
port's alist, which is stored in the internal port structure. The property, which is stored in the internal port structure. The value
value stored in the alist is a single integer that contains a two-bit stored is a single integer that contains a two-bit field for each
field for each read option. read option.
If a bit field contains READ_OPTION_INHERIT (3), that indicates that If a bit field contains READ_OPTION_INHERIT (3), that indicates that
the applicable value should be inherited from the corresponding the applicable value should be inherited from the corresponding
@ -2128,7 +2128,7 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
read option has been set per-port, its possible values are those in read option has been set per-port, its possible values are those in
'enum t_keyword_style'. */ 'enum t_keyword_style'. */
/* Key to read options in per-port alists. */ /* Key to read options in port properties. */
SCM_SYMBOL (sym_port_read_options, "port-read-options"); SCM_SYMBOL (sym_port_read_options, "port-read-options");
/* Offsets of bit fields for each per-port override */ /* Offsets of bit fields for each per-port override */
@ -2153,12 +2153,11 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options");
static void static void
set_port_read_option (SCM port, int option, int new_value) set_port_read_option (SCM port, int option, int new_value)
{ {
SCM alist, scm_read_options; SCM scm_read_options;
unsigned int read_options; unsigned int read_options;
new_value &= READ_OPTION_MASK; new_value &= READ_OPTION_MASK;
alist = scm_i_port_alist (port); scm_read_options = scm_i_port_property (port, sym_port_read_options);
scm_read_options = scm_assq_ref (alist, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE)) if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options); read_options = scm_to_uint (scm_read_options);
else else
@ -2166,8 +2165,7 @@ set_port_read_option (SCM port, int option, int new_value)
read_options &= ~(READ_OPTION_MASK << option); read_options &= ~(READ_OPTION_MASK << option);
read_options |= new_value << option; read_options |= new_value << option;
scm_read_options = scm_from_uint (read_options); scm_read_options = scm_from_uint (read_options);
alist = scm_assq_set_x (alist, sym_port_read_options, scm_read_options); scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
scm_i_set_port_alist_x (port, alist);
} }
/* Set OPTS and PORT's case-insensitivity according to VALUE. */ /* Set OPTS and PORT's case-insensitivity according to VALUE. */
@ -2202,11 +2200,10 @@ set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value)
static void static void
init_read_options (SCM port, scm_t_read_opts *opts) init_read_options (SCM port, scm_t_read_opts *opts)
{ {
SCM alist, val, scm_read_options; SCM val, scm_read_options;
unsigned int read_options, x; unsigned int read_options, x;
alist = scm_i_port_alist (port); scm_read_options = scm_i_port_property (port, sym_port_read_options);
scm_read_options = scm_assq_ref (alist, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE)) if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options); read_options = scm_to_uint (scm_read_options);