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

369.11

Browse Source 
svn: r6085
This commit is contained in:
Matthew Flatt 2007-04-29 02:08:24 +00:00
parent 62954f2d27
commit e9bf34f193
39 changed files with 3905 additions and 3647 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
collects/framework/private/group.ss
View File

@ -94,7 +94,9 @@
(new menu:can-restore-menu-item%
[label (string-constant zoom)]
[parent menu]
[callback (λ (x y) (send (send (send menu get-parent) get-frame) maximize #t))])
[callback (λ (x y)
(let ([frame (send (send menu get-parent) get-frame)])
(send frame maximize (not (send frame is-maximized?)))))])
(make-object separator-menu-item% menu))
(instantiate menu:can-restore-menu-item% ()
(label (string-constant bring-frame-to-front...))

1
collects/mred/private/kernel.ss
View File

@ -537,6 +537,7 @@
system-menu
set-modified
create-status-line
is-maximized?
maximize
status-line-exists?
iconized?

1
collects/mred/private/mrtop.ss
View File

@ -174,6 +174,7 @@
[(i b) (send wx set-icon i b)]
[(i b l?) (send wx set-icon i b l?)])]
[maximize (entry-point (lambda (on?) (send wx position-for-initial-show) (send wx maximize on?)))]
[is-maximized? (entry-point (lambda () (send wx is-maximized?)))]
[get-menu-bar (entry-point (lambda () (let ([mb (send wx get-the-menu-bar)])
(and mb (wx->mred mb)))))]
[modified (entry-point

26
collects/mzlib/private/unit-compiletime.ss
View File

@ -449,6 +449,8 @@
(λ (k v)
(unless (hash-table-get used-binding-table k (λ () #f))
(raise-stx-err "this export is not supplied by the given unit" v))))))
(define (name-form n) (syntax-object->datum n))
;; complete-imports : (hash-tableof symbol (or identifier 'duplicate))
;; (listof link-record)
@ -483,10 +485,10 @@
[(eq? 'duplicate there?)
(raise-stx-err
(if tag
(format "Specified linkages satisfy (tag ~a ~a) import multiple times"
tag (car (siginfo-names (link-record-siginfo import))))
(format "Specified linkages satisfy untagged ~a import multiple times"
(car (siginfo-names (link-record-siginfo import)))))
(format "specified linkages satisfy (tag ~a ~a) import multiple times"
tag (name-form (car (siginfo-names (link-record-siginfo import)))))
(format "specified linkages satisfy untagged ~a import multiple times"
(name-form (car (siginfo-names (link-record-siginfo import))))))
src)]
[there?
(loop (cdr unit-imports))]
@ -498,10 +500,10 @@
[(eq? 'duplicate there?2)
(raise-stx-err
(if tag
(format "Multiple linkages satisfy (tag ~a ~a) import"
tag (car (siginfo-names (link-record-siginfo import))))
(format "Multiple linkages satisfy untagged ~a import"
(car (siginfo-names (link-record-siginfo import)))))
(format "multiple linkages satisfy (tag ~a ~a) import"
tag (name-form (car (siginfo-names (link-record-siginfo import)))))
(format "multiple linkages satisfy untagged ~a import"
(name-form (car (siginfo-names (link-record-siginfo import))))))
src)]
[there?2
(for-each
@ -518,10 +520,10 @@
[else
(raise-stx-err
(if tag
(format "No linkages satisfy (tag ~a ~a) import"
tag (car (siginfo-names (link-record-siginfo import))))
(format "No linkages satisfy untagged ~a import"
(car (siginfo-names (link-record-siginfo import)))))
(format "no linkages satisfy (tag ~a ~a) import"
tag (name-form (car (siginfo-names (link-record-siginfo import)))))
(format "no linkages satisfy untagged ~a import"
(name-form (car (siginfo-names (link-record-siginfo import))))))
src)]))]))]))))
(define (unprocess-link-record-bind lr)

5
collects/mzlib/unit.ss
View File

@ -1581,12 +1581,15 @@
(syntax-case stx () ((_ . x) #'x))))))
u))
(define-syntax/err-param (define-compound-unit/infer stx)
(define-for-syntax (do-define-compound-unit/infer stx)
(build-define-unit stx
(lambda (clause)
(build-compound-unit/infer (check-compound/infer-syntax clause)))
"missing unit name"))
(define-syntax/err-param (define-compound-unit/infer stx)
(do-define-compound-unit/infer stx))
(define-syntax/err-param (invoke-unit stx)
(syntax-case stx (import)
((_ unit)

29
collects/tests/mred/editor.ss
View File

@ -486,6 +486,35 @@
(st es pb find-first-snip)
(st #t es is-owned?))
;; ----------------------------------------
;; edit-sequences and undo
(let ([t (new text%)])
(send t set-max-undo-history 100)
(send t begin-edit-sequence)
(send t begin-edit-sequence)
(send t insert "abcd\n")
(send t set-modified #f)
(send t end-edit-sequence)
(send t delete 0 1)
(send t end-edit-sequence)
(send t undo)
(st "" t get-text))
(let ([t (new text%)])
(send t set-max-undo-history 100)
(send t begin-edit-sequence)
(send t begin-edit-sequence)
(send t insert "abcd\n")
(send t end-edit-sequence)
(send t set-position 0 1)
(send t delete)
(send t set-position 0 1)
(send t delete)
(send t end-edit-sequence)
(send t undo)
(st "" t get-text))
;; ----------------------------------------
(report-errs)

22
collects/tests/mzscheme/file.ss
View File

@ -177,20 +177,34 @@
(write '((0 54609) (1 32874234)) os)
(file-position os 2)
(file-position os eof)
(test #"((0 54609) (1 32874234))" get-output-bytes os))
(test #"((0 54609) (1 32874234))" get-output-bytes os)
(test #"((0 54" get-output-bytes os #f 0 6)
(test #"0 54609) (1 32874234))" get-output-bytes os #f 2)
(test #"0 54609) (1 32874234))" get-output-bytes os #f 2 #f)
(test #"0 546" get-output-bytes os #f 2 7)
(test #"((0 54609) (1 32874234))" get-output-bytes os #t)
(test #"" get-output-bytes os))
(let ([os (open-output-string)])
(write '1234 os)
(file-position os 10)
(write 'z os)
(test #"1234\0\0\0\0\0\0z" get-output-bytes os))
(test #"1234\0\0\0\0\0\0z" get-output-bytes os)
(file-position os 5)
(test #"1234\0\0\0\0\0\0z" get-output-bytes os)
(test #"1234\0" get-output-bytes os #f 0 (file-position os))
(test #"34\0\0\0\0\0\0z" get-output-bytes os #f 2 #f)
(test #"34\0\0\0\0\0\0z" get-output-bytes os #t 2 #f)
(test #"" get-output-bytes os #t 0 #f))
(let ([os (open-output-string)])
(write '1234 os)
(file-position os 10)
(file-position os eof)
(write 'z os)
(test #"1234\0\0\0\0\0\0z" get-output-bytes os))
(test #"1234\0\0\0\0\0\0z" get-output-bytes os)
(test #"23" get-output-bytes os #t 1 3)
(test #"" get-output-bytes os #f 0 #f))
(define s (open-output-string))
(err/rt-test (file-position 's 1))
@ -448,7 +462,7 @@
(arity-test open-output-bytes 0 1)
(arity-test open-input-bytes 1 2)
(arity-test get-output-bytes 1 1)
(arity-test get-output-bytes 1 4)
(test 75 object-name (open-input-string "x" 75))
(test 76 object-name (open-input-bytes #"x" 76))

5
doc/release-notes/mred/HISTORY
View File

@ -1,3 +1,8 @@
Version 369.11
Added is-maximized? method to frame% (Windows, Mac OS X)
Version 369.10
Improved the disabled appearance of some controls under Mac OS X

4
doc/release-notes/mzscheme/HISTORY
View File

@ -1,3 +1,7 @@
Version 369.11
Added reset?, start-, and end-index arguments to get-output-bytes
Added custodian-memory-accounting-available?
Version 369.10
Added parameterize*
Added module-path-index-resolve

12
src/configure vendored
View File

@ -1426,9 +1426,9 @@ else
enable_llvm=no
fi;
# Check whether --enable-sgc or --disable-sgc was given.
if test "${enable_sgc+set}" = set; then
enableval="$enable_sgc"
# Check whether --enable-cgcdefault or --disable-cgcdefault was given.
if test "${enable_cgcdefault+set}" = set; then
enableval="$enable_cgcdefault"
fi;
# Check whether --enable-sgc or --disable-sgc was given.
@ -5363,6 +5363,7 @@ case $OS in
esac
;;
AIX)
enable_cgcdefault="yes"
EXTRALIBS="-Wl,-brtl,-bE:\$(srcdir)/../mzscheme/include/mzscheme.exp"
;;
FreeBSD)
@ -5376,6 +5377,7 @@ case $OS in
LIBS="$LIBS -rdynamic"
;;
IRIX)
enable_cgcdefault="yes"
STATICLINK="/usr/lib/libC.a /usr/lib/libmalloc.a"
if test "$X_PRE_LIBS" = " -lSM -lICE" ; then
# For some reason, works best to drop these
@ -5399,6 +5401,7 @@ case $OS in
esac
;;
OSF1)
enable_cgcdefault="yes"
if test "$CC" = "cc" ; then
COMPFLAGS="$COMPFLAGS -ieee_with_inexact -assume noaligned_objects"
elif test "$CC" = "gcc" ; then
@ -5406,6 +5409,7 @@ case $OS in
fi
;;
HP-UX)
enable_cgcdefault="yes"
if test "$CC" = "gcc"; then
COMPFLAGS="$COMPFLAGS -fPIC"
else
@ -5421,6 +5425,7 @@ case $OS in
X_LIBS="-L/usr/contrib/X11R6/lib/ $X_LIBS"
;;
CYGWIN*)
enable_cgcdefault="yes"
MZINSTALLTARGET=unix-cygwin-install
if test "${enable_shared}" = "yes" ; then
ar_libtool_no_undefined=" -no-undefined"
@ -5430,6 +5435,7 @@ case $OS in
EXE_SUFFIX=".exe"
;;
BeOS)
enable_cgcdefault="yes"
if test "${enable_sgcdebug}" = "yes" ; then
dummyvar=""
else

2
src/mred/gc2/Makefile.in
View File

@ -208,7 +208,7 @@ MACXPRECOMP = macxsrc/xform_precomp.h
macxsrc/xform_precomp.h : $(XFORMDEP) $(srcdir)/macprecomp.cxx $(srcdir)/../../mzscheme/src/schvers.h
env XFORM_PRECOMP=yes $(XFORM) $(MACXPRECOMP) $(srcdir)/macprecomp.cxx
@INCLUDEDEP@ macprecomp.d
@INCLUDEDEP@ macprecomp.dd
wx_xt_XFORMWP = $(XFORMXX)
wx_mac_XFORMWP = env XFORM_USE_PRECOMP=$(MACXPRECOMP) $(XFORMXX)

21
src/mred/gc2/gen-deps.ss
View File

@ -22,5 +22,22 @@
(unless (eof-object? l)
(printf "~a\n" l)
(loop)))))))
'truncate)))))))
(directory-list))
'truncate/replace)))))))
(directory-list))
(when (file-exists? "macprecomp.d")
(with-input-from-file "macprecomp.d"
(lambda ()
(with-output-to-file "macprecomp.dd"
(lambda ()
(when (regexp-match #rx"^macprecomp[.]o"
(current-input-port)
0 #f
(current-output-port))
(printf "macxsrc/xform_precomp.h"))
(let loop ()
(let ([c (read-char)])
(unless (eof-object? c)
(write-char c)
(loop)))))
'truncate/replace))))

24
src/mred/wxs/wxs_fram.cxx
View File

@ -1099,6 +1099,27 @@ static Scheme_Object *os_wxFrameCreateStatusLine(int n, Scheme_Object *p[])
return scheme_void;
}
static Scheme_Object *os_wxFrameIsMaximized(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
REMEMBER_VAR_STACK();
Bool r;
objscheme_check_valid(os_wxFrame_class, "is-maximized? in frame%", n, p);
SETUP_VAR_STACK_REMEMBERED(1);
VAR_STACK_PUSH(0, p);
r = WITH_VAR_STACK(((wxFrame *)((Scheme_Class_Object *)p[0])->primdata)->IsMaximized());
READY_TO_RETURN;
return (r ? scheme_true : scheme_false);
}
static Scheme_Object *os_wxFrameMaximize(int n, Scheme_Object *p[])
{
WXS_USE_ARGUMENT(n) WXS_USE_ARGUMENT(p)
@ -1383,7 +1404,7 @@ void objscheme_setup_wxFrame(Scheme_Env *env)
wxREGGLOB(os_wxFrame_class);
os_wxFrame_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "frame%", "window%", (Scheme_Method_Prim *)os_wxFrame_ConstructScheme, 26));
os_wxFrame_class = WITH_VAR_STACK(objscheme_def_prim_class(env, "frame%", "window%", (Scheme_Method_Prim *)os_wxFrame_ConstructScheme, 27));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "on-drop-file" " method", (Scheme_Method_Prim *)os_wxFrameOnDropFile, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "pre-on-event" " method", (Scheme_Method_Prim *)os_wxFramePreOnEvent, 2, 2));
@ -1402,6 +1423,7 @@ void objscheme_setup_wxFrame(Scheme_Env *env)
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "system-menu" " method", (Scheme_Method_Prim *)os_wxFrameframeMenu, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "set-modified" " method", (Scheme_Method_Prim *)os_wxFrameSetFrameModified, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "create-status-line" " method", (Scheme_Method_Prim *)os_wxFrameCreateStatusLine, 0, 2));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "is-maximized?" " method", (Scheme_Method_Prim *)os_wxFrameIsMaximized, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "maximize" " method", (Scheme_Method_Prim *)os_wxFrameMaximize, 1, 1));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "status-line-exists?" " method", (Scheme_Method_Prim *)os_wxFrameStatusLineExists, 0, 0));
WITH_VAR_STACK(scheme_add_method_w_arity(os_wxFrame_class, "iconized?" " method", (Scheme_Method_Prim *)os_wxFrameIconized, 0, 0));

1
src/mred/wxs/wxs_fram.xc
View File

@ -95,6 +95,7 @@ static void DesignateRootFrame(wxFrame *f)
@ "iconized?" : bool Iconized();
@ "status-line-exists?" : bool StatusLineExists();
@ "maximize" : void Maximize(bool)
@ "is-maximized?" : bool IsMaximized()
@ "create-status-line" : void CreateStatusLine(int = 1, string = "status_line")
@ "set-modified" : void SetFrameModified(bool)

2
src/mysterx/htmlevent.cxx
View File

@ -183,7 +183,7 @@ Scheme_Object *mx_event_x(int argc,Scheme_Object **argv) {
long x;
IEvent *ev;
getEventInterface(argv[0],"mx-event-x");
ev = getEventInterface(argv[0],"mx-event-x");
ev->get_x(&x);
return scheme_make_integer(x);

8
src/mzscheme/configure.ac
View File

@ -42,7 +42,7 @@ AC_ARG_ENABLE(origtree,[ --enable-origtree install with original director
AC_ARG_ENABLE(foreign, [ --enable-foreign compile foreign support (enabled by default)], , enable_foreign=yes)
AC_ARG_ENABLE(llvm, [ --enable-llvm compile llvm support (disabled by default)], , enable_llvm=no)
AC_ARG_ENABLE(sgc, [ --enable-cgcdefault use CGC (Boehm or Senora) as default build])
AC_ARG_ENABLE(cgcdefault, [ --enable-cgcdefault use CGC (Boehm or Senora) as default build])
AC_ARG_ENABLE(sgc, [ --enable-sgc use Senora GC instead of the Boehm GC])
AC_ARG_ENABLE(sgcdebug,[ --enable-sgcdebug use Senora GC for debugging])
AC_ARG_ENABLE(account, [ --enable-account 3m: use memory-accounting GC (enabled by default)], , enable_account=yes)
@ -492,6 +492,7 @@ case $OS in
esac
;;
AIX)
enable_cgcdefault="yes"
EXTRALIBS="-Wl,-brtl,-bE:\$(srcdir)/../mzscheme/include/mzscheme.exp"
;;
FreeBSD)
@ -505,6 +506,7 @@ case $OS in
LIBS="$LIBS -rdynamic"
;;
IRIX)
enable_cgcdefault="yes"
STATICLINK="/usr/lib/libC.a /usr/lib/libmalloc.a"
if test "$X_PRE_LIBS" = " -lSM -lICE" ; then
# For some reason, works best to drop these
@ -528,6 +530,7 @@ case $OS in
esac
;;
OSF1)
enable_cgcdefault="yes"
if test "$CC" = "cc" ; then
COMPFLAGS="$COMPFLAGS -ieee_with_inexact -assume noaligned_objects"
elif test "$CC" = "gcc" ; then
@ -535,6 +538,7 @@ case $OS in
fi
;;
HP-UX)
enable_cgcdefault="yes"
if test "$CC" = "gcc"; then
COMPFLAGS="$COMPFLAGS -fPIC"
else
@ -550,6 +554,7 @@ case $OS in
X_LIBS="-L/usr/contrib/X11R6/lib/ $X_LIBS"
;;
CYGWIN*)
enable_cgcdefault="yes"
MZINSTALLTARGET=unix-cygwin-install
if test "${enable_shared}" = "yes" ; then
ar_libtool_no_undefined=" -no-undefined"
@ -559,6 +564,7 @@ case $OS in
EXE_SUFFIX=".exe"
;;
BeOS)
enable_cgcdefault="yes"
if test "${enable_sgcdebug}" = "yes" ; then
dummyvar=""
else

5
src/mzscheme/gc2/sighand.c
View File

@ -23,8 +23,9 @@ void fault_handler(int sn, struct siginfo *si, void *ctx)
}
#endif
/* ========== FreeBSD signal handler ========== */
#if defined(__FreeBSD__)
/* ========== FreeBSD/NetBSD/OpenBSD signal handler ========== */
/* As of 2007/04/28, this is a guess for NetBSD and OpenBSD! */
#if defined(__FreeBSD__) || defined(__NetBSD__) || defined(__OpenBSD__)
# include <signal.h>
void fault_handler(int sn, siginfo_t *si, void *ctx)
{

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

@ -392,6 +392,7 @@ scheme_make_byte_string_input_port
scheme_make_sized_byte_string_input_port
scheme_make_byte_string_output_port
scheme_get_sized_byte_string_output
scheme_get_reset_sized_byte_string_output
scheme_pipe
scheme_pipe_with_limit
scheme_make_null_output_port

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

@ -402,6 +402,7 @@ scheme_make_byte_string_input_port
scheme_make_sized_byte_string_input_port
scheme_make_byte_string_output_port
scheme_get_sized_byte_string_output
scheme_get_reset_sized_byte_string_output
scheme_pipe
scheme_pipe_with_limit
scheme_make_null_output_port

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

@ -380,6 +380,7 @@ EXPORTS
scheme_make_sized_byte_string_input_port
scheme_make_byte_string_output_port
scheme_get_sized_byte_string_output
scheme_get_reset_sized_byte_string_output
scheme_pipe
scheme_pipe_with_limit
scheme_make_null_output_port

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

@ -394,6 +394,7 @@ EXPORTS
scheme_make_sized_byte_string_input_port
scheme_make_byte_string_output_port
scheme_get_sized_byte_string_output
scheme_get_reset_sized_byte_string_output
scheme_pipe
scheme_pipe_with_limit
scheme_make_null_output_port

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

File diff suppressed because it is too large Load Diff

84
src/mzscheme/src/portfun.c
View File

@ -299,7 +299,7 @@ scheme_init_port_fun(Scheme_Env *env)
scheme_add_global_constant("get-output-bytes",
scheme_make_prim_w_arity(get_output_byte_string,
"get-output-bytes",
1, 1),
1, 4),
env);
scheme_add_global_constant("get-output-string",
scheme_make_prim_w_arity(get_output_char_string,
@ -1083,7 +1083,7 @@ scheme_make_byte_string_output_port (void)
}
char *
scheme_get_sized_byte_string_output(Scheme_Object *port, long *size)
scheme_get_reset_sized_byte_string_output(Scheme_Object *port, long *size, int reset, long startpos, long endpos)
{
Scheme_Output_Port *op;
Scheme_Indexed_String *is;
@ -1103,8 +1103,28 @@ scheme_get_sized_byte_string_output(Scheme_Object *port, long *size)
if (is->u.hot > len)
len = is->u.hot;
v = (char *)scheme_malloc_atomic(len + 1);
memcpy(v, is->string, len);
if (endpos < 0)
endpos = len;
if (reset) {
char *ca;
v = is->string;
is->size = 31;
ca = (char *)scheme_malloc_atomic((is->size) + 1);
is->string = ca;
is->index = 0;
is->u.hot = 0;
if ((startpos > 0) || (endpos < len)) {
len = endpos - startpos;
ca = (char *)scheme_malloc_atomic(len + 1);
memcpy(ca, v XFORM_OK_PLUS startpos, len);
v = ca;
}
} else {
len = endpos - startpos;
v = (char *)scheme_malloc_atomic(len + 1);
memcpy(v, is->string XFORM_OK_PLUS startpos, len);
}
v[len] = 0;
if (size)
@ -1113,6 +1133,12 @@ scheme_get_sized_byte_string_output(Scheme_Object *port, long *size)
return v;
}
char *
scheme_get_sized_byte_string_output(Scheme_Object *port, long *size)
{
return scheme_get_reset_sized_byte_string_output(port, size, 0, 0, -1);
}
char *
scheme_get_string_output(Scheme_Object *port)
{
@ -2783,17 +2809,61 @@ Scheme_Object *do_get_output_string(const char *who, int is_byte,
{
Scheme_Output_Port *op;
char *s;
long size;
long size, startpos, endpos;
op = scheme_output_port_record(argv[0]);
if (!SCHEME_OUTPUT_PORTP(argv[0])
|| (op->sub_type != scheme_string_output_port_type))
scheme_wrong_type(who, "string output port", 0, argc, argv);
s = scheme_get_sized_byte_string_output(argv[0], &size);
if (argc > 2) {
long len;
Scheme_Indexed_String *is;
is = (Scheme_Indexed_String *)op->port_data;
len = is->index;
if (is->u.hot > len)
len = is->u.hot;
startpos = scheme_extract_index(who, 2, argc, argv, len+1, 0);
if (argc > 3) {
if (SCHEME_FALSEP(argv[3]))
endpos = len;
else {
endpos = scheme_extract_index(who, 3, argc, argv, len+1, 1);
if (endpos < 0)
endpos = len+1;
}
if (!(startpos <= len)) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: starting index %V out of range [%d, %d] for port: %V",
who,
argv[2], 0, len,
argv[0]);
return NULL;
}
if (!(endpos >= startpos && endpos <= len)) {
scheme_raise_exn(MZEXN_FAIL_CONTRACT,
"%s: ending index %V out of range [%d, %d] for port: %V",
who,
argv[3], startpos, len,
argv[0]);
return NULL;
}
} else
endpos = -1;
} else {
startpos = 0;
endpos = -1;
}
s = scheme_get_reset_sized_byte_string_output(argv[0], &size,
((argc > 1) && SCHEME_TRUEP(argv[1])),
startpos, endpos);
if (is_byte)
return scheme_make_sized_byte_string(s, size, 1);
return scheme_make_sized_byte_string(s, size, 0);
else
return scheme_make_sized_utf8_string(s, size);
}

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

@ -783,7 +783,8 @@ MZ_EXTERN Scheme_Object *scheme_make_fd_output_port(int fd, Scheme_Object *name,
MZ_EXTERN Scheme_Object *scheme_make_byte_string_input_port(const char *str);
MZ_EXTERN Scheme_Object *scheme_make_sized_byte_string_input_port(const char *str, long len);
MZ_EXTERN Scheme_Object *scheme_make_byte_string_output_port();
MZ_EXTERN char *scheme_get_sized_byte_string_output(Scheme_Object *, long *len);
MZ_EXTERN char *scheme_get_sized_byte_string_output(Scheme_Object *port, long *len);
MZ_EXTERN char *scheme_get_reset_sized_byte_string_output(Scheme_Object *port, long *len, int reset, long startpos, long endpos);
MZ_EXTERN void scheme_pipe(Scheme_Object **read, Scheme_Object **write);
MZ_EXTERN void scheme_pipe_with_limit(Scheme_Object **write, Scheme_Object **read, int maxsize);

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

@ -659,7 +659,8 @@ Scheme_Object *(*scheme_make_fd_output_port)(int fd, Scheme_Object *name, int re
Scheme_Object *(*scheme_make_byte_string_input_port)(const char *str);
Scheme_Object *(*scheme_make_sized_byte_string_input_port)(const char *str, long len);
Scheme_Object *(*scheme_make_byte_string_output_port)();
char *(*scheme_get_sized_byte_string_output)(Scheme_Object *, long *len);
char *(*scheme_get_sized_byte_string_output)(Scheme_Object *port, long *len);
char *(*scheme_get_reset_sized_byte_string_output)(Scheme_Object *port, long *len, int reset, long startpos, long endpos);
void (*scheme_pipe)(Scheme_Object **read, Scheme_Object **write);
void (*scheme_pipe_with_limit)(Scheme_Object **write, Scheme_Object **read, int maxsize);
Scheme_Object *(*scheme_make_null_output_port)(int can_write_special);

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

@ -440,6 +440,7 @@
scheme_extension_table->scheme_make_sized_byte_string_input_port = scheme_make_sized_byte_string_input_port;
scheme_extension_table->scheme_make_byte_string_output_port = scheme_make_byte_string_output_port;
scheme_extension_table->scheme_get_sized_byte_string_output = scheme_get_sized_byte_string_output;
scheme_extension_table->scheme_get_reset_sized_byte_string_output = scheme_get_reset_sized_byte_string_output;
scheme_extension_table->scheme_pipe = scheme_pipe;
scheme_extension_table->scheme_pipe_with_limit = scheme_pipe_with_limit;
scheme_extension_table->scheme_make_null_output_port = scheme_make_null_output_port;

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

@ -440,6 +440,7 @@
#define scheme_make_sized_byte_string_input_port (scheme_extension_table->scheme_make_sized_byte_string_input_port)
#define scheme_make_byte_string_output_port (scheme_extension_table->scheme_make_byte_string_output_port)
#define scheme_get_sized_byte_string_output (scheme_extension_table->scheme_get_sized_byte_string_output)
#define scheme_get_reset_sized_byte_string_output (scheme_extension_table->scheme_get_reset_sized_byte_string_output)
#define scheme_pipe (scheme_extension_table->scheme_pipe)
#define scheme_pipe_with_limit (scheme_extension_table->scheme_pipe_with_limit)
#define scheme_make_null_output_port (scheme_extension_table->scheme_make_null_output_port)

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

@ -13,7 +13,7 @@
#define USE_COMPILED_STARTUP 1
#define EXPECTED_PRIM_COUNT 893
#define EXPECTED_PRIM_COUNT 894
#ifdef MZSCHEME_SOMETHING_OMITTED
# undef USE_COMPILED_STARTUP

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

@ -9,6 +9,6 @@
#define MZSCHEME_VERSION_MAJOR 369
#define MZSCHEME_VERSION_MINOR 10
#define MZSCHEME_VERSION_MINOR 11
#define MZSCHEME_VERSION "369.10" _MZ_SPECIAL_TAG
#define MZSCHEME_VERSION "369.11" _MZ_SPECIAL_TAG

19
src/mzscheme/src/thread.c
View File

@ -275,6 +275,7 @@ static void prepare_this_thread_for_GC(Scheme_Thread *t);
static Scheme_Object *custodian_require_mem(int argc, Scheme_Object *args[]);
static Scheme_Object *custodian_limit_mem(int argc, Scheme_Object *args[]);
static Scheme_Object *custodian_can_mem(int argc, Scheme_Object *args[]);
static Scheme_Object *new_tracking_fun(int argc, Scheme_Object *args[]);
static Scheme_Object *union_tracking_val(int argc, Scheme_Object *args[]);
@ -705,6 +706,11 @@ void scheme_init_thread(Scheme_Env *env)
"custodian-limit-memory",
2, 3),
env);
scheme_add_global_constant("custodian-memory-accounting-available?",
scheme_make_prim_w_arity(custodian_can_mem,
"custodian-memory-accounting-available?",
0, 0),
env);
scheme_add_global_constant("evt?",
@ -901,7 +907,7 @@ static Scheme_Object *custodian_require_mem(int argc, Scheme_Object *args[])
"custodian-require-memory: second custodian is not a sub-custodian of the first custodian");
}
#ifdef MZ_PRECISE_GC
#ifdef NEWGC_BTC_ACCOUNT
if (GC_set_account_hook(MZACCT_REQUIRE, c1, lim, c2))
return scheme_void;
#endif
@ -945,7 +951,7 @@ static Scheme_Object *custodian_limit_mem(int argc, Scheme_Object *args[])
((Scheme_Custodian *)args[2])->has_limit = 1;
}
#ifdef MZ_PRECISE_GC
#ifdef NEWGC_BTC_ACCOUNT
if (GC_set_account_hook(MZACCT_LIMIT, args[0], lim, (argc > 2) ? args[2] : args[0]))
return scheme_void;
#endif
@ -955,6 +961,15 @@ static Scheme_Object *custodian_limit_mem(int argc, Scheme_Object *args[])
return NULL; /* doesn't get here */
}
static Scheme_Object *custodian_can_mem(int argc, Scheme_Object *args[])
{
#ifdef NEWGC_BTC_ACCOUNT
return scheme_true;
#else
return scheme_false;
#endif
}
static Scheme_Object *new_tracking_fun(int argc, Scheme_Object *args[])
{
int retval = 0;

3
src/wxmac/include/base/common.h
View File

@ -173,6 +173,9 @@ enum {
wxSMOOTHING_PARTIAL,
wxSMOOTHING_ON,
wxSMOOTHING_OFF,
wxDIM_OVER = 150,
wxFADE_OVER,
};

1
src/wxmac/include/mac/wx_frame.h
View File

@ -93,6 +93,7 @@ class wxFrame: public wxbFrame
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
virtual void DoSetSize(int x, int y, int width, int height);
void Maximize(Bool maximize);
Bool IsMaximized();
/*+++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ */
/* Status line methods */

5
src/wxmac/src/mac/wx_frame.cc
View File

@ -676,6 +676,11 @@ void wxFrame::Maximize(Bool maximize)
}
}
Bool wxFrame::IsMaximized()
{
return cMaximized;
}
void wxFrame::EnforceSize(int minw, int minh, int maxw, int maxh, int incw, int inch)
{
RgnHandle screen;

3
src/wxwindow/include/base/common.h
View File

@ -184,6 +184,9 @@ enum {
wxSMOOTHING_PARTIAL,
wxSMOOTHING_ON,
wxSMOOTHING_OFF,
wxDIM_OVER = 150,
wxFADE_OVER,
};

1
src/wxwindow/include/msw/wx_frame.h
View File

@ -67,6 +67,7 @@ class wxFrame: public wxbFrame
virtual Bool Iconized(void);
// Windos 3.x maximize/restore
virtual void Maximize(Bool maximize);
virtual Bool IsMaximized();
void PositionStatusWindow(void);
HMENU GetWinMenu(void);

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

@ -556,6 +556,14 @@ Bool wxFrame::Iconized(void)
return (Bool)::IsIconic(GetHWND());
}
Bool wxFrame::IsMaximized()
{
if (IsShown())
return (Bool)::IsZoomed(GetHWND());
else
return hiddenmax;
}
void wxFrame::SetTitle(char *title)
{
if (is_mod) {

5
src/wxxt/src/Windows/Frame.cc
View File

@ -557,6 +557,11 @@ void wxFrame::Maximize(Bool WXUNUSED(maximize))
{
}
Bool wxFrame::IsMaximized()
{
return FALSE;
}
//-----------------------------------------------------------------------------
// status line
//-----------------------------------------------------------------------------

1
src/wxxt/src/Windows/Frame.h
View File

@ -65,6 +65,7 @@ public:
void Iconize(Bool iconize);
Bool Iconized(void);
void Maximize(Bool maximize);
Bool IsMaximized();
// associated GDI objects
wxMenuBar *GetMenuBar(void);
void SetIcon(wxBitmap *icon, wxBitmap *bg = NULL, int kind = 0);

2
src/wxxt/src/wxDefines.h
View File

@ -186,6 +186,8 @@ typedef short int WXTYPE;
#define wxNUM_HATCH (wxVERTICAL - wxBDIAGONAL + 1)
#define wxOPAQUE_STIPPLE 207
#define wxPANEL_PATTERN 208
#define wxDIM_OVER 209
#define wxFADE_OVER 210
#define wxJOIN_BEVEL 0
#define wxJOIN_MITER 1