[gimp] Applied changes based on official version of TinyScheme (CVS commit dated

[Kevin Cozens <kcozens src gnome org>]

commit bf3d355fd7a95b132473746374408edddd1990b4
Author: Kevin Cozens <kcozens cvs gnome org>
Date:   Tue Aug 4 13:39:17 2009 -0400

    Applied changes based on official version of TinyScheme (CVS commit dated
    2007/12/22 10:48) which makes string output ports conform to SRFI-6.
    NOTE: SRFI-6 compliance is incomplete in official version of TinyScheme.
          (See SourceForge bug #2832150)
    
    Also included two minor additions/corrections to old ChangeLog files.

 ChangeLog.pre-2-6                              |    2 +-
 ChangeLog.pre-git                              |    6 +-
 plug-ins/script-fu/tinyscheme/Manual.txt       |    2 +-
 plug-ins/script-fu/tinyscheme/opdefines.h      |    3 +-
 plug-ins/script-fu/tinyscheme/scheme-private.h |    1 +
 plug-ins/script-fu/tinyscheme/scheme.c         |  100 +++++++++++++++++++++++-
 6 files changed, 104 insertions(+), 10 deletions(-)
---
diff --git a/ChangeLog.pre-2-6 b/ChangeLog.pre-2-6
index 98ca289..fe14d2f 100644
--- a/ChangeLog.pre-2-6
+++ b/ChangeLog.pre-2-6
@@ -870,7 +870,7 @@
 	official version of TinyScheme which adds entry point for nested
 	calling. Part of making it more suitable for Scheme->C->Scheme
 	calling. See SourceForge bug #1599945. Updated usage information
-	using text from Manual.txt.
+	using text from Manual.txt. See SourceForge bug #1825395.
 
 2008-09-11  Michael Natterer  <mitch gimp org>
 
diff --git a/ChangeLog.pre-git b/ChangeLog.pre-git
index ba8b168..69c6aba 100644
--- a/ChangeLog.pre-git
+++ b/ChangeLog.pre-git
@@ -1249,12 +1249,12 @@
 	use gtk_widget_get_action() instead of g_object_get_data(),
 	which relies on the name of the data key.
 
-2009-01-23  Kevin Cozens  <kcozens cvs gimp org>
+2009-01-23  Kevin Cozens  <kcozens cvs gnome org>
 
 	* libgimpcolor/gimprgb-parse.c: Applied patch from Andreas Turtschan
 	to fix more RGB colour values. Fixes bug #568909.
 
-2009-01-23  Kevin Cozens  <kcozens cvs gimp org>
+2009-01-23  Kevin Cozens  <kcozens cvs gnome org>
 
 	* libgimpcolor/gimprgb-parse.c: Applied patch from Andreas Turtschan
 	to fix colour values for slategray and slategrey. Fixes bug #568839.
@@ -1392,7 +1392,7 @@
 	* configure.in: require intltool >= 0.40.1. Looks like that was
 	the first version with support for the NC_ keyword.
 
-2009-01-13  Kevin Cozens  <kcozens cvs gimp org>
+2009-01-13  Kevin Cozens  <kcozens cvs gnome org>
 
 	* app/tools/gimpforegroundselecttool.c: Corrected spelling error
 	spotted by David Gowers.
diff --git a/plug-ins/script-fu/tinyscheme/Manual.txt b/plug-ins/script-fu/tinyscheme/Manual.txt
index 77bea11..7091a37 100644
--- a/plug-ins/script-fu/tinyscheme/Manual.txt
+++ b/plug-ins/script-fu/tinyscheme/Manual.txt
@@ -182,7 +182,7 @@ Please read accompanying file COPYING.
      with-input-from-file, with-output-from-file and
      with-input-output-from-to-files, close-port and input-output-port? 
      (not R5RS).
-     String Ports: open-input-string, open-output-string,
+     String Ports: open-input-string, open-output-string, get-output-string,
      open-input-output-string. Strings can be used with I/O routines.
 
           Vectors
diff --git a/plug-ins/script-fu/tinyscheme/opdefines.h b/plug-ins/script-fu/tinyscheme/opdefines.h
index 57c5433..51664e8 100644
--- a/plug-ins/script-fu/tinyscheme/opdefines.h
+++ b/plug-ins/script-fu/tinyscheme/opdefines.h
@@ -159,8 +159,9 @@
     _OP_DEF(opexe_4, "open-input-output-file",         1,  1,       TST_STRING,                      OP_OPEN_INOUTFILE   )
 #if USE_STRING_PORTS
     _OP_DEF(opexe_4, "open-input-string",              1,  1,       TST_STRING,                      OP_OPEN_INSTRING    )
-    _OP_DEF(opexe_4, "open-output-string",             1,  1,       TST_STRING,                      OP_OPEN_OUTSTRING   )
     _OP_DEF(opexe_4, "open-input-output-string",       1,  1,       TST_STRING,                      OP_OPEN_INOUTSTRING )
+    _OP_DEF(opexe_4, "open-output-string",             0,  1,       TST_STRING,                      OP_OPEN_OUTSTRING   )
+    _OP_DEF(opexe_4, "get-output-string",              1,  1,       TST_OUTPORT,                     OP_GET_OUTSTRING    )
 #endif
     _OP_DEF(opexe_4, "close-input-port",               1,  1,       TST_INPORT,                      OP_CLOSE_INPORT     )
     _OP_DEF(opexe_4, "close-output-port",              1,  1,       TST_OUTPORT,                     OP_CLOSE_OUTPORT    )
diff --git a/plug-ins/script-fu/tinyscheme/scheme-private.h b/plug-ins/script-fu/tinyscheme/scheme-private.h
index 8607a33..e755638 100644
--- a/plug-ins/script-fu/tinyscheme/scheme-private.h
+++ b/plug-ins/script-fu/tinyscheme/scheme-private.h
@@ -11,6 +11,7 @@ enum scheme_port_kind {
   port_free=0,
   port_file=1,
   port_string=2,
+  port_srfi6=4,
   port_input=16,
   port_output=32
 };
diff --git a/plug-ins/script-fu/tinyscheme/scheme.c b/plug-ins/script-fu/tinyscheme/scheme.c
index 3d0b096..d6f823f 100644
--- a/plug-ins/script-fu/tinyscheme/scheme.c
+++ b/plug-ins/script-fu/tinyscheme/scheme.c
@@ -1463,6 +1463,37 @@ static pointer port_from_string(scheme *sc, char *start, char *past_the_end, int
   return mk_port(sc,pt);
 }
 
+#define BLOCK_SIZE 256
+
+static port *port_rep_from_scratch(scheme *sc) {
+  port *pt;
+  char *start;
+  pt=(port*)sc->malloc(sizeof(port));
+  if(pt==0) {
+    return 0;
+  }
+  start=sc->malloc(BLOCK_SIZE);
+  if(start==0) {
+    return 0;
+  }
+  memset(start,' ',BLOCK_SIZE-1);
+  start[BLOCK_SIZE-1]='\0';
+  pt->kind=port_string|port_output|port_srfi6;
+  pt->rep.string.start=start;
+  pt->rep.string.curr=start;
+  pt->rep.string.past_the_end=start+BLOCK_SIZE-1;
+  return pt;
+}
+
+static pointer port_from_scratch(scheme *sc) {
+  port *pt;
+  pt=port_rep_from_scratch(sc);
+  if(pt==0) {
+    return sc->NIL;
+  }
+  return mk_port(sc,pt);
+}
+
 static void port_close(scheme *sc, pointer p, int flag) {
   port *pt=p->_object._port;
   pt->kind&=~flag;
@@ -1601,6 +1632,25 @@ static void backchar(scheme *sc, gunichar c) {
   }
 }
 
+static int realloc_port_string(scheme *sc, port *p)
+{
+  char *start=p->rep.string.start;
+  size_t new_size=p->rep.string.past_the_end-start+1+BLOCK_SIZE;
+  char *str=sc->malloc(new_size);
+  if(str) {
+    memset(str,' ',new_size-1);
+    str[new_size-1]='\0';
+    strcpy(str,start);
+    p->rep.string.start=str;
+    p->rep.string.past_the_end=str+new_size-1;
+    p->rep.string.curr-=start-str;
+    sc->free(start);
+    return 1;
+  } else {
+    return 0;
+  }
+}
+
 /* len is number of UTF-8 characters in string pointed to by chars */
 static void putchars(scheme *sc, const char *chars, int char_cnt) {
   int   free_bytes;     /* Space remaining in buffer (in bytes) */
@@ -1628,13 +1678,20 @@ static void putchars(scheme *sc, const char *chars, int char_cnt) {
       }
 #endif
   } else {
-    free_bytes = pt->rep.string.past_the_end - pt->rep.string.curr;
-    if (free_bytes > 0)
+    if (pt->rep.string.past_the_end != pt->rep.string.curr)
     {
+       free_bytes = pt->rep.string.past_the_end - pt->rep.string.curr;
        l = min(char_cnt, free_bytes);
        memcpy(pt->rep.string.curr, chars, l);
        pt->rep.string.curr += l;
     }
+    else if(pt->kind&port_srfi6&&realloc_port_string(sc,pt))
+    {
+       free_bytes = pt->rep.string.past_the_end - pt->rep.string.curr;
+       l = min(char_cnt, free_bytes);
+       memcpy(pt->rep.string.curr, chars, char_cnt);
+       pt->rep.string.curr += l;
+    }
   }
 }
 
@@ -3840,13 +3897,11 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
 
 #if USE_STRING_PORTS
      case OP_OPEN_INSTRING: /* open-input-string */
-     case OP_OPEN_OUTSTRING: /* open-output-string */
      case OP_OPEN_INOUTSTRING: /* open-input-output-string */ {
           int prop=0;
           pointer p;
           switch(op) {
                case OP_OPEN_INSTRING:     prop=port_input; break;
-               case OP_OPEN_OUTSTRING:    prop=port_output; break;
                case OP_OPEN_INOUTSTRING:  prop=port_input|port_output; break;
                default:                   break;  /* Quiet the compiler */
           }
@@ -3857,6 +3912,43 @@ static pointer opexe_4(scheme *sc, enum scheme_opcodes op) {
           }
           s_return(sc,p);
      }
+     case OP_OPEN_OUTSTRING: /* open-output-string */ {
+          pointer p;
+          if(car(sc->args)==sc->NIL) {
+               p=port_from_scratch(sc);
+               if(p==sc->NIL) {
+                    s_return(sc,sc->F);
+               }
+          } else {
+               p=port_from_string(sc, strvalue(car(sc->args)),
+                          strvalue(car(sc->args))+strlength(car(sc->args)),
+                          port_output);
+               if(p==sc->NIL) {
+                    s_return(sc,sc->F);
+               }
+          }
+          s_return(sc,p);
+     }
+     case OP_GET_OUTSTRING: /* get-output-string */ {
+          port *p;
+
+          if ((p=car(sc->args)->_object._port)->kind&port_string) {
+               off_t size;
+               char *str;
+
+               size=p->rep.string.curr-p->rep.string.start+1;
+               if(str=sc->malloc(size)) {
+                    pointer s;
+
+                    memcpy(str,p->rep.string.start,size-1);
+                    str[size-1]='\0';
+                    s=mk_string(sc,str);
+                    sc->free(str);
+                    s_return(sc,s);
+               }
+          }
+          s_return(sc,sc->F);
+     }
 #endif
 
      case OP_CLOSE_INPORT: /* close-input-port */