suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

299.404

Browse Source 
svn: r1073
This commit is contained in:
Matthew Flatt 2005-10-13 19:58:38 +00:00
parent d044b06b27
commit 24d6604cd5
24 changed files with 2114 additions and 1280 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

56
src/configure vendored
View File

@ -8717,6 +8717,62 @@ fi
echo "$as_me:$LINENO: result: $inline" >&5
echo "${ECHO_T}$inline" >&6
echo "$as_me:$LINENO: checking for nl_langinfo (CODESET)" >&5
echo $ECHO_N "checking for nl_langinfo (CODESET)... $ECHO_C" >&6
cat >conftest.$ac_ext <<_ACEOF
/* confdefs.h. */
_ACEOF
cat confdefs.h >>conftest.$ac_ext
cat >>conftest.$ac_ext <<_ACEOF
/* end confdefs.h. */
#include <langinfo.h>
int
main ()
{
char *codeset = nl_langinfo (CODESET);
;
return 0;
}
_ACEOF
rm -f conftest.$ac_objext conftest$ac_exeext
if { (eval echo "$as_me:$LINENO: \"$ac_link\"") >&5
(eval $ac_link) 2>conftest.er1
ac_status=$?
grep -v '^ *+' conftest.er1 >conftest.err
rm -f conftest.er1
cat conftest.err >&5
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); } &&
{ ac_try='test -z "$ac_c_werror_flag"
|| test ! -s conftest.err'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; } &&
{ ac_try='test -s conftest$ac_exeext'
{ (eval echo "$as_me:$LINENO: \"$ac_try\"") >&5
(eval $ac_try) 2>&5
ac_status=$?
echo "$as_me:$LINENO: \$? = $ac_status" >&5
(exit $ac_status); }; }; then
cat >>confdefs.h <<\_ACEOF
#define HAVE_CODESET 1
_ACEOF
have_codeset=yes
else
echo "$as_me: failed program was:" >&5
sed 's/^/| /' conftest.$ac_ext >&5
have_codeset=no
fi
rm -f conftest.err conftest.$ac_objext \
conftest$ac_exeext conftest.$ac_ext
echo "$as_me:$LINENO: result: $have_codeset" >&5
echo "${ECHO_T}$have_codeset" >&6
iconv_lib_flag=""
if test "${enable_iconv}" = "yes" ; then
if test "${ac_cv_header_iconv_h+set}" = set; then

11
src/mred/wxme/wx_mbuf.cxx
View File

@ -733,6 +733,8 @@ Bool wxReadMediaGlobalFooter(wxMediaStreamIn *f)
Bool wxWriteMediaGlobalHeader(wxMediaStreamOut *f)
{
f->PrettyStart();
f->scl->ResetHeaderFlags(f);
if (!f->scl->Write(f))
return FALSE;
@ -747,6 +749,8 @@ Bool wxWriteMediaGlobalFooter(wxMediaStreamOut *f)
wxmbDoneStyleReadsWrites(f);
f->scl->ResetHeaderFlags(f);
f->PrettyFinish();
return TRUE;
}
@ -765,7 +769,8 @@ int wxmeCheckFormatAndVersion(wxMediaStreamIn *s, wxMediaStreamInBase *b, Bool s
&& strcmp(s->read_version, "03")
&& strcmp(s->read_version, "04")
&& strcmp(s->read_version, "05")
&& strcmp(s->read_version, "06")) {
&& strcmp(s->read_version, "06")
&& strcmp(s->read_version, "07")) {
if (showErrors)
wxmeError("load-file: unknown version number in editor<%> file format");
return 0;
@ -780,7 +785,9 @@ int wxmeCheckFormatAndVersion(wxMediaStreamIn *s, wxMediaStreamInBase *b, Bool s
if ((buf[0] != ' ')
|| (buf[1] != '#')
|| (buf[2] != '#')
|| (buf[3] != ' ')) {
|| ((buf[3] != ' ')
&& (buf[3] != '\r')
&& (buf[3] != '\n'))) {
if (showErrors)
wxmeError("load-file: editor<%> file missing ' ## ' mark");
return 0;

795
src/mred/wxme/wx_medio.cxx
View File

File diff suppressed because it is too large Load Diff

27
src/mred/wxme/wx_medio.h
View File

@ -12,7 +12,7 @@ class wxMediaStreamInBase : public wxObject
virtual void Seek(long) = 0;
virtual void Skip(long) = 0;
virtual Bool Bad(void) = 0;
virtual long Read(char *data, long len) = 0;
virtual long Read(char *data, long len, long delta = 0) = 0;
};
class wxMediaStreamOutBase : public wxObject
@ -38,7 +38,7 @@ class wxMediaStreamInFileBase : public wxMediaStreamInBase
void Seek(long);
void Skip(long);
Bool Bad(void);
long Read(char *data, long len);
long Read(char *data, long len, long delta = 0);
};
class wxMediaStreamOutFileBase : public wxMediaStreamOutBase
@ -71,7 +71,7 @@ class wxMediaStreamInStringBase : public wxMediaStreamInBase
void Seek(long);
void Skip(long);
Bool Bad(void);
long Read(char *data, long len);
long Read(char *data, long len, long delta = 0);
};
class wxMediaStreamOutStringBase : public wxMediaStreamOutBase
@ -99,7 +99,7 @@ class wxMediaStreamOutStringBase : public wxMediaStreamOutBase
#define MRED_START_STR_LEN 4
#define MRED_FORMAT_STR "01"
#define MRED_FORMAT_STR_LEN 2
#define MRED_VERSION_STR "07"
#define MRED_VERSION_STR "08"
#define MRED_VERSION_STR_LEN 2
#define WXME_VERSION_ONE(f) (f->read_version[1] == '1')
@ -108,7 +108,8 @@ class wxMediaStreamOutStringBase : public wxMediaStreamOutBase
#define WXME_VERSION_FOUR(f) (f->read_version[1] == '4')
#define WXME_VERSION_FIVE(f) (f->read_version[1] == '5')
#define WXME_VERSION_SIX(f) (f->read_version[1] == '6')
#define WXME_VERSION_BEFORE_SEVEN(f) ((f->read_version[1] >= '1') && (f->read_version[1] <= '6'))
#define WXME_VERSION_SEVEN(f) (f->read_version[1] == '7')
#define WXME_VERSION_BEFORE_EIGHT(f) ((f->read_version[1] >= '1') && (f->read_version[1] <= '7'))
class wxStandardSnipClassList;
class wxBufferDataClassList;
@ -182,9 +183,18 @@ class wxMediaStreamIn : public wxMediaStream
long *boundaries;
int boundalloc, boundcount;
int bad;
int items;
void *pos_map;
void Typecheck(char);
void GetNumber(long*, double*);
char *GetAString(long *n, long limit, char *target, int extra, int recur);
void IncItemCount();
void SkipOne(int recur);
char SkipWhitespace(char *buf = NULL);
int IsDelim(char c);
public:
wxMediaStreamIn(wxMediaStreamInBase *base);
~wxMediaStreamIn();
@ -215,7 +225,9 @@ class wxMediaStreamIn : public wxMediaStream
class wxMediaStreamOut : public wxMediaStream
{
wxMediaStreamOutBase *f;
int bad;
int bad, col;
int items; /* position count in items */
void *pos_map; /* map from position count to stream location */
void Typeset(char);
@ -237,6 +249,9 @@ class wxMediaStreamOut : public wxMediaStream
void JumpTo(long pos);
Bool Ok(void);
void PrettyStart();
void PrettyFinish();
};
#endif /* wx_medio */

51
src/mred/wxs/wxs_mio.cxx
View File

@ -143,7 +143,7 @@ static l_TYPE l_POINT *l_MAKE_ARRAY(Scheme_Object *l, l_INTTYPE *c, char *who)
static char *VectorToArray(char *r, Scheme_Object *vec, long *len)
static char *VectorToArray(char *r, Scheme_Object *vec, long *len, long delta)
{
long c, i;
Scheme_Object **a = NULL;
@ -158,21 +158,23 @@ static char *VectorToArray(char *r, Scheme_Object *vec, long *len)
c = *len = SCHEME_VEC_SIZE(vec);
if (!r)
if (!r) {
r = WITH_VAR_STACK((char *)scheme_malloc_atomic(c));
delta = 0;
}
for (a = SCHEME_VEC_ELS(vec), i = 0; i < c; i++) {
if (!SCHEME_CHARP(a[i]))
WITH_VAR_STACK(scheme_wrong_type(METHODNAME("editor-stream-in-base%","read"),
"character vector", -1, 0, &vec));
r[i] = SCHEME_CHAR_VAL(a[i]);
r[i+delta] = SCHEME_CHAR_VAL(a[i]);
}
READY_TO_RETURN;
return r;
}
static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len)
static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len, long delta)
{
long i;
Scheme_Object **a = NULL;
@ -188,7 +190,7 @@ static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len)
"character vector", -1, 0, &vec));
for (a = SCHEME_VEC_ELS(vec), i = 0; i < len; i++)
a[i] = WITH_VAR_STACK(scheme_make_char(r[i]));
a[i] = WITH_VAR_STACK(scheme_make_ascii_character(r[i+delta]));
READY_TO_RETURN;
@ -203,7 +205,7 @@ class os_wxMediaStreamInBase : public wxMediaStreamInBase {
os_wxMediaStreamInBase CONSTRUCTOR_ARGS(());
~os_wxMediaStreamInBase();
long Read(char* x0, long x1);
long Read(char* x0, long x1, long x2);
Bool Bad();
void Skip(nnlong x0);
void Seek(nnlong x0);
@ -237,7 +239,7 @@ os_wxMediaStreamInBase::~os_wxMediaStreamInBase()
static Scheme_Object *os_wxMediaStreamInBaseRead(int n, Scheme_Object *p[]);
long os_wxMediaStreamInBase::Read(char* x0, long x1)
long os_wxMediaStreamInBase::Read(char* x0, long x1, long x2)
{
Scheme_Object *p[POFFSET+1] INIT_NULLED_ARRAY({ NULLED_OUT INA_comma NULLED_OUT });
Scheme_Object *v;
@ -261,11 +263,11 @@ long os_wxMediaStreamInBase::Read(char* x0, long x1)
} else {
p[POFFSET+0] = NULL;
p[POFFSET] = ArrayToVector(x0, NULL, x1);
p[POFFSET] = ArrayToVector(x0, NULL, x1, x2);
p[0] = (Scheme_Object *) ASSELF __gc_external;
v = WITH_VAR_STACK(scheme_apply(method, POFFSET+1, p));
VectorToArray(x0, p[POFFSET], &x1);
VectorToArray(x0, p[POFFSET], &x1, x2);
{
long resval;
@ -432,6 +434,7 @@ static Scheme_Object *os_wxMediaStreamInBaseRead(int n, Scheme_Object *p[])
objscheme_check_valid(os_wxMediaStreamInBase_class, "read in editor-stream-in-base%", n, p);
char* x0 INIT_NULLED_OUT;
long x1;
long x2;
SETUP_VAR_STACK_REMEMBERED(2);
VAR_STACK_PUSH(0, p);
@ -440,13 +443,13 @@ static Scheme_Object *os_wxMediaStreamInBaseRead(int n, Scheme_Object *p[])
x0 = NULL;
x0 = VectorToArray(NULL, p[POFFSET], &x1);
x0 = VectorToArray(NULL, p[POFFSET], &x1, x2);
if (((Scheme_Class_Object *)p[0])->primflag)
r = 0;
else
r = WITH_VAR_STACK(((wxMediaStreamInBase *)((Scheme_Class_Object *)p[0])->primdata)->Read(x0, x1));
r = WITH_VAR_STACK(((wxMediaStreamInBase *)((Scheme_Class_Object *)p[0])->primdata)->Read(x0, x1, x2));
ArrayToVector(x0, p[POFFSET], x1);
ArrayToVector(x0, p[POFFSET], x1, x2);
READY_TO_RETURN;
return scheme_make_integer(r);
@ -1871,6 +1874,7 @@ class wxMediaStreamIn *objscheme_unbundle_wxMediaStreamIn(Scheme_Object *obj, co
class os_wxMediaStreamOut : public wxMediaStreamOut {
public:
@ -1924,6 +1928,26 @@ static Scheme_Object *os_wxMediaStreamOutOk(int n, Scheme_Object *p[])
return (r ? scheme_true : scheme_false);
}
static Scheme_Object *os_wxMediaStreamOutPrettyFinish(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
objscheme_check_valid(os_wxMediaStreamOut_class, "pretty-finish in editor-stream-out%", n, p);
SETUP_VAR_STACK_REMEMBERED(1);
VAR_STACK_PUSH(0, p);
WITH_VAR_STACK(((wxMediaStreamOut *)((Scheme_Class_Object *)p[0])->primdata)->PrettyFinish());
READY_TO_RETURN;
return scheme_void;
}
static Scheme_Object *os_wxMediaStreamOutJumpTo(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@ -2120,9 +2144,10 @@ void objscheme_setup_wxMediaStreamOut(Scheme_Env *env)
wxREGGLOB(os_wxMediaStreamOut_class);
os_wxMediaStreamOut_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "editor-stream-out%", "object%", (Scheme_Method_Prim *)os_wxMediaStreamOut_ConstructScheme, 5));
os_wxMediaStreamOut_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "editor-stream-out%", "object%", (Scheme_Method_Prim *)os_wxMediaStreamOut_ConstructScheme, 6));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaStreamOut_class, "ok?" " method", (Scheme_Method_Prim *)os_wxMediaStreamOutOk, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaStreamOut_class, "pretty-finish" " method", (Scheme_Method_Prim *)os_wxMediaStreamOutPrettyFinish, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaStreamOut_class, "jump-to" " method", (Scheme_Method_Prim *)os_wxMediaStreamOutJumpTo, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaStreamOut_class, "tell" " method", (Scheme_Method_Prim *)os_wxMediaStreamOutTell, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxMediaStreamOut_class, "put-fixed" " method", (Scheme_Method_Prim *)os_wxMediaStreamOutPutFixed, 1, 1));

24
src/mred/wxs/wxs_mio.xc
View File

@ -17,7 +17,7 @@
@CLASSBASE wxMediaStreamInBase "editor-stream-in-base" : "object"
static char *VectorToArray(char *r, Scheme_Object *vec, long *len)
static char *VectorToArray(char *r, Scheme_Object *vec, long *len, long delta)
{
long c, i;
Scheme_Object **a = NULL;
@ -32,21 +32,23 @@ static char *VectorToArray(char *r, Scheme_Object *vec, long *len)
c = *len = SCHEME_VEC_SIZE(vec);
if (!r)
if (!r) {
r = WITH_VAR_STACK((char *)scheme_malloc_atomic(c));
delta = 0;
}
for (a = SCHEME_VEC_ELS(vec), i = 0; i < c; i++) {
if (!SCHEME_CHARP(a[i]))
WITH_VAR_STACK(scheme_wrong_type(METHODNAME("editor-stream-in-base%","read"),
"character vector", -1, 0, &vec));
r[i] = SCHEME_CHAR_VAL(a[i]);
r[i+delta] = SCHEME_CHAR_VAL(a[i]);
}
READY_TO_RETURN;
return r;
}
static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len)
static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len, long delta)
{
long i;
Scheme_Object **a = NULL;
@ -62,7 +64,7 @@ static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len)
"character vector", -1, 0, &vec));
for (a = SCHEME_VEC_ELS(vec), i = 0; i < len; i++)
a[i] = WITH_VAR_STACK(scheme_make_char(r[i]));
a[i] = WITH_VAR_STACK(scheme_make_ascii_character(r[i+delta]));
READY_TO_RETURN;
@ -70,10 +72,10 @@ static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len)
}
@MACRO setNULL = NULL
@MACRO arrayToVector = p[POFFSET] = ArrayToVector(x0, NULL, x1);
@MACRO copyArrayToVector = ArrayToVector(x0, p[POFFSET], x1);
@MACRO vectorToArray = x0 = VectorToArray(NULL, p[POFFSET], &x1);
@MACRO copyVectorToArray = VectorToArray(x0, p[POFFSET], &x1);
@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 copyVectorToArray = VectorToArray(x0, p[POFFSET], &x1, x2);
@CREATOR ();
@ -81,7 +83,7 @@ static Scheme_Object *ArrayToVector(char *r, Scheme_Object *vec, long len)
@ V "seek" : void Seek(nnlong);
@ V "skip" : void Skip(nnlong);
@ V "bad?" : bool Bad(); : : : rZERO
@ V "read" : long Read(char[]/setNULL/setNULL////push,-long); : /arrayToVector/copyVectorToArray : /vectorToArray/copyArrayToVector : rZERO
@ V "read" : long Read(char[]/setNULL/setNULL////push,-long,-long); : /arrayToVector/copyVectorToArray : /vectorToArray/copyArrayToVector : rZERO
@END
@ -178,6 +180,8 @@ static double GetInexact(wxMediaStreamIn *s)
@ "tell" : long Tell();
@ "jump-to" : void JumpTo(nnlong);
@ "pretty-finish" : void PrettyFinish();
@ "ok?" : bool Ok();
@END

8
src/mzscheme/configure.ac
View File

@ -551,6 +551,14 @@ if test "$inline" = "no" ; then
fi
AC_MSG_RESULT($inline)
AC_MSG_CHECKING([for nl_langinfo (CODESET)])
AC_TRY_LINK([#include <langinfo.h>],
[char *codeset = nl_langinfo (CODESET);],
AC_DEFINE(HAVE_CODESET,1,[Have nl_langinfo (CODESET)])
have_codeset=yes,
have_codeset=no)
AC_MSG_RESULT($have_codeset)
iconv_lib_flag=""
if test "${enable_iconv}" = "yes" ; then
AC_CHECK_HEADER(iconv.h, enable_iconv=yes, enable_iconv=no)

1
src/mzscheme/include/mzscheme.exp
View File

@ -395,6 +395,7 @@ scheme_set_type_printer
scheme_print_bytes
scheme_print_utf8
scheme_print_string
scheme_read_byte_string
scheme_make_namespace
scheme_add_namespace_option
scheme_require_from_original_env

1
src/mzscheme/include/mzscheme3m.exp
View File

@ -402,6 +402,7 @@ scheme_set_type_printer
scheme_print_bytes
scheme_print_utf8
scheme_print_string
scheme_read_byte_string
scheme_make_namespace
scheme_add_namespace_option
scheme_require_from_original_env

1
src/mzscheme/include/mzwin.def
View File

@ -387,6 +387,7 @@ EXPORTS
scheme_print_bytes
scheme_print_utf8
scheme_print_string
scheme_read_byte_string
scheme_make_namespace
scheme_add_namespace_option
scheme_require_from_original_env

4
src/mzscheme/mzconfig.h.in
View File

@ -16,3 +16,7 @@
/* The size of a `long long', as computed by sizeof. */
#undef SIZEOF_LONG_LONG
/* whether nl_langinfo works */
#undef HAVE_CODESET

2056
src/mzscheme/src/cstartup.inc
View File

File diff suppressed because it is too large Load Diff

33
src/mzscheme/src/read.c
View File

@ -141,7 +141,7 @@ static Scheme_Object *read_string(int is_byte, int is_honu_char,
long line, long col, long pos,
Scheme_Hash_Table **ht,
Scheme_Object *indentation,
ReadParams *params);
ReadParams *params, int err_ok);
static Scheme_Object *read_here_string(Scheme_Object *port, Scheme_Object *stxsrc,
long line, long col, long pos,
Scheme_Object *indentation,
@ -873,10 +873,10 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
case '|':
return read_symbol(ch, port, stxsrc, line, col, pos, ht, indentation, params, table);
case '"':
return read_string(0, 0, port, stxsrc, line, col, pos, ht, indentation, params);
return read_string(0, 0, port, stxsrc, line, col, pos, ht, indentation, params, 1);
case '\'':
if (params->honu_mode) {
return read_string(0, 1, port, stxsrc, line, col, pos, ht, indentation, params);
return read_string(0, 1, port, stxsrc, line, col, pos, ht, indentation, params, 1);
} else {
return read_quote("quoting '", quote_symbol, 1, port, stxsrc, line, col, pos, ht, indentation, params);
}
@ -1240,7 +1240,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
/* Skip #rx[#]: */
scheme_tell_all(port, &line, &col, &pos);
str = read_string(is_byte, 0, port, stxsrc, line, col, pos, ht, indentation, params);
str = read_string(is_byte, 0, port, stxsrc, line, col, pos, ht, indentation, params, 1);
if (stxsrc)
str = SCHEME_STX_VAL(str);
@ -1428,7 +1428,7 @@ read_inner_inner(Scheme_Object *port, Scheme_Object *stxsrc, Scheme_Hash_Table *
break;
case '"':
if (!params->honu_mode) {
return read_string(1, 0, port, stxsrc, line, col, pos, ht, indentation, params);
return read_string(1, 0, port, stxsrc, line, col, pos, ht, indentation, params, 1);
}
break;
case '<':
@ -2343,7 +2343,8 @@ static Scheme_Object *
read_string(int is_byte, int is_honu_char, Scheme_Object *port,
Scheme_Object *stxsrc, long line, long col, long pos,
Scheme_Hash_Table **ht,
Scheme_Object *indentation, ReadParams *params)
Scheme_Object *indentation, ReadParams *params,
int err_ok)
{
mzchar *buf, *oldbuf, onstack[32];
int i, j, n, n1, ch, closer = (is_honu_char ? '\'' : '"');
@ -2354,6 +2355,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
buf = onstack;
while ((ch = scheme_getc_special_ok(port)) != closer) {
if ((ch == EOF) || (is_honu_char && (i > 0))) {
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), ch, indentation,
"read: expected a closing %s%s",
is_honu_char ? "'" : "'\"'",
@ -2361,6 +2363,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
return NULL;
} else if (ch == SCHEME_SPECIAL) {
scheme_get_ready_read_special(port, stxsrc, ht);
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), SCHEME_SPECIAL, indentation,
"read: found non-character while reading a %s",
is_honu_char ? "character constant" : "string");
@ -2371,12 +2374,14 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
if (ch == '\\') {
ch = scheme_getc_special_ok(port);
if (ch == EOF) {
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), EOF, indentation,
"read: expected a closing %s",
is_honu_char ? "'" : "'\"'");
return NULL;
} else if (ch == SCHEME_SPECIAL) {
scheme_get_ready_read_special(port, stxsrc, ht);
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), SCHEME_SPECIAL, indentation,
"read: found non-character while reading a %s",
is_honu_char ? "character constant" : "string");
@ -2411,6 +2416,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
} else {
if (ch == SCHEME_SPECIAL)
scheme_get_ready_read_special(port, stxsrc, ht);
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), ch, indentation,
"read: no hex digit following \\x in %s",
is_honu_char ? "character constant" : "string");
@ -2444,6 +2450,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
} else {
if (ch == SCHEME_SPECIAL)
scheme_get_ready_read_special(port, stxsrc, ht);
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), ch, indentation,
"read: no hex digit following \\%c in %s",
((maxc == 4) ? 'u' : 'U'),
@ -2457,6 +2464,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
for (n = j = 0; j < 3; j++) {
n1 = 8*n + ch - '0';
if (n1 > 255) {
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), 0, indentation,
"read: escape sequence \\%o out of range in %s", n1,
is_honu_char ? "character constant" : "string");
@ -2474,6 +2482,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
}
ch = n;
} else {
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), 0, indentation,
"read: unknown escape sequence \\%c in %s%s", ch,
is_byte ? "byte " : "",
@ -2498,6 +2507,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
}
if (ch < 0) {
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, SPAN(port, pos), 0, indentation,
"read: out-of-range character in %s%s",
is_byte ? "byte " : "",
@ -2521,6 +2531,7 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
if (i)
result = scheme_make_character(buf[0]);
else {
if (err_ok)
scheme_read_err(port, stxsrc, line, col, pos, 2, 0, indentation,
"read: expected one character before closing '");
return NULL;
@ -2543,6 +2554,16 @@ read_string(int is_byte, int is_honu_char, Scheme_Object *port,
return result;
}
Scheme_Object *scheme_read_byte_string(Scheme_Object *port)
/* used by MrEd */
{
return read_string(1, 0, port,
NULL, 0, 0, 0,
NULL,
NULL, NULL,
0);
}
static Scheme_Object *
read_here_string(Scheme_Object *port, Scheme_Object *stxsrc,
long line, long col, long pos,

2
src/mzscheme/src/schemef.h
View File

@ -783,6 +783,8 @@ MZ_EXTERN void scheme_print_bytes(Scheme_Print_Params *pp, const char *str, int
MZ_EXTERN void scheme_print_utf8(Scheme_Print_Params *pp, const char *str, int offset, int len);
MZ_EXTERN void scheme_print_string(Scheme_Print_Params *pp, const mzchar *str, int offset, int len);
MZ_EXTERN Scheme_Object *scheme_read_byte_string(Scheme_Object *port);
/*========================================================================*/
/* namespace/environment */
/*========================================================================*/

1
src/mzscheme/src/schemex.h
View File

@ -651,6 +651,7 @@ void (*scheme_set_type_printer)(Scheme_Type stype, Scheme_Type_Printer printer);
void (*scheme_print_bytes)(Scheme_Print_Params *pp, const char *str, int offset, int len);
void (*scheme_print_utf8)(Scheme_Print_Params *pp, const char *str, int offset, int len);
void (*scheme_print_string)(Scheme_Print_Params *pp, const mzchar *str, int offset, int len);
Scheme_Object *(*scheme_read_byte_string)(Scheme_Object *port);
/*========================================================================*/
/* namespace/environment */
/*========================================================================*/

1
src/mzscheme/src/schemex.inc
View File

@ -444,6 +444,7 @@
scheme_extension_table->scheme_print_bytes = scheme_print_bytes;
scheme_extension_table->scheme_print_utf8 = scheme_print_utf8;
scheme_extension_table->scheme_print_string = scheme_print_string;
scheme_extension_table->scheme_read_byte_string = scheme_read_byte_string;
scheme_extension_table->scheme_make_namespace = scheme_make_namespace;
scheme_extension_table->scheme_add_namespace_option = scheme_add_namespace_option;
scheme_extension_table->scheme_require_from_original_env = scheme_require_from_original_env;

1
src/mzscheme/src/schemexm.h
View File

@ -444,6 +444,7 @@
#define scheme_print_bytes (scheme_extension_table->scheme_print_bytes)
#define scheme_print_utf8 (scheme_extension_table->scheme_print_utf8)
#define scheme_print_string (scheme_extension_table->scheme_print_string)
#define scheme_read_byte_string (scheme_extension_table->scheme_read_byte_string)
#define scheme_make_namespace (scheme_extension_table->scheme_make_namespace)
#define scheme_add_namespace_option (scheme_extension_table->scheme_add_namespace_option)
#define scheme_require_from_original_env (scheme_extension_table->scheme_require_from_original_env)

2
src/mzscheme/src/schminc.h
View File

@ -11,7 +11,7 @@
EXPECTED_PRIM_COUNT to the new value, and then USE_COMPILED_STARTUP
can be set to 1 again. */
#define USE_COMPILED_STARTUP 0
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 844

4
src/mzscheme/src/schvers.h
View File

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

7
src/mzscheme/src/string.c
View File

@ -75,6 +75,8 @@ static int get_iconv_errno(void)
a = msvcrt_errno();
return *a;
}
# undef HAVE_CODESET
# define HAVE_CODESET 1
# define CODESET 0
# define ICONV_errno get_iconv_errno()
static int iconv_ready = 0;
@ -2143,7 +2145,12 @@ static Scheme_Object *locale_string_encoding(int argc, Scheme_Object *argv[])
if (mzLOCALE_IS_UTF_8(current_locale_name) || !locale_on)
return scheme_make_utf8_string("UTF-8");
#if HAVE_CODESET
return scheme_make_utf8_string(nl_langinfo(CODESET));
#else
/* nl_langinfo doesn't work, so just make up something */
return scheme_make_utf8_string("UTF-8");
#endif
}
#ifndef DONT_USE_LOCALE

4
src/worksp-vc70/mzconfig.h
View File

@ -20,3 +20,7 @@
/* The size of a `long long', as computed by sizeof. */
#undef SIZEOF_LONG_LONG
/* whether nl_langinfo works */
#undef HAVE_CODESET

4
src/worksp/mzconfig.h
View File

@ -20,3 +20,7 @@
/* The size of a `long long', as computed by sizeof. */
#undef SIZEOF_LONG_LONG
/* whether nl_langinfo works */
#undef HAVE_CODESET

10
src/wxcommon/PSDC.cxx
View File

@ -1265,7 +1265,7 @@ void wxPostScriptDC::DrawText(DRAW_TEXT_CONST char *text, double x, double y,
{
double tw, th;
const char *name;
int size, sym_map;
int sym_map;
if (!pstream)
return;
@ -1359,8 +1359,6 @@ void wxPostScriptDC::DrawText(DRAW_TEXT_CONST char *text, double x, double y,
name = "Times-Roman";
}
size = current_font->GetPointSize();
if (angle != 0.0) {
pstream->Out("gsave\n");
}
@ -1372,11 +1370,9 @@ void wxPostScriptDC::DrawText(DRAW_TEXT_CONST char *text, double x, double y,
pstream->Out(user_scale_x); pstream->Out(" "); pstream->Out(user_scale_y); pstream->Out(" scale\n");
}
pstream->Out(angle * 180 / pie);
pstream->Out(" rotate 0 ");
pstream->Out(-size);
pstream->Out(" moveto\n");
pstream->Out(" rotate 0 0 moveto\n");
} else {
pstream->Out(XSCALE(x)); pstream->Out(" "); pstream->Out(YSCALE(y + size));
pstream->Out(XSCALE(x)); pstream->Out(" "); pstream->Out(YSCALE(y));
pstream->Out(" moveto\n");
if ((user_scale_x != 1) || (user_scale_y != 1)) {
pstream->Out("gsave\n");

8
src/wxwindow/src/msw/wx_clipb.cxx
View File

@ -238,8 +238,12 @@ wxObject *wxGetClipboardData(int dataFormat, long *len)
GlobalUnlock(hGlobalMemory);
if ((dataFormat == CF_UNICODETEXT)
&& !(hsize & 0x1)) {
if (dataFormat == CF_UNICODETEXT) {
if (hsize & 0x1) {
/* Why is a UTF-16 encoding odd sized? Try
dropping a byte. */
s[hsize - 1] = 0;
}
s = wxNARROW_STRING((wchar_t *)s);
}