Implement 'set-port-read-option!'.

* libguile/read.c (scm_keyword_prefix, scm_keyword_postfix):
  Rename to 'sym_prefix' and 'sym_postfix'.
  (scm_copy, scm_positions, scm_case_insensitive, sym_keywords,
  sym_r6rs_hex_escapes, sym_square_brackets, sym_hungry_eol_escapes,
  sym_curly_infix, sym_inherit): New variables.
  (scm_set_port_read_option_x): New procedure.
  (init_read_context): Adapt to the renamed 'sym_prefix' and
  'sym_postfix' variables.

* libguile/read.h (scm_set_port_read_option_x): New prototype.

* doc/ref/api-evaluation.texi (Scheme Read): Add docs.

3 files changed, 114 insertions, 13 deletions

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 88f713d40..5eb6e3db3 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -345,19 +345,40 @@ curly-infix       no    Support SRFI-105 curly infix expressions.
 r7rs-symbols      no    Support R7RS |...| symbol notation.
 @end smalllisp
 
-Note that Guile also includes a preliminary mechanism for setting read
-options on a per-port basis.  For instance, the @code{case-insensitive}
-read option is set (or unset) on the port when the reader encounters the
+Guile allows read options to be set on a per-port basis in one of two
+ways.  One way to do this is by placing reader directives within the
+file itself.  For example, the @code{case-insensitive} read option is
+set (or unset) on the port when the reader encounters the
 @code{#!fold-case} or @code{#!no-fold-case} reader directives.
 Similarly, the @code{#!curly-infix} reader directive sets the
 @code{curly-infix} read option on the port, and
 @code{#!curly-infix-and-bracket-lists} sets @code{curly-infix} and
-unsets @code{square-brackets} on the port (@pxref{SRFI-105}).  There is
-currently no other way to access or set the per-port read options.
+unsets @code{square-brackets} on the port (@pxref{SRFI-105}).
 
-The boolean options may be toggled with @code{read-enable} and
-@code{read-disable}. The non-boolean @code{keywords} option must be set
-using @code{read-set!}.
+Alternatively, per-port read options can be set using the following
+procedure:
+
+@deffn {Scheme Procedure} set-port-read-option! port option value
+@deffnx {C Function} scm_set_port_read_option_x (port, option, value)
+Set the per-port read option @var{option} to @var{value} for the given
+@var{port}.  @var{option} must be one of the symbols listed above.
+
+For the boolean read options, @var{value} must be either a boolean or
+the symbol @code{inherit}, which indicates that the setting should be
+inherited from the corresponding global read option.  For the
+@code{keywords} read option, @var{value} must be @code{#f},
+@code{prefix}, @code{postfix}, or @code{inherit}.
+@end deffn
+
+For example, to enable case-insensitive mode on a given port:
+
+@example
+(set-port-read-option! port 'case-insensitive #t)
+@end example
+
+It is also possible to set read options globally.  The boolean options
+may be toggled globally with @code{read-enable} and @code{read-disable}.
+The non-boolean @code{keywords} option must be set using @code{read-set!}.
 
 @deffn {Scheme Procedure} read-enable option-name
 @deffnx {Scheme Procedure} read-disable option-name
diff --git a/libguile/read.c b/libguile/read.c
index f9b72ab7f..f1adc8f96 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -61,8 +61,8 @@
 
 
 SCM_GLOBAL_SYMBOL (scm_sym_dot, ".");
-SCM_SYMBOL (scm_keyword_prefix, "prefix");
-SCM_SYMBOL (scm_keyword_postfix, "postfix");
+SCM_SYMBOL (sym_prefix, "prefix");
+SCM_SYMBOL (sym_postfix, "postfix");
 SCM_SYMBOL (sym_nil, "nil");
 
 /* SRFI-105 curly infix expression support */
@@ -2411,6 +2411,84 @@ set_port_read_option (SCM port, int option, int new_value)
   scm_i_set_port_property_x (port, sym_port_read_options, scm_read_options);
 }
 
+/* Read option symbols */
+SCM_SYMBOL (sym_copy, "copy");
+SCM_SYMBOL (sym_positions, "positions");
+SCM_SYMBOL (sym_case_insensitive, "case-insensitive");
+SCM_SYMBOL (sym_keywords, "keywords");
+SCM_SYMBOL (sym_r6rs_hex_escapes, "r6rs-hex-escapes");
+SCM_SYMBOL (sym_square_brackets, "square-brackets");
+SCM_SYMBOL (sym_hungry_eol_escapes, "hungry-eol-escapes");
+SCM_SYMBOL (sym_curly_infix, "curly-infix");
+SCM_SYMBOL (sym_r7rs_symbols, "r7rs-symbols");
+
+/* Special 'inherit' value for 'set-port-read-option!'. */
+SCM_SYMBOL (sym_inherit, "inherit");
+
+SCM_DEFINE (scm_set_port_read_option_x, "set-port-read-option!", 3, 0, 0,
+            (SCM port, SCM option, SCM value),
+	    "Set the reader option OPTION to VALUE for the given PORT.")
+#define FUNC_NAME s_scm_set_port_read_option_x
+{
+  SCM_VALIDATE_OPPORT (1, port);
+  if (scm_is_eq (option, sym_keywords))
+    {
+      int new_value;
+
+      if (scm_is_false (value))
+        new_value = KEYWORD_STYLE_HASH_PREFIX;
+      else if (scm_is_eq (value, sym_prefix))
+        new_value = KEYWORD_STYLE_PREFIX;
+      else if (scm_is_eq (value, sym_postfix))
+        new_value = KEYWORD_STYLE_POSTFIX;
+      else if (scm_is_eq (value, sym_inherit))
+        new_value = READ_OPTION_INHERIT;
+      else
+        scm_wrong_type_arg_msg ("set-port-read-option!", 3,
+                                value, "#f, prefix, postfix, or inherit");
+
+      set_port_read_option (port, READ_OPTION_KEYWORD_STYLE, new_value);
+    }
+  else
+    {
+      int option_code, new_value;
+
+      if (scm_is_eq (option, sym_copy))
+        option_code = READ_OPTION_COPY_SOURCE_P;
+      else if (scm_is_eq (option, sym_positions))
+        option_code = READ_OPTION_RECORD_POSITIONS_P;
+      else if (scm_is_eq (option, sym_case_insensitive))
+        option_code = READ_OPTION_CASE_INSENSITIVE_P;
+      else if (scm_is_eq (option, sym_r6rs_hex_escapes))
+        option_code = READ_OPTION_R6RS_ESCAPES_P;
+      else if (scm_is_eq (option, sym_square_brackets))
+        option_code = READ_OPTION_SQUARE_BRACKETS_P;
+      else if (scm_is_eq (option, sym_hungry_eol_escapes))
+        option_code = READ_OPTION_HUNGRY_EOL_ESCAPES_P;
+      else if (scm_is_eq (option, sym_curly_infix))
+        option_code = READ_OPTION_CURLY_INFIX_P;
+      else if (scm_is_eq (option, sym_r7rs_symbols))
+        option_code = READ_OPTION_R7RS_SYMBOLS_P;
+      else
+        scm_wrong_type_arg_msg ("set-port-read-option!", 2,
+                                option, "valid read option symbol");
+
+      if (scm_is_false (value))
+        new_value = 0;
+      else if (scm_is_eq (value, SCM_BOOL_T))
+        new_value = 1;
+      else if (scm_is_eq (value, sym_inherit))
+        new_value = READ_OPTION_INHERIT;
+      else
+        scm_wrong_type_arg_msg ("set-port-read-option!", 3,
+                                value, "#t, #f, or inherit");
+
+      set_port_read_option (port, option_code, new_value);
+    }
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 /* Set CTX and PORT's case-insensitivity according to VALUE. */
 static void
 set_port_case_insensitive_p (SCM port, scm_t_read_context *ctx, int value)
@@ -2457,9 +2535,9 @@ init_read_context (SCM port, scm_t_read_context *ctx)
   if (x == READ_OPTION_INHERIT)
     {
       val = SCM_PACK (SCM_KEYWORD_STYLE);
-      if (scm_is_eq (val, scm_keyword_prefix))
+      if (scm_is_eq (val, sym_prefix))
         x = KEYWORD_STYLE_PREFIX;
-      else if (scm_is_eq (val, scm_keyword_postfix))
+      else if (scm_is_eq (val, sym_postfix))
         x = KEYWORD_STYLE_POSTFIX;
       else
         x = KEYWORD_STYLE_HASH_PREFIX;
diff --git a/libguile/read.h b/libguile/read.h
index 3c47afdd0..08372d7f5 100644
--- a/libguile/read.h
+++ b/libguile/read.h
@@ -3,7 +3,8 @@
 #ifndef SCM_READ_H
 #define SCM_READ_H
 
-/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009 Free Software Foundation, Inc.
+/* Copyright (C) 1995,1996,2000, 2006, 2008, 2009,
+ *   2014 Free Software Foundation, Inc.
  *
  * This library is free software; you can redistribute it and/or
  * modify it under the terms of the GNU Lesser General Public License
@@ -52,6 +53,7 @@
 
 SCM_API SCM scm_sym_dot;
 
+SCM_API SCM scm_set_port_read_option_x (SCM port, SCM option, SCM value);
 SCM_API SCM scm_read_options (SCM setting);
 SCM_API SCM scm_read (SCM port);
 SCM_API SCM scm_read_hash_extend (SCM chr, SCM proc);