summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2013-11-17 01:11:57 -0500
committerMark H Weaver <mhw@netris.org>2013-11-23 15:47:31 -0500
commita38024baaa32d1a6d91fdc81388c88bbb926c3ae (patch)
tree4a31e92b862e5d9309df956546c49c707c5e8c57
parent2437c7b2e8b4ab7786847ee1ce0b59e446a70fe2 (diff)
downloadguile-a38024baaa32d1a6d91fdc81388c88bbb926c3ae.tar.gz
Make port properties accessible from Scheme.
* libguile/ports.c (scm_i_port_alist, scm_i_set_port_alist_x): Removed. (scm_i_port_property, scm_i_set_port_property_x): New procedures, available from Scheme as '%port-property' and '%set-port-property!'. * libguile/ports.h (scm_i_port_alist, scm_i_set_port_alist_x): Removed. (scm_i_port_property, scm_i_set_port_property_x): New prototypes. * libguile/read.c (set_port_read_option, init_read_options): Adapt to use scm_i_port_property and scm_i_set_port_property_x.
-rw-r--r--libguile/ports.c25
-rw-r--r--libguile/ports.h4
-rw-r--r--libguile/read.c23
3 files changed, 31 insertions, 21 deletions
diff --git a/libguile/ports.c b/libguile/ports.c
index 6f219d6d2..451616069 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -61,6 +61,7 @@
#include "libguile/weaks.h"
#include "libguile/fluids.h"
#include "libguile/eq.h"
+#include "libguile/alist.h"
#ifdef HAVE_STRING_H
#include <string.h>
@@ -254,17 +255,29 @@ scm_i_clear_pending_eof (SCM port)
SCM_PORT_GET_INTERNAL (port)->pending_eof = 0;
}
-SCM
-scm_i_port_alist (SCM port)
+SCM_DEFINE (scm_i_port_property, "%port-property", 2, 0, 0,
+ (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_i_set_port_alist_x (SCM port, SCM alist)
+SCM_DEFINE (scm_i_set_port_property_x, "%set-port-property!", 3, 0, 0,
+ (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
diff --git a/libguile/ports.h b/libguile/ports.h
index 39317f8b1..4affb4d48 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -317,8 +317,8 @@ SCM_API SCM scm_port_column (SCM port);
SCM_API SCM scm_set_port_column_x (SCM port, SCM line);
SCM_API SCM scm_port_filename (SCM port);
SCM_API SCM scm_set_port_filename_x (SCM port, SCM filename);
-SCM_INTERNAL SCM scm_i_port_alist (SCM port);
-SCM_INTERNAL void scm_i_set_port_alist_x (SCM port, SCM alist);
+SCM_INTERNAL SCM scm_i_port_property (SCM port, SCM key);
+SCM_INTERNAL SCM scm_i_set_port_property_x (SCM port, SCM key, SCM value);
SCM_INTERNAL const char *scm_i_default_port_encoding (void);
SCM_INTERNAL void scm_i_set_default_port_encoding (const char *);
SCM_INTERNAL void scm_i_set_port_encoding_x (SCM port, const char *str);
diff --git a/libguile/read.c b/libguile/read.c
index e2e2e4a2e..299ab70a4 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -2133,10 +2133,10 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
/* Per-port read options.
- We store per-port read options in the 'port-read-options' key of the
- port's alist, which is stored in the internal port structure. The
- value stored in the alist is a single integer that contains a two-bit
- field for each read option.
+ We store per-port read options in the 'port-read-options' port
+ property, which is stored in the internal port structure. The value
+ stored is a single integer that contains a two-bit field for each
+ read option.
If a bit field contains READ_OPTION_INHERIT (3), that indicates that
the applicable value should be inherited from the corresponding
@@ -2146,7 +2146,7 @@ SCM_DEFINE (scm_file_encoding, "file-encoding", 1, 0, 0,
read option has been set per-port, its possible values are those in
'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");
/* Offsets of bit fields for each per-port override */
@@ -2171,12 +2171,11 @@ SCM_SYMBOL (sym_port_read_options, "port-read-options");
static void
set_port_read_option (SCM port, int option, int new_value)
{
- SCM alist, scm_read_options;
+ SCM scm_read_options;
unsigned int read_options;
new_value &= READ_OPTION_MASK;
- alist = scm_i_port_alist (port);
- scm_read_options = scm_assq_ref (alist, sym_port_read_options);
+ scm_read_options = scm_i_port_property (port, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options);
else
@@ -2184,8 +2183,7 @@ set_port_read_option (SCM port, int option, int new_value)
read_options &= ~(READ_OPTION_MASK << option);
read_options |= new_value << option;
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_alist_x (port, alist);
+ scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
}
/* Set OPTS and PORT's case-insensitivity according to VALUE. */
@@ -2220,11 +2218,10 @@ set_port_curly_infix_p (SCM port, scm_t_read_opts *opts, int value)
static void
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;
- alist = scm_i_port_alist (port);
- scm_read_options = scm_assq_ref (alist, sym_port_read_options);
+ scm_read_options = scm_i_port_property (port, sym_port_read_options);
if (scm_is_unsigned_integer (scm_read_options, 0, READ_OPTIONS_MAX_VALUE))
read_options = scm_to_uint (scm_read_options);