racket/src/gracket/gracketx.cxx
2010-05-16 23:46:05 -04:00

1016 lines
23 KiB
C++

/*
* File: mredx.cc
* Purpose: GRacket X Windows event loop
* Author: Matthew Flatt
* Created: 1996
* Copyright: (c) 2004-2010 PLT Scheme Inc.
* Copyright: (c) 1996, Matthew Flatt
*/
#define Uses_XtIntrinsic
#define Uses_XtIntrinsicP
#define Uses_XLib
#include "wx_main.h"
#include "wx_win.h"
#include "wx_clipb.h"
#include "scheme.h"
#include "gracket.h"
#include <X11/Shell.h>
static int short_circuit = 0, just_check = 0, checking_for_break = 0;
static Widget just_this_one;
static Widget orig_top_level;
static Widget save_top_level = 0;
static KeyCode breaking_code;
static int breaking_code_set = 0;
static Widget *grab_stack, grabber;
static int grab_stack_pos = 0, grab_stack_size = 0;
#define WSTACK_INC 3
extern Widget wx_clipWindow, wx_selWindow;
Window wxAddClipboardWindowProperty(Atom prop);
extern Atom wx_single_instance_tag;
wxWindow *wxLocationToWindow(int x, int y);
extern "C" {
void wxAddGrab(Widget w)
{
if (!grab_stack_pos) {
Widget *naya;
if (!grab_stack)
wxREGGLOB(grab_stack);
grab_stack_size += WSTACK_INC;
naya = (Widget *)scheme_malloc(grab_stack_size * sizeof(Widget));
memcpy(naya + WSTACK_INC, grab_stack, (grab_stack_size - WSTACK_INC) * sizeof(Widget));
grab_stack = naya;
grab_stack_pos = WSTACK_INC;
}
grabber = grab_stack[--grab_stack_pos] = w;
}
void wxRemoveGrab(Widget w)
{
if (w != grabber)
return;
if (++grab_stack_pos < grab_stack_size)
grabber = grab_stack[grab_stack_pos];
else
grabber = NULL;
}
};
Widget wxGetAppToplevel()
{
if (save_top_level)
return save_top_level;
else {
MrEdContext *c;
c = MrEdGetContext();
return c->finalized->toplevel;
}
}
void wxPutAppToplevel(Widget w)
{
save_top_level = w;
}
void MrEdInitFirstContext(MrEdContext *c)
{
orig_top_level = save_top_level;
c->finalized->toplevel = save_top_level;
save_top_level = 0;
}
void MrEdInitNewContext(MrEdContext *c)
{
wxInitNewToplevel();
c->finalized->toplevel = save_top_level;
save_top_level = 0;
}
void MrEdDestroyContext(MrEdFinalizedContext *c)
{
XtDestroyWidget(c->toplevel);
}
static Window GetEventWindow(XEvent *e)
{
Window window = 0;
#define WINCASEEX(type, record, field) case type: window = e->record.field; break
#define WINCASE(type, record) WINCASEEX(type, record, window)
switch (e->type) {
WINCASE(KeyPress, xkey);
WINCASE(KeyRelease, xkey);
WINCASE(ButtonPress, xbutton);
WINCASE(ButtonRelease, xbutton);
WINCASE(MotionNotify, xmotion);
WINCASE(EnterNotify, xcrossing);
WINCASE(LeaveNotify, xcrossing);
WINCASE(FocusIn, xfocus);
WINCASE(FocusOut, xfocus);
WINCASE(KeymapNotify, xkeymap);
WINCASE(Expose, xexpose);
WINCASEEX(GraphicsExpose, xgraphicsexpose, drawable);
WINCASEEX(NoExpose, xnoexpose, drawable);
WINCASE(VisibilityNotify, xvisibility);
WINCASE(CreateNotify, xcreatewindow);
WINCASE(DestroyNotify, xdestroywindow);
WINCASE(UnmapNotify, xunmap);
WINCASE(MapNotify, xmap);
WINCASE(MapRequest, xmaprequest);
WINCASE(ReparentNotify, xreparent);
WINCASE(ConfigureNotify, xconfigure);
WINCASE(ConfigureRequest, xconfigurerequest);
WINCASE(GravityNotify, xgravity);
WINCASE(ResizeRequest, xresizerequest);
WINCASE(CirculateNotify, xcirculate);
WINCASE(CirculateRequest, xcirculaterequest);
WINCASE(PropertyNotify, xproperty);
WINCASE(SelectionClear, xselectionclear);
WINCASEEX(SelectionRequest, xselectionrequest, owner);
WINCASEEX(SelectionNotify, xselection, requestor);
WINCASE(ColormapNotify, xcolormap);
WINCASE(ClientMessage, xclient);
WINCASE(MappingNotify, xmapping);
default:
break;
}
return window;
}
static unsigned long lastUngrabTime;
static unsigned long lastUnhideTime;
static int need_unhide = 0;
class Check_Ungrab_Record {
public:
Window window;
int x, y, x_root, y_root;
Check_Ungrab_Record *next;
};
static int cur_registered = 0;
static Check_Ungrab_Record *first_cur = NULL, *last_cur = NULL;
static void CheckUngrab(Display *dpy, Check_Ungrab_Record *cur)
{
Window root;
int x, y;
unsigned w, h, b, d;
XGetGeometry(dpy, cur->window,
&root, &x, &y, &w, &h,
&b, &d);
if ((cur->x < 0) || (cur->y < 0)
|| ((unsigned int)cur->x > w) || ((unsigned int)cur->y > h)) {
/* Looks bad, but is it a click in a GRacket window
that we could care about? */
wxWindow *w;
w = wxLocationToWindow(cur->x_root, cur->y_root);
if (w) {
/* Looks like we need to ungrab */
XUngrabPointer(dpy, 0);
XUngrabKeyboard(dpy, 0);
}
}
}
static Bool CheckPred(Display *display, XEvent *e, char *args)
{
Window window;
Widget widget;
switch (e->type) {
case ButtonPress:
case ButtonRelease:
case MotionNotify:
if (e->xbutton.time > lastUnhideTime) {
lastUnhideTime = e->xbutton.time;
need_unhide = 1;
}
break;
default:
break;
}
if (short_circuit)
return FALSE;
#if 0
printf("trying %s\n", get_event_type(e));
#endif
window = GetEventWindow(e);
if (window) {
widget = XtWindowToWidget(display, window);
#if 1
if (widget)
if (e->type == DestroyNotify)
printf("DestroyNotified window %lx is still widget-mapped; BadWindow error is imminent.\n", window);
#endif
} else
widget = 0;
/* Check for mouse-down events outside the indicated window. That
might indicate a mouse grab gone awry, and we need to fix it.
The only legitimate grabs that operate on other windows are with
menus, and those have no wx counterpart. */
if (widget && (e->type == ButtonPress)) {
/* lastUngrabTime keeps us from checking the same events
over and over again. */
if (e->xbutton.time > lastUngrabTime) {
Check_Ungrab_Record *cur;
if (!cur_registered) {
wxREGGLOB(first_cur);
wxREGGLOB(last_cur);
}
cur = new WXGC_PTRS Check_Ungrab_Record;
cur->window = e->xbutton.window;
cur->x = e->xbutton.x;
cur->y = e->xbutton.y;
cur->x_root = e->xbutton.x_root;
cur->y_root = e->xbutton.y_root;
if (last_cur)
last_cur->next = cur;
else
first_cur = cur;
last_cur = cur;
lastUngrabTime = e->xbutton.time;
}
}
if (widget) {
Widget parent = 0;
/* Special hack in cooperation with Clipboard.cc
to make clipboard operations happen in the right
eventspace. */
if (widget == wx_clipWindow) {
wxClipboardClient *clipOwner;
clipOwner = wxTheClipboard->GetClipboardClient();
if (clipOwner) {
MrEdContext *cc = (MrEdContext *)clipOwner->context;
if (cc)
parent = cc->finalized->toplevel;
}
}
if (widget == wx_selWindow) {
wxClipboardClient *clipOwner;
clipOwner = wxTheSelection->GetClipboardClient();
if (clipOwner) {
MrEdContext *cc = (MrEdContext *)clipOwner->context;
if (cc)
parent = cc->finalized->toplevel;
}
}
if (!parent) {
for (parent = widget; XtParent(parent); parent = XtParent(parent)) {
}
}
#if 0
printf("parent: %lx context: %lx\n", parent, parent_context);
#endif
if (just_this_one) {
if (parent == just_this_one) {
if (checking_for_break) {
if (e->type == KeyPress) {
if ((e->xkey.state & ControlMask)
#if BREAKING_REQUIRES_SHIFT
&& (e->xkey.state & ShiftMask)
#endif
&& (e->xkey.keycode == breaking_code))
goto found;
}
} else {
goto found;
}
} else {
#if 0
printf("wrong eventspace (%lx != %lx)\n", just_this_one, parent_context);
#endif
}
} else {
MrEdContext *c;
for (c = mred_contexts; c; c = c->next) {
if (c->finalized->toplevel == parent) {
if (!c->ready) {
#if 0
printf("not ready\n");
#endif
return FALSE;
} else {
if (args)
*(MrEdContext **)args = c;
goto found;
}
}
}
/* Toplevel without context; handle in the main context: */
#if 0
printf("Can't map top-level to eventspace for %lx\n", window);
#endif
if (checking_for_break)
return FALSE;
else {
if (args)
*(MrEdContext **)args = NULL;
goto found;
}
}
} else {
#if 0
printf("warning: window->widget mapping failed: %lx; event: %d; parent: %lx\n",
window, e->type, ((XCreateWindowEvent *)e)->parent);
#endif
if (checking_for_break)
return FALSE;
else if (just_this_one)
return FALSE;
else {
/* Toplevel without context; handle in the main context: */
if (args)
*(MrEdContext **)args = NULL;
goto found;
}
}
return FALSE;
found:
if (just_check) {
short_circuit = TRUE;
return FALSE;
} else
return TRUE;
}
int MrEdGetNextEvent(int check_only, int current_only,
XEvent *event, MrEdContext **which)
{
Display *d;
int got;
if (which)
*which = NULL;
just_check = check_only;
just_this_one = (current_only ? wxGetAppToplevel() : (Widget)NULL);
if (!orig_top_level)
d = XtDisplay(save_top_level);
else
d = XtDisplay(orig_top_level);
got = XCheckIfEvent(d, event, CheckPred, (char *)which);
if (need_unhide) {
need_unhide = 0;
wxUnhideAllCursors();
}
while (first_cur) {
CheckUngrab(d, first_cur);
first_cur = first_cur->next;
}
last_cur = NULL;
if (got) {
just_check = 0;
return 1;
} else if (short_circuit) {
short_circuit = 0;
return 1;
}
return 0;
}
static Scheme_Hash_Table *disabled_widgets;
#ifdef MZ_PRECISE_GC
static void widget_hash_indices(void *_key, long *_h, long *_h2)
{
long lkey;
long h, h2;
lkey = (long)_key;
h = (lkey >> 2);
h2 = (lkey >> 3);
if (_h)
*_h = h;
if (_h2)
*_h2 = h2;
}
#endif
void wxSetSensitive(Widget w, Bool enabled)
{
if (!disabled_widgets) {
if (enabled)
return;
wxREGGLOB(disabled_widgets);
disabled_widgets = scheme_make_hash_table(SCHEME_hash_ptr);
#ifdef MZ_PRECISE_GC
disabled_widgets->make_hash_indices = widget_hash_indices;
#endif
}
if (enabled) {
scheme_hash_set(disabled_widgets, (Scheme_Object *)w, NULL);
} else {
scheme_hash_set(disabled_widgets, (Scheme_Object *)w, (Scheme_Object *)0x1);
}
}
#ifdef MZ_PRECISE_GC
START_XFORM_SKIP;
#endif
/* No GC here because it's used to draw GC bitmaps */
Display *MrEdGetXDisplay(void)
{
if (!orig_top_level)
return XtDisplay(save_top_level);
else
return XtDisplay(orig_top_level);
}
int MrEdGetDoubleTime(void)
{
return XtGetMultiClickTime(MrEdGetXDisplay());
}
#ifdef MZ_PRECISE_GC
END_XFORM_SKIP;
#endif
void MrEdDispatchEvent(XEvent *event)
{
if (disabled_widgets) {
int type = event->type;
Display *d;
d = MrEdGetXDisplay();
if ((type == KeyPress)
|| (type == KeyRelease)
|| (type == ButtonPress)
|| (type == ButtonRelease)
|| (type == MotionNotify)
|| (type == EnterNotify)
|| (type == LeaveNotify)
|| ((type == ClientMessage)
&& !strcmp(XGetAtomName(d, event->xclient.message_type), "WM_PROTOCOLS")
&& !strcmp(XGetAtomName(d, event->xclient.data.l[0]), "WM_DELETE_WINDOW"))) {
Window window;
Widget widget, ow, exempt = 0;
MrEdContext *c;
wxWindow *ew;
window = GetEventWindow(event);
if (window)
widget = XtWindowToWidget(d, window);
else
widget = 0;
ow = widget;
c = MrEdGetContext();
ew = c->modal_window;
if (ew) {
wxWindow_Xintern *ph;
ph = ew->GetHandle();
exempt = ph->frame;
}
while (widget) {
if (widget == grabber)
break;
/* Only start checking the enabled state with the first
top-level window. That way, PreOnChar and PreOnEvent are
called appropriately. wxWindows/Xt ensures that key and mouse
events are not dispatched to disabled items. */
if (XtIsSubclass(widget, transientShellWidgetClass)
|| XtIsSubclass(widget, topLevelShellWidgetClass)) {
if (scheme_hash_get(disabled_widgets, (Scheme_Object *)widget)) {
#if 0
printf("disabled: %lx from %lx\n", widget, ow);
#endif
return;
}
}
if (widget == exempt)
break;
widget = XtParent(widget);
}
}
}
XtDispatchEvent(event);
}
int MrEdCheckForBreak(void)
{
int br;
GC_CAN_IGNORE XEvent e;
Display *d;
if (!orig_top_level)
d = XtDisplay(save_top_level);
else
d = XtDisplay(orig_top_level);
if (!breaking_code_set) {
breaking_code = XKeysymToKeycode(d, 'c');
breaking_code_set = 1;
}
XFlush(d);
checking_for_break = 1;
br = MrEdGetNextEvent(0, 1, &e, NULL);
checking_for_break = 0;
return br;
}
#include "wx_timer.h"
class wxXtTimer : public wxTimer
{
public:
XtTimerCallbackProc callback;
XtPointer data;
int ok;
Widget wgt;
wxXtTimer(Widget w, XtTimerCallbackProc c, XtPointer d);
Bool Start(int millisec = -1, Bool one_shot = FALSE);
void Stopped() { ok = 0; }
void Notify(void);
};
wxXtTimer::wxXtTimer(Widget w, XtTimerCallbackProc c, XtPointer d)
: wxTimer()
{
callback = c;
wgt = w;
data = d;
ok = 1;
}
void wxXtTimer::Notify(void) {
/* Used to try to avoid starving other events, but yielding
has its own problems. In particular, it messes up dialogs
that expect show #f to immediately lead to a return from
show #t. */
// wxYield();
if (ok)
callback(data, NULL);
}
Bool wxXtTimer::Start(int millisec, Bool one_shot)
{
Widget parent;
/* Only start the timer if the context is consistnt with
the original widget, the context is still running,
etc. */
for (parent = wgt; XtParent(parent); parent = XtParent(parent)) {
}
if (context
&& !((MrEdContext *)context)->killed
&& ((MrEdContext *)context)->finalized
&& (((MrEdContext *)context)->finalized->toplevel == parent)) {
return wxTimer::Start(millisec, one_shot);
}
return FALSE;
}
extern "C" {
void wxRemoveTimeOut(long timer)
{
wxXtTimer *t;
#ifdef MZ_PRECISE_GC
t = *(wxXtTimer **)timer;
GC_free_immobile_box((void **)timer);
#else
t = (wxXtTimer *)timer;
#endif
t->Stop();
t->Stopped();
#ifdef MZ_PRECISE_GC
XFORM_RESET_VAR_STACK;
#endif
}
long wxAppAddTimeOut(XtAppContext app_ctx, unsigned long interval,
XtTimerCallbackProc callback, XtPointer data,
Widget w)
{
wxTimer *t;
long result;
t = new wxXtTimer(w, callback, data);
t->Start(interval, TRUE);
#ifdef MZ_PRECISE_GC
result = (long)GC_malloc_immobile_box(t);
#else
result = (long)t;
#endif
#ifdef MZ_PRECISE_GC
XFORM_RESET_VAR_STACK;
#endif
return result;
}
}
/***********************************************************************/
typedef struct {
Widget w;
wxWindow *wx;
} FindRec;
void *IsWidgetFrame(wxObject *f, void *d)
{
FindRec *fr = (FindRec *)d;
wxWindow_Xintern *i;
i = ((wxWindow *)f)->GetHandle();
if (i->frame == fr->w) {
fr->wx = (wxWindow *)f;
}
return d;
}
static wxWindow *FindMrEdWindow(Display *d, Window xw)
{
Widget w;
w = XtWindowToWidget(d, xw);
if (w) {
FindRec fr;
fr.w = w;
fr.wx = NULL;
MrEdForEachFrame(IsWidgetFrame, &fr);
return fr.wx;
} else {
wxWindow *m;
Window root, parent, *children;
unsigned int n, i;
if (XQueryTree(d, xw, &root, &parent, &children, &n)) {
if (children) {
m = NULL;
for (i = 0; i < n; i++) {
m = FindMrEdWindow(d, children[i]);
if (m)
break;
}
XFree(children);
return m;
}
}
return NULL;
}
}
wxWindow *wxLocationToWindow(int x, int y)
{
Display *d;
Window root, parent, *children;
unsigned int n, i;
XWindowAttributes a;
wxWindow *result = NULL;
if (!orig_top_level)
d = XtDisplay(save_top_level);
else
d = XtDisplay(orig_top_level);
if (XQueryTree(d, DefaultRootWindow(d),
&root, &parent, &children, &n)) {
for (i = n; i--; ) {
XGetWindowAttributes(d, children[i], &a);
if (a.map_state == IsViewable
&& (a.x <= x) && (a.x + a.width >= x)
&& (a.y <= y) && (a.y + a.height >= y)) {
/* Found the X window, now see if it's a MrEd window: */
result = FindMrEdWindow(d, children[i]);
break;
}
}
if (children)
XFree(children);
}
return result;
}
int wxLocaleStringToChar(char *str, int slen)
{
Scheme_Object *s;
s = scheme_make_locale_string(str);
if (SCHEME_CHAR_STRLEN_VAL(s))
return SCHEME_CHAR_STR_VAL(s)[0];
else
return 0;
}
int wxUTF8StringToChar(char *str, int slen)
{
mzchar s[1];
s[0] = 0;
scheme_utf8_decode((unsigned char *)str, 0, slen,
s, 0, 1,
NULL, 0, '?');
return (int)s[0];
}
/***********************************************************************/
static int has_property(Display *d, Window w, Atom atag)
{
Atom actual;
int format;
unsigned long count, remaining;
unsigned char *data = 0;
XGetWindowProperty(d, w, atag,
0, 0x8000000L, FALSE,
AnyPropertyType, &actual, &format,
&count, &remaining, &data);
if (data)
XFree(data);
return (actual != None);
}
static int wxSendOrSetTag(char *tag, char *pre_tag, char *msg)
{
Display *d;
Window root, parent, *children;
unsigned int n, i;
Atom atag, apre_tag;
Window target = 0, me;
int try_again = 0, add_property_back = 0, found_nothing;
/* Elect a leader, relying on the fact that the X server serializes
its interactions.
Each client sets a pre-tag, and then checks all windows. If any
window has a (non-pre) tag already, then that's the leader. If no
one else has a pre tag, then this client is elected, and it sets
the tag on itself. If someone else has a pre tag, we try again;
if the other window id is lower, this client drops it pre tag, so
that the other will be elected eventually. Note that if two
clients set a pre tag, then one must see the other (because
neither looks until its tag is set). Livelock is a possibility if
clients continuously appear with ever higher window ids, but that
possibility is exceedingly remote. */
if (!orig_top_level)
d = XtDisplay(save_top_level);
else
d = XtDisplay(orig_top_level);
apre_tag = XInternAtom(d, pre_tag, False);
atag = XInternAtom(d, tag, False);
wx_single_instance_tag = atag;
me = wxAddClipboardWindowProperty(apre_tag);
do {
if (add_property_back) {
wxAddClipboardWindowProperty(apre_tag);
add_property_back = 1;
}
XFlush(d);
XSync(d, FALSE);
found_nothing = 1;
if (XQueryTree(d, DefaultRootWindow(d),
&root, &parent, &children, &n)) {
for (i = n; i--; ) {
if (children[i] != me) {
if (has_property(d, children[i], atag)) {
/* Found the leader: */
target = children[i];
try_again = 0;
found_nothing = 0;
break;
} else if (has_property(d, children[i], apre_tag)) {
/* Found another candidate. If our ID is
higher, then withdrawl candidacy. Loop
to wait for some process to assume leadership. */
if ((long)me >= (long)children[i])
XDeleteProperty(d, me, apre_tag);
try_again = 1;
found_nothing = 0;
}
}
}
if (found_nothing && try_again) {
/* This can only happen if some candidate process
(with a lower window ID) has now exited. Try
again to become the leader. */
add_property_back = 1;
}
if (children)
XFree(children);
}
} while (try_again);
if (target) {
GC_CAN_IGNORE XEvent xevent;
long mlen, offset = 0;
int sent_last = 0;
mlen = strlen(msg);
/* Send the message(s): */
while (!sent_last) {
memset(&xevent, 0, sizeof (xevent));
xevent.xany.type = ClientMessage;
xevent.xany.display = d;
xevent.xclient.window = target;
xevent.xclient.message_type = atag;
xevent.xclient.format = 8;
{
int i = sizeof(Window);
long w = (long)me;
while (i--) {
xevent.xclient.data.b[i] = (char)(w & 0xFF);
w = w >> 8;
}
}
if (offset < mlen) {
long amt;
amt = mlen - offset;
if (amt > (int)(20 - sizeof(Window)))
amt = 20 - sizeof(Window);
memcpy(xevent.xclient.data.b + sizeof(Window), msg + offset, amt);
offset += amt;
sent_last = (amt < (int)(20 - sizeof(Window)));
} else
sent_last = 1;
XSendEvent(d, target, 0, 0, &xevent);
}
XFlush(d);
XSync(d, FALSE);
return 1;
} else {
/* Set the property on the clipboard window */
wxAddClipboardWindowProperty(atag);
return 0;
}
}
# define SINGLE_INSTANCE_HANDLER_CODE \
"(lambda (f host)" \
" (let-values ([(path) (simplify-path" \
" (path->complete-path" \
" (or (find-executable-path (find-system-path 'run-file) #f)" \
" (find-system-path 'run-file))" \
" (current-directory)))])" \
" (let-values ([(tag) (string->bytes/utf-8" \
" (format \"~a:~a_~a\" host path (version)))])" \
" (f tag " \
" (bytes-append #\"pre\" tag)" \
" (apply" \
" bytes-append" \
" (map (lambda (s)" \
" (let-values ([(s) (path->string" \
" (path->complete-path s (current-directory)))])" \
" (string->bytes/utf-8" \
" (format \"~a:~a\"" \
" (string-length s)" \
" s))))" \
" (vector->list" \
" (current-command-line-arguments))))))))"
static Scheme_Object *prep_single_instance(int argc, Scheme_Object **argv)
{
return (wxSendOrSetTag(SCHEME_BYTE_STR_VAL(argv[0]),
SCHEME_BYTE_STR_VAL(argv[1]),
SCHEME_BYTE_STR_VAL(argv[2]))
? scheme_true
: scheme_false);
}
int wxCheckSingleInstance(Scheme_Env *global_env)
{
Scheme_Object *a[2], *v, *nam, *nr, *ns;
char buf[256];
Scheme_Config *config;
Scheme_Cont_Frame_Data frame;
if (!wxGetHostName(buf, 256)) {
buf[0] = 0;
}
/* ************************************************************ */
/* Set up a namespace to evaluate SINGLE_INSTANCE_HANDLER_CODE: */
ns = scheme_make_namespace(0, NULL);
config = scheme_extend_config(scheme_current_config(),
MZCONFIG_ENV,
ns);
scheme_push_continuation_frame(&frame);
scheme_install_config(config);
nam = scheme_builtin_value("namespace-attach-module");
a[0] = (Scheme_Object *)global_env;
a[1] = scheme_make_pair(scheme_intern_symbol("quote"),
scheme_make_pair(scheme_intern_symbol("#%utils"),
scheme_null));
scheme_apply(nam, 2, a);
nr = scheme_builtin_value("namespace-require");
a[0] = a[1];
scheme_apply(nr, 1, a);
a[0] = scheme_make_pair(scheme_intern_symbol("quote"),
scheme_make_pair(scheme_intern_symbol("#%min-stx"),
scheme_null));
scheme_apply(nr, 1, a);
a[0] = scheme_make_pair(scheme_intern_symbol("quote"),
scheme_make_pair(scheme_intern_symbol("#%kernel"),
scheme_null));
scheme_apply(nr, 1, a);
/* *********************************************************** **/
a[0] = scheme_make_prim(prep_single_instance);
a[1] = scheme_make_byte_string(buf);
v = scheme_apply(scheme_eval_string(SINGLE_INSTANCE_HANDLER_CODE,
(Scheme_Env *)ns),
2,
a);
/* Pop the namespace: */
scheme_pop_continuation_frame(&frame);
return SCHEME_TRUEP(v);
}