299.405

svn: r1152

src/mred/wxme/wx_medio.cxx

@@ -927,7 +927,11 @@ char *wxMediaStreamIn::GetString(long *n, int extra)
 
 char *wxMediaStreamIn::GetStringPlusOne(long *n)
 {
-  return GetString(n, 1);
+  char *s;
+  s = GetString(n, 1);
+  if (n && *n)
+    *n = (*n - 1);
+  return s;
 }
 
 wxMediaStreamIn *wxMediaStreamIn::Get(long *n, char *str)

src/mred/wxs/wxs_mio.cxx

@@ -443,7 +443,7 @@ static Scheme_Object *os_wxMediaStreamInBaseRead(int n,  Scheme_Object *p[])
   
   x0 = NULL;
 
-  x0 = VectorToArray(NULL, p[POFFSET], &x1, x2);
+  x2 = 0; x0 = VectorToArray(NULL, p[POFFSET], &x1, x2);
   if (((Scheme_Class_Object *)p[0])->primflag)
     r =  0;
   else

src/mred/wxs/wxs_mio.xc

@@ -74,7 +74,7 @@ static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len, long
 @MACRO setNULL = NULL
 @MACRO arrayToVector = p[POFFSET] = ArrayToVector(x0, NULL, x1, x2);
 @MACRO copyArrayToVector = ArrayToVector(x0, p[POFFSET], x1, x2);
-@MACRO vectorToArray = x0 = VectorToArray(NULL, p[POFFSET], &x1, x2);
+@MACRO vectorToArray = x2 = 0; x0 = VectorToArray(NULL, p[POFFSET], &x1, x2);
 @MACRO copyVectorToArray = VectorToArray(x0, p[POFFSET], &x1, x2);
 
 @CREATOR ();

src/mzscheme/src/schminc.h

@@ -13,7 +13,7 @@
 
 #define USE_COMPILED_STARTUP 1
 
-#define EXPECTED_PRIM_COUNT 844
+#define EXPECTED_PRIM_COUNT 845
 
 #ifdef MZSCHEME_SOMETHING_OMITTED
 # undef USE_COMPILED_STARTUP

src/mzscheme/src/schvers.h

@@ -9,6 +9,6 @@
 
 
 #define MZSCHEME_VERSION_MAJOR 299
-#define MZSCHEME_VERSION_MINOR 404
+#define MZSCHEME_VERSION_MINOR 405
 
-#define MZSCHEME_VERSION "299.404" _MZ_SPECIAL_TAG
+#define MZSCHEME_VERSION "299.405" _MZ_SPECIAL_TAG

src/mzscheme/src/string.c

@@ -39,6 +39,7 @@
 # include <errno.h>
 # ifdef MACOS_UNICODE_SUPPORT
 #  include <CoreFoundation/CFString.h>
+#  include <CoreFoundation/CFLocale.h>
 # endif
 # ifdef WINDOWS_UNICODE_SUPPORT
 #  include <windows.h>
@@ -235,6 +236,7 @@ static Scheme_Object *system_library_subpath(int argc, Scheme_Object *argv[]);
 static Scheme_Object *cmdline_args(int argc, Scheme_Object *argv[]);
 static Scheme_Object *current_locale(int argc, Scheme_Object *argv[]);
 static Scheme_Object *locale_string_encoding(int argc, Scheme_Object *argv[]);
+static Scheme_Object *system_language_country(int argc, Scheme_Object *argv[]);
 
 static Scheme_Object *byte_string_open_converter(int argc, Scheme_Object *argv[]);
 static Scheme_Object *byte_string_close_converter(int argc, Scheme_Object *argv[]);
@@ -516,6 +518,11 @@ scheme_init_string (Scheme_Env *env)
 						      "locale-string-encoding",
 						      0, 0),
 			     env);
+  scheme_add_global_constant("system-language+country",
+			     scheme_make_prim_w_arity(system_language_country,
+						      "system-language+country",
+						      0, 0),
+			     env);
 
   scheme_add_global_constant("bytes-converter?",
 			     scheme_make_prim_w_arity(byte_converter_p,
@@ -2153,6 +2160,83 @@ static Scheme_Object *locale_string_encoding(int argc, Scheme_Object *argv[])
 #endif
 }
 
+static Scheme_Object *system_language_country(int argc, Scheme_Object *argv[])
+{
+#ifdef MACOS_UNICODE_SUPPORT
+  /* Mac OS X */
+  CFLocaleRef l;
+  CFStringRef s;
+  int len;
+  char *r;
+
+  l = CFLocaleCopyCurrent();
+  s = CFLocaleGetIdentifier(l);
+
+  len = CFStringGetLength(s);
+  r = (char *)scheme_malloc_atomic(len * 6 + 1);
+  CFStringGetCString(s, r, len * 6 + 1, kCFStringEncodingUTF8);
+
+  CFRelease(l);
+
+  return scheme_make_sized_utf8_string(r, 5);
+#else
+# ifdef WINDOWS_UNICODE_SUPPORT
+  /* Windows */
+  LCID l;
+  int llen, clen;
+  char *lang, *country, *s;
+  l = GetUserDefaultLCID();
+
+  llen = GetLocaleInfo(l, LOCALE_SENGLANGUAGE, NULL, 0);
+  lang = (char *)scheme_malloc_atomic(llen);
+  GetLocaleInfo(l, LOCALE_SENGLANGUAGE, lang, llen);
+  if (llen)
+    llen -= 1; /* drop nul terminator */
+
+  clen = GetLocaleInfo(l, LOCALE_SENGCOUNTRY, NULL, 0);
+  country = (char *)scheme_malloc_atomic(clen);
+  GetLocaleInfo(l, LOCALE_SENGCOUNTRY, country, clen);
+  if (clen)
+    clen -= 1; /* drop nul terminator */
+
+  s = (char *)scheme_malloc_atomic(clen + llen + 1);
+  memcpy(s, lang, llen);
+  memcpy(s + 1 + llen, country, clen);
+  s[llen] = '_';
+  
+  return scheme_make_sized_utf8_string(s, llen + 1 + clen);
+# else
+  /* Unix */
+  char *s;
+  
+  s = getenv("LC_ALL");
+  if (!s)
+    s = getenv("LC_CTYPE");
+  if (!s)
+    s = getenv("LANG");
+  
+  if (s) {
+    /* Check that the environment variable has the form
+       xx_XX[.ENC] */
+    if ((s[0] >= 'a') && (s[0] <= 'z')
+	&& (s[1] >= 'a') && (s[1] <= 'z')
+	&& (s[2] == '_')
+	&& (s[3] >= 'A') && (s[3] <= 'Z')
+	&& (s[4] >= 'A') && (s[4] <= 'Z')
+	&& (!s[5] || s[5] == '.')) {
+      /* Good */
+    } else
+      s = NULL;
+  }
+  
+  if (!s)
+    s = "en_US";
+  
+  return scheme_make_sized_utf8_string(s, 5);
+# endif
+#endif
+}
+
 #ifndef DONT_USE_LOCALE
 
 #ifdef OS_X