From 3ec85650e3deda7f597d4d8b51525413cfd61222 Mon Sep 17 00:00:00 2001
From: Mark H Weaver <mhw@netris.org>
Date: Wed, 24 Oct 2012 14:37:36 -0400
Subject: [PATCH 2/3] Implement #!fold-case and #!no-fold-case reader
 directives.

* libguile/read.c (set_port_case_insensitive_p): New function.

  (scm_read_shebang): Handle #!fold-case and #!no-fold-case.

* doc/ref/api-evaluation.texi (Case Sensitivity, Scheme Read): Document
  the #!fold-case and #!no-fold-case reader directives.

* test-suite/tests/reader.test ("per-port-read-options"): Add tests.
---
 doc/ref/api-evaluation.texi  |   22 +++++++++++++++-------
 libguile/read.c              |   16 ++++++++++++++++
 test-suite/tests/reader.test |   13 +++++++++++++
 3 files changed, 44 insertions(+), 7 deletions(-)

diff --git a/doc/ref/api-evaluation.texi b/doc/ref/api-evaluation.texi
index 6112832..c7bf97a 100644
--- a/doc/ref/api-evaluation.texi
+++ b/doc/ref/api-evaluation.texi
@@ -254,6 +254,8 @@ Encoding of Source Files}.
 
 @node Case Sensitivity
 @subsubsection Case Sensitivity
+@cindex fold-case
+@cindex no-fold-case
 
 @c FIXME::martin: Review me!
 
@@ -275,9 +277,9 @@ options, @xref{Scheme Read}.
 (read-enable 'case-insensitive)
 @end lisp
 
-Note that this is seldom a problem, because Scheme programmers tend not
-to use uppercase letters in their identifiers anyway.
-
+It is also possible to disable (or enable) case sensitivity within a
+single file by placing the reader directives @code{#!fold-case} (or
+@code{#!no-fold-case}) within the file itself.
 
 @node Keyword Syntax
 @subsubsection Keyword Syntax
@@ -315,10 +317,10 @@ its read options.
 @cindex options - read
 @cindex read options
 @deffn {Scheme Procedure} read-options [setting]
-Display the current settings of the read options.  If @var{setting} is
-omitted, only a short form of the current read options is printed.
-Otherwise if @var{setting} is the symbol @code{help}, a complete options
-description is displayed.
+Display the current settings of the global read options.  If
+@var{setting} is omitted, only a short form of the current read options
+is printed.  Otherwise if @var{setting} is the symbol @code{help}, a
+complete options description is displayed.
 @end deffn
 
 The set of available options, and their default values, may be had by
@@ -338,6 +340,12 @@ hungry-eol-escapes no   In strings, consume leading whitespace after an
                         escaped end-of-line.
 @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
+@code{#!fold-case} or @code{#!no-fold-case} reader directives.  There is
+currently no other way to access or set the per-port read options.
+
 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!}.
diff --git a/libguile/read.c b/libguile/read.c
index 18ac0ef..1ec7325 100644
--- a/libguile/read.c
+++ b/libguile/read.c
@@ -1276,6 +1276,9 @@ scm_read_scsh_block_comment (scm_t_wchar chr, SCM port)
   return SCM_UNSPECIFIED;
 }
 
+static void set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts,
+                                         int value);
+
 static SCM
 scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
 {
@@ -1297,6 +1300,10 @@ scm_read_shebang (scm_t_wchar chr, SCM port, scm_t_read_opts *opts)
           name[i] = '\0';
           if (0 == strcmp ("r6rs", name))
             ;  /* Silently ignore */
+          else if (0 == strcmp ("fold-case", name))
+            set_port_case_insensitive_p (port, opts, 1);
+          else if (0 == strcmp ("no-fold-case", name))
+            set_port_case_insensitive_p (port, opts, 0);
           else
             break;
 
@@ -1999,6 +2006,15 @@ set_port_read_option (SCM port, int option, int new_value)
   scm_i_pthread_mutex_unlock (&scm_i_port_table_mutex);
 }
 
+/* Set OPTS and PORT's case-insensitivity according to VALUE. */
+static void
+set_port_case_insensitive_p (SCM port, scm_t_read_opts *opts, int value)
+{
+  value = !!value;
+  opts->case_insensitive_p = value;
+  set_port_read_option (port, READ_OPTION_CASE_INSENSITIVE_P, value);
+}
+
 /* Initialize OPTS based on PORT's read options and the global read
    options. */
 static void
diff --git a/test-suite/tests/reader.test b/test-suite/tests/reader.test
index 60c853c..6e02255 100644
--- a/test-suite/tests/reader.test
+++ b/test-suite/tests/reader.test
@@ -401,6 +401,19 @@
         (lambda ()
           (read-disable 'hungry-eol-escapes))))))
 
+(with-test-prefix "per-port-read-options"
+  (pass-if "case-sensitive"
+    (equal? '(guile GuiLe gUIle)
+            (with-read-options '(case-insensitive)
+              (lambda ()
+                (with-input-from-string "GUIle #!no-fold-case GuiLe gUIle"
+                  (lambda ()
+                    (list (read) (read) (read))))))))
+  (pass-if "case-insensitive"
+    (equal? '(GUIle guile guile)
+            (with-input-from-string "GUIle #!fold-case GuiLe gUIle"
+              (lambda ()
+                (list (read) (read) (read)))))))
 
 (with-test-prefix "#;"
   (for-each
-- 
1.7.10.4