[Guile-commits] 05/12: Add 'set-port-binary/text-mode!' procedure for MinGW.

[Jan Nieuwenhuizen]

janneke pushed a commit to branch wip-mingw
in repository guile.

commit 155d38db7f7927becd882c799e0f546a8a6a7552
Author: Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
AuthorDate: Thu Nov 19 15:08:33 2020 +0100

    Add 'set-port-binary/text-mode!' procedure for MinGW.
    
    * libguile/ports.c (scm_init_ports)[O_BINARY]: Define 'O_BINARY'.
    [O_TEXT]: Define 'O_TEXT'.
    (scm_c_set_port_binary_text_mode_x): New function.
    * libguile/ports.h (scm_set_binary_text_mode_x): Declare it.
    * module/ice-9/ports.scm (ice-9): Export it as
    'set-port-binary/text-mode!'.
    * doc/ref/api-io.texi (File Ports): Document it.
---
 doc/ref/api-io.texi    | 13 +++++++++++++
 libguile/ports.c       | 42 ++++++++++++++++++++++++++++++++++++++++++
 libguile/ports.h       |  1 +
 module/ice-9/ports.scm |  1 +
 4 files changed, 57 insertions(+)

diff --git a/doc/ref/api-io.texi b/doc/ref/api-io.texi
index 87d4af4..aee4525 100644
--- a/doc/ref/api-io.texi
+++ b/doc/ref/api-io.texi
@@ -1143,6 +1143,19 @@ source of data, but only the value that is returned by
 Determine whether @var{obj} is a port that is related to a file.
 @end deffn
 
+@deffn {Scheme Procedure} set-port-binary/text-mode! port mode
+On MinGW, set the binary/text mode for @var{port}.  @var{mode} can be one
+of the following:
+@table @code
+@item O_BINARY
+binary mode
+@item O_TEXT
+text mode
+@end table
+
+Only open file ports are supported.  On POSIX, this is a no-op.
+@end deffn
+
 
 @node Bytevector Ports
 @subsubsection Bytevector Ports
diff --git a/libguile/ports.c b/libguile/ports.c
index c25c207..be6b4bc 100644
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -4134,6 +4134,41 @@ SCM_DEFINE (scm_sys_make_void_port, "%make-void-port", 
1, 0, 0,
 }
 #undef FUNC_NAME
 
+SCM_DEFINE (scm_set_port_binary_text_mode_x, "set-port-binary/text-mode!", 2, 
0, 0,
+            (SCM port, SCM mode),
+           "On MinGW, set the binary/text mode for @var{port}.  @var{mode} can 
be one\n"
+            "of the following:\n"
+           "@table @code\n"
+           "@item O_BINARY\n"
+           "binary mode\n"
+           "@item O_TEXT\n"
+           "text mode\n"
+           "@end table\n\n"
+           "Only open file ports are supported.  On POSIX, this is a no-op.")
+#define FUNC_NAME s_scm_set_port_binary_text_mode_x
+{
+  int cmode = 0;
+  int fd;
+
+  if (scm_is_integer (port))
+    fd = scm_to_int (port);
+  else
+    {
+      SCM_VALIDATE_OPFPORT (1, port);
+      fd = SCM_FPORT_FDES (port);
+    }
+
+  SCM_VALIDATE_NUMBER (2, mode);
+  cmode = scm_to_int (mode);
+
+#if __MINGW32__
+  _setmode (fd, cmode);
+#endif
+
+  return SCM_UNSPECIFIED;
+}
+#undef FUNC_NAME
+
 
 
 
@@ -4173,6 +4208,13 @@ scm_init_ports (void)
   sym_escape = scm_from_latin1_symbol ("escape");
   sym_error = scm_from_latin1_symbol ("error");
 
+#ifdef O_BINARY
+  scm_c_define ("O_BINARY", scm_from_int (O_BINARY));
+#endif
+#ifdef O_TEXT
+  scm_c_define ("O_TEXT", scm_from_int (O_TEXT));
+#endif
+
   trampoline_to_c_read_subr =
     scm_c_make_gsubr ("port-read", 4, 0, 0,
                       (scm_t_subr) trampoline_to_c_read);
diff --git a/libguile/ports.h b/libguile/ports.h
index 44ef29d..c40b18d 100644
--- a/libguile/ports.h
+++ b/libguile/ports.h
@@ -218,6 +218,7 @@ SCM_API SCM scm_drain_input (SCM port);
 SCM_API void scm_end_input (SCM port);
 SCM_API SCM scm_force_output (SCM port);
 SCM_API void scm_flush (SCM port);
+SCM_API SCM scm_set_binary_text_mode_x (SCM port, SCM mode);
 
 SCM_INTERNAL SCM scm_port_random_access_p (SCM port);
 SCM_INTERNAL SCM scm_port_read_buffering (SCM port);
diff --git a/module/ice-9/ports.scm b/module/ice-9/ports.scm
index b219fee..6252845 100644
--- a/module/ice-9/ports.scm
+++ b/module/ice-9/ports.scm
@@ -69,6 +69,7 @@
             port-for-each
             flush-all-ports
             %make-void-port
+            set-port-binary/text-mode!
 
             ;; Definitions from fports.c.
             open-file