v08i061: Elk (Extension Language Toolkit) part 13 of 14

Brandon S. Allbery - comp.sources.misc allbery at uunet.UU.NET
Sun Sep 24 07:44:40 AEST 1989


Posting-number: Volume 8, Issue 61
Submitted-by: net at tub.UUCP (Oliver Laumann)
Archive-name: elk/part13

[Let this be a lesson to submitters:  this was submitted as uuencoded,
compressed files.  I lost the source information while unpacking it; this
is the best approximation I could come up with.  ++bsa]

#! /bin/sh
# This is a shell archive.  Remove anything before this line, then unpack
# it by saving it into a file and typing "sh file".  To overwrite existing
# files, type "sh file -c".  You can also feed this as standard input via
# unshar, or by typing "sh <file", e.g..  If this archive is complete, you
# will see the following message at the end:
#		"End of archive 13 (of 14)."
# Contents:  lib/xt/class.c lib/xt/xt.h lib/xt/callback.c
#   lib/xt/context.c lib/xt/translation.c lib/xt/widget.c
#   lib/xt/make-widget lib/xt/converter.c lib/xt/popup.c
#   lib/xt/resource.c lib/xt/BUGS lib/xt/identifier.c lib/util
#   lib/util/symbol.h lib/util/objects.h lib/xhp
# Wrapped by net at tub on Sun Sep 17 17:32:42 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f lib/xt/class.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/class.c\"
else
echo shar: Extracting \"lib/xt/class.c\" \(4967 characters\)
sed "s/^X//" >lib/xt/class.c <<'END_OF_lib/xt/class.c'
X#include "xt.h"
X
X#define MAX_CLASS	        128
X#define MAX_CALLBACK_PER_CLASS    5
X
Xtypedef struct {
X    char *name;
X    int has_arg;
X} CALLBACK_INFO;
X
Xtypedef struct {
X    WidgetClass class;
X    char *name;
X    CALLBACK_INFO cb[MAX_CALLBACK_PER_CLASS], *cblast;
X    XtResourceList sub_resources;
X    int num_resources;
X} CLASS_INFO;
X
Xstatic CLASS_INFO ctab[MAX_CLASS], *clast = ctab;
X
XGeneric_Predicate (Class);
X
XGeneric_Simple_Equal (Class, CLASS, class);
X
XGeneric_Print (Class, "#[class %s]", CLASS(x)->name);
X
XObject Make_Class (class, name) WidgetClass class; char *name; {
X    register char *p;
X    Object c;
X
X    c = Find_Object (T_Class, (GENERIC)0, Match_Xt_Obj, class);
X    if (Nullp (c)) {
X	p = Get_Bytes (sizeof (struct S_Class));
X	SET (c, T_Class, (struct S_Class *)p);
X	CLASS(c)->tag = Null;
X	CLASS(c)->class = class;
X	CLASS(c)->name = name;
X	Register_Object (c, (GENERIC)0, (PFO)0, 0);
X    }
X    return c;
X}
X
XObject Make_Widget_Class (class) WidgetClass class; {
X    register CLASS_INFO *p;
X
X    for (p = ctab; p < clast; p++)
X	if (p->class == class)
X	    return Make_Class (class, p->name);
X    Primitive_Error ("undefined widget class");
X    /*NOTREACHED*/
X}
X
Xstatic Object P_Find_Class (name) Object name; {
X    register char *s;
X    register CLASS_INFO *p;
X
X    Make_C_String (name, s);
X    for (p = ctab; p < clast; p++)
X	if (streq (p->name, s))
X	    return Make_Class (p->class, p->name);
X    Primitive_Error ("no such widget class: ~s", name);
X    /*NOTREACHED*/
X}
X
Xstatic Object P_Class_Existsp (name) Object name; {
X    register char *s;
X    register CLASS_INFO *p;
X
X    Make_C_String (name, s);
X    for (p = ctab; p < clast; p++)
X	if (streq (p->name, s))
X	    return True;
X    return False;
X}
X
Xchar *Class_Name (class) WidgetClass class; {
X    register CLASS_INFO *p;
X
X    for (p = ctab; p < clast && p->class != class; p++)
X	;
X    if (p == clast)
X	return "unknown";
X    return p->name;
X}
X
Xvoid Get_Sub_Resource_List (class, rp, np) WidgetClass class;
X	XtResourceList *rp; int *np; {
X    register CLASS_INFO *p;
X
X    for (p = ctab; p < clast && p->class != class; p++)
X	;
X    if (p == clast)
X	Panic ("Get_Sub_Resource_List");
X    *np = p->num_resources;
X    *rp = p->sub_resources;
X}
X
Xstatic Object P_Class_Resources (c) Object c; {
X    Check_Type (c, T_Class);
X    return Get_Resources (CLASS(c)->class, XtGetResourceList, 1);
X}
X
Xstatic Object P_Class_Constraint_Resources (c) Object c; {
X    Check_Type (c, T_Class);
X    return Get_Resources (CLASS(c)->class, XtGetConstraintResourceList, 1);
X}
X
Xstatic Object P_Class_Sub_Resources (c) Object c; {
X    Check_Type (c, T_Class);
X    return Get_Resources (CLASS(c)->class, Get_Sub_Resource_List, 0);
X}
X
XDefine_Class (name, class, r, nr) char *name; WidgetClass class;
X	XtResourceList r; {
X    Error_Tag = "define-class";
X    if (clast == ctab+MAX_CLASS)
X	Primitive_Error ("too many widget classes");
X    clast->name = name;
X    clast->class = class;
X    clast->cb[0].name = XtNdestroyCallback;
X    clast->cb[0].has_arg = 0;
X    clast->cblast = clast->cb+1;
X    clast->sub_resources = r;
X    clast->num_resources = nr;
X    clast++;
X}
X
XDefine_Callback (cl, s, has_arg) char *cl, *s; {
X    register CLASS_INFO *p;
X
X    Error_Tag = "define-callback";
X    for (p = ctab; p < clast; p++)
X	if (streq (p->name, cl)) {
X	    if (p->cblast == p->cb+MAX_CALLBACK_PER_CLASS)
X		Primitive_Error ("too many callbacks for this class");
X	    p->cblast->name = s;
X	    p->cblast->has_arg = has_arg;
X	    p->cblast++;
X	    return;
X	}
X    Primitive_Error ("undefined class");
X}
X
XPFO Find_Callback_Converter (c, name, sname) WidgetClass c; char *name;
X	Object sname; {
X    register CLASS_INFO *p;
X    register CALLBACK_INFO *q;
X    PFO conv;
X
X    for (p = ctab; p < clast; p++)
X	if (p->class == c) {
X	    for (q = p->cb; q < p->cblast; q++)
X		if (streq (q->name, name)) {
X		    if (q->has_arg) {
X			char s[128];
X			sprintf (s, "%s-%s", p->name, name);
X			conv = Find_Converter_To_Scheme (s);
X			if (conv == 0) {
X			    sprintf (s, "no callback converter for %s", name);
X			    Primitive_Error (s);
X			}
X			return conv;
X		    } else return (PFO)0;
X		}
X	    Primitive_Error ("no such callback: ~s", sname);
X	}
X    Panic ("Find_Callback_Converter");
X    /*NOTREACHED*/
X}
X
Xinit_xt_class () {
X    Generic_Define (Class, "class", "class?");
X    Define_Primitive (P_Find_Class,        "find-class",        1, 1, EVAL);
X    Define_Primitive (P_Class_Resources,   "class-resources",   1, 1, EVAL);
X    Define_Primitive (P_Class_Constraint_Resources, 
X                               "class-constraint-resources",    1, 1, EVAL);
X    Define_Primitive (P_Class_Sub_Resources,
X			       "class-sub-resources",           1, 1, EVAL);
X    Define_Primitive (P_Class_Existsp,     "class-exists?",     1, 1, EVAL);
X    Define_Class ("core", widgetClass, (XtResourceList)0, 0);
X    Define_Class ("constraint", constraintWidgetClass, (XtResourceList)0, 0);
X    Define_Class ("composite", compositeWidgetClass, (XtResourceList)0, 0);
X}
END_OF_lib/xt/class.c
if test 4967 -ne `wc -c <lib/xt/class.c`; then
    echo shar: \"lib/xt/class.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/xt.h -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/xt.h\"
else
echo shar: Extracting \"lib/xt/xt.h\" \(1570 characters\)
sed "s/^X//" >lib/xt/xt.h <<'END_OF_lib/xt/xt.h'
X#include "../xlib/xlib.h"
X
X#include <X11/Intrinsic.h>
X#include <X11/Core.h>
X#include <X11/Cardinals.h>
X#include <X11/StringDefs.h>
X
Xtypedef XtArgVal (*PFX)();
X
Xint T_Context;
Xint T_Class;
Xint T_Widget;
Xint T_Identifier;
X
X#define CONTEXT(x)	((struct S_Context *)POINTER(x))
X#define CLASS(x)	((struct S_Class *)POINTER(x))
X#define WIDGET(x)	((struct S_Widget *)POINTER(x))
X#define IDENTIFIER(x)   ((struct S_Identifier *)POINTER(x))
X
Xstruct S_Context {
X    Object tag;
X    XtAppContext context;
X    char free;
X};
X
Xstruct S_Class {
X    Object tag;
X    WidgetClass class;
X    char *name;
X};
X
Xstruct S_Widget {
X    Object tag;
X    Widget widget;
X    char free;
X};
X
Xstruct S_Identifier {
X    Object tag;
X    char type;
X    caddr_t val;
X    int num;
X    char free;
X};
X
Xextern Match_Xt_Obj();
Xextern Object Make_Widget_Class(), Make_Context(), Make_Widget();
Xextern Object Get_Values(), Get_Resources(), Get_Callbackfun();
Xextern WidgetClass widgetClass;    /* The `core' class */
Xextern WidgetClass constraintWidgetClass;
Xextern WidgetClass compositeWidgetClass;
Xextern caddr_t Use_Id();
Xextern Xt_Warning();
Xextern void XtGetResourceList(), XtGetConstraintResourceList();
Xextern void Destroy_Callback_Proc();
Xextern PFO Find_Callback_Converter(), Find_Converter_To_Scheme();
Xextern PFX Find_Converter_To_C();
Xextern char *Class_Name();
Xextern XtTranslations Get_Translations();
X
X
X#define Encode_Arglist(ac,av,to,widget,class) {\
X    to = (Arg *)alloca (((ac)+1)/2 * sizeof (Arg));\
X    Convert_Args (ac, av, to, widget, class);\
X}
X
X#define streq(a,b) (strcmp ((a), (b)) == 0)
END_OF_lib/xt/xt.h
if test 1570 -ne `wc -c <lib/xt/xt.h`; then
    echo shar: \"lib/xt/xt.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/callback.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/callback.c\"
else
echo shar: Extracting \"lib/xt/callback.c\" \(3938 characters\)
sed "s/^X//" >lib/xt/callback.c <<'END_OF_lib/xt/callback.c'
X#include "xt.h"
X
X#define MAX_CALLBACKS   512
X
Xstatic Object Callbacks;
X
Xtypedef struct {
X    PFO converter;
X    int num;
X} CLIENT_DATA;
X
XObject Get_Callbackfun (c) caddr_t c; {
X    register CLIENT_DATA *cd = (CLIENT_DATA *)c;
X    return cd ? VECTOR(Callbacks)->data[cd->num] : False;
X}
X
Xstatic void Callback_Proc (w, client_data, call_data) Widget w;
X	caddr_t client_data, call_data; {
X    register CLIENT_DATA *cd = (CLIENT_DATA *)client_data;
X    Object args;
X
X    args = Null;
X    if (cd->converter)
X	args = Cons ((cd->converter)((XtArgVal)call_data), args);
X    args = Cons (Make_Widget (w), args);
X    (void)Funcall (Get_Callbackfun (client_data), args, 0);
X}
X
X/*ARGSUSED*/
Xvoid Destroy_Callback_Proc (w, client_data, call_data) Widget w;
X	caddr_t client_data, call_data; {
X    Object x;
X
X    x = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, w);
X    if (Nullp (x) || WIDGET(x)->free)
X	return;
X    WIDGET(x)->free = 1;
X    Remove_All_Callbacks (w);
X    Deregister_Object (x);
X}
X
X/* The code assumes that callbacks are called in the order they
X * have been added.  The Destroy_Callback_Proc() must always be
X * the last callback in the destroy callback list of each widget.
X *
X * When the destroy callback list of a widget is modified
X * (via P_Add_Callbacks or P_Set_Values), Fiddle_Destroy_Callback()
X * must be called to remove the Destroy_Callback_Proc() and put
X * it back to the end of the callback list.
X */
XFiddle_Destroy_Callback (w) Widget w; {
X    XtRemoveCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, (caddr_t)0);
X    XtAddCallback (w, XtNdestroyCallback, Destroy_Callback_Proc, (caddr_t)0);
X}
X
XCheck_Callback_List (x) Object x; {
X    Object tail;
X
X    Check_List (x);
X    for (tail = x; !Nullp (tail); tail = Cdr (tail))
X	Check_Procedure (Car (tail));
X}
X
Xstatic Object P_Add_Callbacks (w, name, cbl) Object w, name, cbl; {
X    register char *s;
X    register n;
X    XtCallbackList callbacks;
X
X    Check_Widget (w);
X    Check_Callback_List (cbl);
X    Make_C_String (name, s);
X    Make_Resource_Name (s);
X    n = Internal_Length (cbl);
X    callbacks = (XtCallbackRec *)alloca ((n+1) * sizeof (XtCallbackRec));
X    callbacks[n].callback = 0;
X    callbacks[n].closure = 0;
X    Fill_Callbacks (cbl, callbacks, n,
X	Find_Callback_Converter (XtClass (WIDGET(w)->widget), s, name));
X    XtAddCallbacks (WIDGET(w)->widget, s, callbacks);
X    if (streq (s, XtNdestroyCallback))
X	Fiddle_Destroy_Callback (WIDGET(w)->widget);
X    return Void;
X}
X
XFill_Callbacks (src, dst, n, conv) Object src; XtCallbackList dst;
X	register n; PFO conv; {
X    register CLIENT_DATA *cd;
X    register i, j;
X    Object tail;
X    GC_Node2;
X
X    GC_Link2 (src, tail);
X    for (i = 0, tail = src; i < n; i++, tail = Cdr (tail)) {
X	Object fun = Car (tail);
X	for (j = 0; j < MAX_CALLBACKS; j++)
X	    if (Nullp (VECTOR(Callbacks)->data[j])) break;
X	if (j == MAX_CALLBACKS)
X	    Primitive_Error ("too many callbacks");
X	VECTOR(Callbacks)->data[j] = fun;
X	cd = (CLIENT_DATA *)XtMalloc (sizeof (CLIENT_DATA));
X	cd->converter = conv;
X	cd->num = j;
X	dst[i].callback = (XtCallbackProc)Callback_Proc;
X	dst[i].closure = (caddr_t)cd;
X    }
X    GC_Unlink;
X}
X
Xstatic Remove_All_Callbacks (w) Widget w; {
X    Arg a[1];
X    XtCallbackList c;
X    XtResource *r;
X    int nr, nc;
X    register i, j;
X
X    Get_All_Resources (w, XtClass (w), &r, &nr, &nc);
X    for (j = 0; j < nr; j++) {
X	if (streq (r[j].resource_type, XtRCallback)) {
X	    XtSetArg (a[0], r[j].resource_name, &c);
X	    XtGetValues (w, a, ONE);
X	    for (i = 0; c[i].callback; i++) {
X		register CLIENT_DATA *cd = (CLIENT_DATA *)c[i].closure;
X		if (c[i].callback == (XtCallbackProc)Callback_Proc && cd) {
X		    VECTOR(Callbacks)->data[cd->num] = Null;
X		    XtFree ((char *)cd);
X		}
X	    }
X	}
X    }
X    XtFree ((char *)r);
X}
X
Xinit_xt_callback () {
X    Callbacks = Make_Vector (MAX_CALLBACKS, Null);
X    Global_GC_Link (Callbacks);
X    Define_Primitive (P_Add_Callbacks, "add-callbacks", 3, 3, EVAL);
X}
END_OF_lib/xt/callback.c
if test 3938 -ne `wc -c <lib/xt/callback.c`; then
    echo shar: \"lib/xt/callback.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/context.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/context.c\"
else
echo shar: Extracting \"lib/xt/context.c\" \(6094 characters\)
sed "s/^X//" >lib/xt/context.c <<'END_OF_lib/xt/context.c'
X#include "xt.h"
X
X#define MAX_WORKPROCS            512
X#define MAX_TIMEOUTS             512
X
Xstatic Object Workprocs, Timeouts;
X
Xstatic SYMDESCR XtIM_Syms[] = {
X    { "x-event",         XtIMXEvent },
X    { "timer",           XtIMTimer },
X    { "alternate-input", XtIMAlternateInput },
X    { 0, 0 }
X};
X
Xstatic Object P_Destroy_Context();
X
XGeneric_Predicate (Context);
X
XGeneric_Equal (Context, CONTEXT, context);
X
XGeneric_Print (Context, "#[context %u]", POINTER(x));
X
XObject Make_Context (context) XtAppContext context; {
X    register char *p;
X    Object c;
X
X    c = Find_Object (T_Context, (GENERIC)0, Match_Xt_Obj, context);
X    if (Nullp (c)) {
X	p = Get_Bytes (sizeof (struct S_Context));
X	SET (c, T_Context, (struct S_Context *)p);
X	CONTEXT(c)->tag = Null;
X	CONTEXT(c)->context = context;
X	CONTEXT(c)->free = 0;
X	Register_Object (c, (GENERIC)0, P_Destroy_Context, 0);
X	XtAppSetWarningHandler (context, Xt_Warning);
X    }
X    return c;
X}
X
Xstatic Check_Context (c) Object c; {
X    Check_Type (c, T_Context);
X    if (CONTEXT(c)->free)
X	Primitive_Error ("invalid context: ~s", c);
X}
X
Xstatic Object P_Create_Context () {
X    /*  Should read:
X    return Make_Context (XtCreateApplicationContext ());
X     *  but Xt is broken (timers are added to the wrong context).
X     */
X    extern XtAppContext _XtDefaultAppContext();
X    return Make_Context (_XtDefaultAppContext ());
X}
X
Xstatic Object P_Destroy_Context (c) Object c; {
X    Check_Context (c);
X    XtDestroyApplicationContext (CONTEXT(c)->context);
X    CONTEXT(c)->free = 1;
X    Deregister_Object (c);
X    return Void;
X}
X
Xstatic Object P_Initialize_Display (c, d, name, class)
X	Object c, d, name, class; {
X    register char *sn, *sc, *sd = 0;
X    register t = TYPE(d);
X    Display *dpy;
X    extern char **Argv;
X    extern First_Arg, Argc;
X    int argc = Argc - First_Arg + 1;
X
X    Argv[First_Arg-1] = "bogus";  /* Not actually used by Xt.  Or is it? */
X    Check_Context (c);
X    Make_C_String (name, sn);
X    Make_C_String (class, sc);
X    if (t == T_Display) {
X	XtDisplayInitialize (CONTEXT(c)->context, DISPLAY(d)->dpy,
X	    sn, sc, (XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]);
X	Argc = First_Arg + argc;
X	return Void;
X    }
X    if (Truep (d))
X	Make_C_String (d, sd);
X    dpy = XtOpenDisplay (CONTEXT(c)->context, sd, sn, sc,
X	(XrmOptionDescRec *)0, 0, &argc, &Argv[First_Arg-1]);
X    Argc = First_Arg + argc - 1;
X    if (dpy == 0)
X	if (sd)
X	    Primitive_Error ("cannot open display ~s", d);
X	else
X	    Primitive_Error ("cannot open display");
X    return Make_Display (0, dpy);
X}
X
Xstatic Object P_Context_Main_Loop (c) Object c; {
X    Check_Context (c);
X    XtAppMainLoop (CONTEXT(c)->context);
X    /*NOTREACHED*/
X}
X
Xstatic Object P_Context_Pending (c) Object c; {
X    Check_Context (c);
X    return Bits_To_Symbols ((unsigned long)XtAppPending (CONTEXT(c)->context),
X	1, XtIM_Syms);
X}
X
Xstatic Object P_Context_Process_Event (argc, argv) Object *argv; {
X    XtInputMask mask = XtIMAll;
X
X    Check_Context (argv[0]);
X    if (argc == 2)
X	mask = (XtInputMask)Symbols_To_Bits (argv[1], 1, XtIM_Syms);
X    XtAppProcessEvent (CONTEXT(argv[0])->context, mask);
X    return Void;
X}
X
Xstatic Work_Proc (client_data) caddr_t client_data; {
X    Object ret = Funcall (VECTOR(Workprocs)->data[(int)client_data], Null, 0);
X    if (Truep (ret))
X	VECTOR(Workprocs)->data[(int)client_data] = Null;
X    return Truep (ret);
X}
X
Xstatic Object P_Context_Add_Work_Proc (c, p) Object c, p; {
X    XtWorkProcId id;
X    register i;
X
X    Check_Context (c);
X    Check_Procedure (p);
X    for (i = 0; i < MAX_WORKPROCS; i++)
X	if (Nullp (VECTOR(Workprocs)->data[i])) break;
X    if (i == MAX_WORKPROCS)
X	Primitive_Error ("too many work procs");
X    VECTOR(Workprocs)->data[i] = p;
X    id = XtAppAddWorkProc (CONTEXT(c)->context, Work_Proc, (caddr_t)i);
X    return Make_Id ('w', (caddr_t)id, i);
X}
X
Xstatic Object P_Remove_Work_Proc (id) Object id; {
X    XtRemoveWorkProc ((XtWorkProcId)Use_Id (id, 'w'));
X    VECTOR(Workprocs)->data[IDENTIFIER(id)->num] = Null;
X    return Void;
X}
X
Xstatic Timeout_Proc (client_data, id) caddr_t client_data; XtIntervalId *id; {
X    Object proc, args;
X
X    args = Cons (Make_Id ('t', (caddr_t)*id, 0), Null);
X    proc = VECTOR(Timeouts)->data[(int)client_data];
X    VECTOR(Timeouts)->data[(int)client_data] = Null;
X    (void)Funcall (proc, args, 0);
X}
X
Xstatic Object P_Context_Add_Timeout (c, n, p) Object c, n, p; {
X    XtIntervalId id;
X    register i;
X
X    Check_Context (c);
X    Check_Procedure (p);
X    for (i = 0; i < MAX_TIMEOUTS; i++)
X	if (Nullp (VECTOR(Timeouts)->data[i])) break;
X    if (i == MAX_TIMEOUTS)
X	Primitive_Error ("too many timeouts");
X    VECTOR(Timeouts)->data[i] = p;
X    id = XtAppAddTimeOut (CONTEXT(c)->context, Get_Integer (n), Timeout_Proc,
X	(caddr_t)i);
X    return Make_Id ('t', (caddr_t)id, i);
X}
X
Xstatic Object P_Remove_Timeout (id) Object id; {
X    XtRemoveTimeOut ((XtIntervalId)Use_Id (id, 't'));
X    VECTOR(Timeouts)->data[IDENTIFIER(id)->num] = Null;
X    return Void;
X}
X
Xinit_xt_context () {
X    Workprocs = Make_Vector (MAX_WORKPROCS, Null);
X    Global_GC_Link (Workprocs);
X    Timeouts = Make_Vector (MAX_TIMEOUTS, Null);
X    Global_GC_Link (Timeouts);
X    Generic_Define (Context, "context", "context?");
X    Define_Primitive (P_Create_Context,     "create-context",     0, 0, EVAL);
X    Define_Primitive (P_Destroy_Context,    "destroy-context",    1, 1, EVAL);
X    Define_Primitive (P_Initialize_Display, "initialize-display", 4, 4, EVAL);
X    Define_Primitive (P_Context_Main_Loop,  "context-main-loop",  1, 1, EVAL);
X    Define_Primitive (P_Context_Pending,    "context-pending",    1, 1, EVAL);
X    Define_Primitive (P_Context_Process_Event, "context-process-event",
X							      1, 2, VARARGS);
X    Define_Primitive (P_Context_Add_Work_Proc, "context-add-work-proc",
X							      2, 2, EVAL);
X    Define_Primitive (P_Remove_Work_Proc,   "remove-work-proc",   1, 1, EVAL);
X    Define_Primitive (P_Context_Add_Timeout,"context-add-timeout",3, 3, EVAL);
X    Define_Primitive (P_Remove_Timeout,     "remove-timeout",     1, 1, EVAL);
X    XtToolkitInitialize ();
X    P_Provide (Intern ("xt.o"));
X}
END_OF_lib/xt/context.c
if test 6094 -ne `wc -c <lib/xt/context.c`; then
    echo shar: \"lib/xt/context.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/translation.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/translation.c\"
else
echo shar: Extracting \"lib/xt/translation.c\" \(1039 characters\)
sed "s/^X//" >lib/xt/translation.c <<'END_OF_lib/xt/translation.c'
X#include "xt.h"
X
XXtTranslations Get_Translations (t) Object t; {
X    register char *s;
X    XtTranslations ret;
X
X    Make_C_String (t, s);
X    if ((ret = XtParseTranslationTable (s)) == 0)
X	Primitive_Error ("bad translation table: ~s", t);
X    return ret;
X}
X
Xstatic Object P_Augment_Translations (w, t) Object w, t; {
X    Check_Widget (w);
X    XtAugmentTranslations (WIDGET(w)->widget, Get_Translations (t));
X    return Void;
X}
X    
Xstatic Object P_Override_Translations (w, t) Object w, t; {
X    Check_Widget (w);
X    XtOverrideTranslations (WIDGET(w)->widget, Get_Translations (t));
X    return Void;
X}
X
Xstatic Object P_Uninstall_Translations (w) Object w; {
X    Check_Widget (w);
X    XtUninstallTranslations (WIDGET(w)->widget);
X    return Void;
X}
X
Xinit_xt_translation () {
X    Define_Primitive (P_Augment_Translations,   "augment-translations",
X	2, 2, EVAL);
X    Define_Primitive (P_Override_Translations,  "override-translations",
X	2, 2, EVAL);
X    Define_Primitive (P_Uninstall_Translations, "uninstall-translations", 
X	1, 1, EVAL);
X}
END_OF_lib/xt/translation.c
if test 1039 -ne `wc -c <lib/xt/translation.c`; then
    echo shar: \"lib/xt/translation.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/widget.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/widget.c\"
else
echo shar: Extracting \"lib/xt/widget.c\" \(8487 characters\)
sed "s/^X//" >lib/xt/widget.c <<'END_OF_lib/xt/widget.c'
X#include "xt.h"
X
Xextern void XtManageChildren(), XtUnmanageChildren();
X
Xstatic Object P_Destroy_Widget();
X
XGeneric_Predicate (Widget);
X
XGeneric_Equal (Widget, WIDGET, widget);
X
XGeneric_Print (Widget, "#[widget %u]", POINTER(x));
X
XObject Make_Widget (widget) Widget widget; {
X    register char *p;
X    Object w;
X
X    if (widget == 0)
X	return Sym_None;
X    w = Find_Object (T_Widget, (GENERIC)0, Match_Xt_Obj, widget);
X    if (Nullp (w)) {
X	p = Get_Bytes (sizeof (struct S_Widget));
X	SET (w, T_Widget, (struct S_Widget *)p);
X	WIDGET(w)->tag = Null;
X	WIDGET(w)->widget = widget;
X	WIDGET(w)->free = 0;
X	XtAddCallback (widget, XtNdestroyCallback, Destroy_Callback_Proc,
X	    (caddr_t)0);
X	Register_Object (w, (GENERIC)0, P_Destroy_Widget, 0);
X    }
X    return w;
X}
X
XCheck_Widget (w) Object w; {
X    Check_Type (w, T_Widget);
X    if (WIDGET(w)->free)
X	Primitive_Error ("invalid widget: ~s", w);
X}
X
XCheck_Widget_Class (w, class) Object w; WidgetClass class; {
X    Check_Widget (w);
X    if (XtClass (WIDGET(w)->widget) != class)
X	Primitive_Error ("widget not of expected class: ~s", w);
X}
X
Xstatic Object P_Destroy_Widget (w) Object w; {
X    Check_Widget (w);
X    XtDestroyWidget (WIDGET(w)->widget);
X    return Void;
X}
X
Xstatic Object P_Create_Shell (argc, argv) Object *argv; {
X    register char *sn, *sc;
X    ArgList a;
X    Object name = argv[0], class = argv[1], w = argv[2], d = argv[3];
X
X    Make_C_String (name, sn);
X    Make_C_String (class, sc);
X    Check_Type (w, T_Class);
X    Check_Type (d, T_Display);
X    Encode_Arglist (argc-4, argv+4, a, (Widget)0, CLASS(w)->class);
X    return Make_Widget (XtAppCreateShell (sn, sc, CLASS(w)->class,
X	DISPLAY(d)->dpy, a, (Cardinal)(argc-4)/2));
X}
X
Xstatic Object P_Create_Widget (argc, argv) Object *argv; {
X    ArgList a;
X    char *name = 0;
X    Object x = argv[0], class, parent;
X
X    if (TYPE(x) != T_Class) {
X	Make_C_String (x, name);
X	argv++; argc--;
X    }
X    class = argv[0];
X    parent = argv[1];
X    Check_Type (class, T_Class);
X    Check_Widget (parent);
X    if (name == 0)
X	name = CLASS(class)->name;
X    Encode_Arglist (argc-2, argv+2, a, (Widget)0, CLASS(class)->class);
X    return Make_Widget (XtCreateWidget ((String)name, CLASS(class)->class,
X	WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2));
X}
X
Xstatic Object P_Realize_Widget (w) Object w; {
X    Check_Widget (w);
X    XtRealizeWidget (WIDGET(w)->widget);
X    return Void;
X}
X
Xstatic Object P_Unrealize_Widget (w) Object w; {
X    Check_Widget (w);
X    XtUnrealizeWidget (WIDGET(w)->widget);
X    return Void;
X}
X
Xstatic Object P_Widget_Realizedp (w) Object w; {
X    Check_Widget (w);
X    return XtIsRealized (WIDGET(w)->widget) ? True : False;
X}
X
Xstatic Object P_Widget_Display (w) Object w; {
X    Check_Widget (w);
X    return Make_Display (0, XtDisplay (WIDGET(w)->widget));
X}
X
Xstatic Object P_Widget_Parent (w) Object w; {
X    Check_Widget (w);
X    return Make_Widget (XtParent (WIDGET(w)->widget));
X}
X
Xstatic Object P_Widget_Window (w) Object w; {
X    Check_Widget (w);
X    return Make_Window (0, XtDisplay (WIDGET(w)->widget),
X	XtWindow (WIDGET(w)->widget));
X}
X
Xstatic Object P_Widget_Compositep (w) Object w; {
X    Check_Widget (w);
X    return XtIsComposite (WIDGET(w)->widget) ? True : False;
X}
X
Xstatic Object Manage_Unmanage (children, f) Object children; void (*f)(); {
X    register i, n;
X    Widget *buf;
X    Object tail;
X
X    Check_List (children);
X    n = Internal_Length (children);
X    buf = (Widget *)alloca (n * sizeof (Widget));
X    for (i = 0, tail = children; i < n; i++, tail = Cdr (tail)) {
X	Object w = Car (tail);
X	Check_Widget (w);
X	buf[i] = WIDGET(w)->widget;
X    }
X    f (buf, n);
X    return Void;
X}
X
Xstatic Object P_Manage_Children (children) Object children; {
X    return Manage_Unmanage (children, XtManageChildren);
X}
X
Xstatic Object P_Unmanage_Children (children) Object children; {
X    return Manage_Unmanage (children, XtUnmanageChildren);
X}
X
Xstatic Object P_Widget_Managedp (w) Object w; {
X    Check_Widget (w);
X    return XtIsManaged (WIDGET(w)->widget) ? True : False;
X}
X
Xstatic Object P_Widget_Class (w) Object w; {
X    Check_Widget (w);
X    return Make_Widget_Class (XtClass (WIDGET(w)->widget));
X}
X
Xstatic Object P_Widget_Superclass (w) Object w; {
X    Check_Widget (w);
X    if (XtClass (WIDGET(w)->widget) == widgetClass)
X	return Sym_None;
X    return Make_Widget_Class (XtSuperclass (WIDGET(w)->widget));
X}
X
Xstatic Object P_Widget_Subclassp (w, c) Object w, c; {
X    Check_Widget (w);
X    Check_Type (c, T_Class);
X    return XtIsSubclass (WIDGET(w)->widget, CLASS(c)->class) ? True : False;
X}
X
Xstatic Object P_Set_Mapped_When_Managed (w, m) Object w, m; {
X    Check_Widget (w);
X    Check_Type (m, T_Boolean);
X    XtSetMappedWhenManaged (WIDGET(w)->widget, EQ(m, True));
X    return Void;
X}
X
Xstatic Object P_Map_Widget (w) Object w; {
X    Check_Widget (w);
X    XtMapWidget (WIDGET(w)->widget);
X    return Void;
X}
X
Xstatic Object P_Unmap_Widget (w) Object w; {
X    Check_Widget (w);
X    XtUnmapWidget (WIDGET(w)->widget);
X    return Void;
X}
X
Xstatic Object P_Set_Values (argc, argv) Object *argv; {
X    ArgList a;
X    Widget w;
X    register i, n = (argc-1)/2;
X
X    Check_Widget (argv[0]);
X    w = WIDGET(argv[0])->widget;
X    Encode_Arglist (argc-1, argv+1, a, w, XtClass (w));
X    XtSetValues (w, a, (Cardinal)n);
X    for (i = 0; i < n; i++)
X	if (streq (a[i].name, XtNdestroyCallback))
X	    Fiddle_Destroy_Callback (w);
X    return Void;
X}
X
Xstatic Object P_Get_Values (argc, argv) Object *argv; {
X    Widget w;
X
X    Check_Widget (argv[0]);
X    w = WIDGET(argv[0])->widget;
X    return Get_Values (w, argc-1, argv+1);
X}
X
Xstatic Object P_Widget_Context (w) Object w; {
X    Check_Widget (w);
X    return Make_Context (XtWidgetToApplicationContext (WIDGET(w)->widget));
X}
X
Xstatic Object P_Set_Sensitive (w, s) Object w, s; {
X    Check_Widget (w);
X    Check_Type (s, T_Boolean);
X    XtSetSensitive (WIDGET(w)->widget, EQ(s, True));
X    return Void;
X}
X
Xstatic Object P_Sensitivep (w) Object w; {
X    Check_Widget (w);
X    return XtIsSensitive (WIDGET(w)->widget) ? True : False;
X}
X
Xstatic Object P_Window_To_Widget (w) Object w; {
X    Check_Type (w, T_Window);
X    return Make_Widget (XtWindowToWidget (WINDOW(w)->dpy,
X	WIDGET(w)->widget));
X}
X
Xstatic Object P_Name_To_Widget (root, name) Object root, name; {
X    register char *s;
X
X    Check_Widget (root);
X    Make_C_String (name, s);
X    return Make_Widget (XtNameToWidget (WIDGET(root)->widget, s));
X}
X
Xinit_xt_widget () {
X    Generic_Define (Widget, "widget", "widget?");
X    Define_Primitive (P_Destroy_Widget,    "destroy-widget",    1, 1, EVAL);
X    Define_Primitive (P_Create_Shell,      "create-shell",  4, MANY, VARARGS);
X    Define_Primitive (P_Create_Widget,     "create-widget", 2, MANY, VARARGS);
X    Define_Primitive (P_Realize_Widget,    "realize-widget",    1, 1, EVAL);
X    Define_Primitive (P_Unrealize_Widget,  "unrealize-widget",  1, 1, EVAL);
X    Define_Primitive (P_Widget_Realizedp,  "widget-realized?",  1, 1, EVAL);
X    Define_Primitive (P_Widget_Display,    "widget-display",    1, 1, EVAL);
X    Define_Primitive (P_Widget_Parent,     "widget-parent",     1, 1, EVAL);
X    Define_Primitive (P_Widget_Window,     "widget-window",     1, 1, EVAL);
X    Define_Primitive (P_Widget_Compositep, "widget-composite?", 1, 1, EVAL);
X    Define_Primitive (P_Manage_Children,   "manage-children",   1, 1, EVAL);
X    Define_Primitive (P_Unmanage_Children, "unmanage-children", 1, 1, EVAL);
X    Define_Primitive (P_Widget_Managedp,   "widget-managed?",   1, 1, EVAL);
X    Define_Primitive (P_Widget_Class,      "widget-class",      1, 1, EVAL);
X    Define_Primitive (P_Widget_Superclass, "widget-superclass", 1, 1, EVAL);
X    Define_Primitive (P_Widget_Subclassp,  "widget-subclass?",  2, 2, EVAL);
X    Define_Primitive (P_Set_Mapped_When_Managed,
X				  "set-mapped-when-managed!",   2, 2, EVAL);
X    Define_Primitive (P_Map_Widget,        "map-widget",        1, 1, EVAL);
X    Define_Primitive (P_Unmap_Widget,      "unmap-widget",      1, 1, EVAL);
X    Define_Primitive (P_Set_Values,        "set-values!",   1, MANY, VARARGS);
X    Define_Primitive (P_Get_Values,        "get-values",    1, MANY, VARARGS);
X    Define_Primitive (P_Widget_Context,    "widget-context",    1, 1, EVAL);
X    Define_Primitive (P_Set_Sensitive,     "set-sensitive!",    2, 2, EVAL);
X    Define_Primitive (P_Sensitivep,        "widget-sensitive?", 1, 1, EVAL);
X    Define_Primitive (P_Window_To_Widget,  "window->widget",    1, 1, EVAL);
X    Define_Primitive (P_Name_To_Widget,    "name->widget",      2, 2, EVAL);
X}
END_OF_lib/xt/widget.c
if test 8487 -ne `wc -c <lib/xt/widget.c`; then
    echo shar: \"lib/xt/widget.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/make-widget -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/make-widget\"
else
echo shar: Extracting \"lib/xt/make-widget\" \(5113 characters\)
sed "s/^X//" >lib/xt/make-widget <<'END_OF_lib/xt/make-widget'
X;;; -*-Scheme-*-
X
X(define type-name #f)
X
X(define classes ())
X(define callbacks ())
X(define primitives ())
X(define converters ())
X
X(define f)
X
X(define (check-string proc x name)
X  (if (not (memq (type x) '(symbol string)))
X      (error proc (format #f "~s must be string or symbol" name))))
X
X(define (define-widget-type name include . prolog)
X    (if type-name
X	(error 'define-widget-type "must be called once"))
X    (check-string 'define-widget-type name 'name)
X    (check-string 'define-widget-type include 'include)
X    (set! type-name name)
X    (format f "#include \"../xt/xt.h\"~%")
X    (case widget-set
X      (xhp
X       (format f "#include <X11/Xw/Xw.h>~%")))
X    (case widget-set
X      (xaw
X       (format f "#include <X11/~a>~%~%" include))
X      (xhp
X       (format f "#include <X11/Xw/~a>~%~%" include)))
X    (if prolog
X	(begin
X	  (check-string 'define-widget-type (car prolog) 'prolog)
X	  (display (car prolog) f)
X	  (format f "~%~%"))))
X
X(define (define-callback class name has-arg?)
X  (check-string 'define-callback class 'class)
X  (check-string 'define-callback name 'name)
X  (if (not (boolean? has-arg?))
X      (error 'define-callback "has-arg? must be boolean"))
X  (set! callbacks (cons (list class name has-arg?) callbacks)))
X
X(define (c->scheme name body)
X  (check-string 'c->scheme name 'name)
X  (define c-name (scheme-to-c-name name))
X  (string-set! c-name 0 #\S)
X  (format f "static Object ~a (x) XtArgVal x; {~%" c-name)
X  (display body f)
X  (format f "~%}~%~%")
X  (define s
X    (format #f "    Define_Converter_To_Scheme (\"~a\", ~a);~%"
X	    name c-name))
X  (set! converters (cons s converters)))
X
X(define (scheme->c name body)
X  (check-string 'scheme->c name 'name)
X  (define c-name (scheme-to-c-name name))
X  (string-set! c-name 0 #\C)
X  (format f "static XtArgVal ~a (x) Object x; {~%" c-name)
X  (display body f)
X  (format f "~%}~%~%")
X  (define s
X    (format #f "    Define_Converter_To_C (\"~a\", ~a);~%"
X	    name c-name))
X  (set! converters (cons s converters)))
X
X(define (define-primitive scheme-name args body)
X  (check-string 'define-primitive scheme-name 'scheme-name)
X  (if (not (pair? args))
X      (error 'define-primitive "args must be a list"))
X  (define c-name (scheme-to-c-name scheme-name))
X  (format f "static Object ~a (" c-name)
X  (do ((a args a)) ((null? a))
X    (display (car a) f)
X    (set! a (cdr a))
X    (if a (display ", " f)))
X  (display ") " f)
X  (if args
X      (begin
X	(display "Object " f)
X	(do ((a args a)) ((null? a))
X	  (display (car a) f)
X	  (set! a (cdr a))
X	  (if a (display ", " f)))
X	(display "; {" f)))
X  (newline f)
X  (display body f)
X  (format f "~%}~%~%")
X  (define s
X    (format #f "    Define_Primitive (~a, \"~a\", ~a, ~a, EVAL);~%"
X	    c-name scheme-name (length args) (length args)))
X  (set! primitives (cons s primitives)))
X
X;;; [missing conversion from -> to "to"]
X(define (scheme-to-c-name s)
X  (if (symbol? s)
X      (set! s (symbol->string s)))
X  (define len (string-length s))
X  (if (char=? (string-ref s (1- len)) #\?)
X      (string-set! s (1- len) #\p))
X  (if (char=? (string-ref s (1- len)) #\!)
X      (set! len (1- len)))
X  (let loop ((ret "P") (i 0))
X    (if (>= i len)
X	ret
X	(define next
X	  (do ((j i (1+ j))) ((or (= j len) (char=? (string-ref s j) #\-)) j)))
X	(loop (format #f "~a_~a~a" ret (char-upcase (string-ref s i))
X		      (substring s (1+ i) next)) (1+ next)))))
X
X(define (define-widget-class name class . sub-resources)
X  (check-string 'define-widget-class name 'name)
X  (check-string 'define-widget-class class 'class)
X  (set! classes (cons (list name class sub-resources) classes)))
X
X(define args (command-line-args))
X(if (not (= (length args) 3))
X    (error 'make-widget "expected three arguments"))
X(define widget-set (string->symbol (caddr args)))
X(set! f (open-output-file (cadr args)))
X(load (car args))
X(if (not type-name)
X    (error 'make-widget "no widget type defined"))
X(if (null? classes)
X    (error 'make-widget "no class definitions"))
X(format f "init_~a () {~%" type-name)
X(format f "    XtResourceList r = 0;~%")
X(do ((c classes (cdr c))) ((null? c))
X  (define cl (car c))
X  (define res (caddr cl))
X  (if res
X      (begin
X	(format f
X	  "    r = (XtResourceList)XtMalloc (~a * sizeof (XtResource));~%"
X	  (length res))
X	(do ((r res (cdr r)) (num 0 (1+ num))) ((null? r))
X	  (define x (car r))
X	  (if (not (= (length x) 3))
X	      (error 'make-widget "bad sub-resource declaration"))
X	  (for-each
X	   (lambda (r)
X	     (if (not (memq (type r) '(symbol string)))
X		 (error 'make-widget "bad type in sub-resource declaration")))
X	   x)
X	  (format f "    r[~a].resource_name = \"~a\";~%" num (car x))
X	  (format f "    r[~a].resource_class = \"~a\";~%" num (cadr x))
X	  (format f "    r[~a].resource_type = \"~a\";~%" num (caddr x)))))
X  (format f "    Define_Class (\"~a\", ~a, r, ~a);~%" (car cl) (cadr cl)
X	  (length res)))
X(do ((c callbacks (cdr c))) ((null? c))
X  (define cb (car c))
X  (format f "    Define_Callback (\"~a\", \"~a\", ~a);~%" (car cb) (cadr cb)
X	  (if (caddr cb) 1 0)))
X(for-each (lambda (x) (display x f)) primitives)
X(for-each (lambda (x) (display x f)) converters)
X(format f "}~%")
END_OF_lib/xt/make-widget
if test 5113 -ne `wc -c <lib/xt/make-widget`; then
    echo shar: \"lib/xt/make-widget\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/converter.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/converter.c\"
else
echo shar: Extracting \"lib/xt/converter.c\" \(1104 characters\)
sed "s/^X//" >lib/xt/converter.c <<'END_OF_lib/xt/converter.c'
X#include "xt.h"
X
X#define MAX_CONVERTER   32
X
Xtypedef struct {
X    char *name;
X    int scheme_to_c;
X    PFO to_scheme;
X    PFX to_c;
X} CONVERTER;
X
Xstatic CONVERTER ctab[MAX_CONVERTER], *clast = ctab;
X
XDefine_Converter_To_Scheme (name, c) char *name; PFO c; {
X    Error_Tag = "c->scheme";
X    if (clast == ctab+MAX_CONVERTER)
X	Primitive_Error ("too many converters");
X    clast->name = name;
X    clast->scheme_to_c = 0;
X    clast->to_scheme = c;
X    clast++;
X}
X
XDefine_Converter_To_C (name, c) char *name; PFX c; {
X    Error_Tag = "scheme->c";
X    if (clast == ctab+MAX_CONVERTER)
X	Primitive_Error ("too many converters");
X    clast->name = name;
X    clast->scheme_to_c = 1;
X    clast->to_c = c;
X    clast++;
X}
X
XPFO Find_Converter_To_Scheme (name) char *name; {
X    register CONVERTER *p;
X
X    for (p = ctab; p < clast; p++)
X	if (!p->scheme_to_c && streq (p->name, name))
X	    return p->to_scheme;
X    return 0;
X}
X
XPFX Find_Converter_To_C (name) char *name; {
X    register CONVERTER *p;
X
X    for (p = ctab; p < clast; p++)
X	if (p->scheme_to_c && streq (p->name, name))
X	    return p->to_c;
X    return 0;
X}
END_OF_lib/xt/converter.c
if test 1104 -ne `wc -c <lib/xt/converter.c`; then
    echo shar: \"lib/xt/converter.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/popup.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/popup.c\"
else
echo shar: Extracting \"lib/xt/popup.c\" \(1335 characters\)
sed "s/^X//" >lib/xt/popup.c <<'END_OF_lib/xt/popup.c'
X#include "xt.h"
X
Xstatic SYMDESCR Grab_Kind_Syms[] = {
X    { "grab-none",         XtGrabNone },
X    { "grab-nonexclusive", XtGrabNonexclusive },
X    { "grab-exclusive",    XtGrabExclusive },
X    { 0, 0 }
X};
X
Xstatic Object P_Create_Popup_Shell (argc, argv) Object *argv; {
X    ArgList a;
X    char *name = 0;
X    Object x = argv[0], class, parent;
X
X    if (TYPE(x) != T_Class) {
X	Make_C_String (x, name);
X	argv++; argc--;
X    }
X    class = argv[0];
X    parent = argv[1];
X    Check_Type (class, T_Class);
X    Check_Widget (parent);
X    if (name == 0)
X	name = CLASS(class)->name;
X    Encode_Arglist (argc-2, argv+2, a, (Widget)0, CLASS(class)->class);
X    return Make_Widget (XtCreatePopupShell (name, CLASS(class)->class,
X	WIDGET(parent)->widget, a, (Cardinal)(argc-2)/2));
X}
X
Xstatic Object P_Popup (shell, grab_kind) Object shell, grab_kind; {
X    Check_Widget (shell);
X    XtPopup (WIDGET(shell)->widget, Symbols_To_Bits (grab_kind, 0,
X	Grab_Kind_Syms));
X    return Void;
X}
X
Xstatic Object P_Popdown (shell) Object shell; {
X    Check_Widget (shell);
X    XtPopdown (WIDGET(shell)->widget);
X    return Void;
X}
X
Xinit_xt_popup () {
X    Define_Primitive (P_Create_Popup_Shell, "create-popup-shell",
X					    2, MANY, VARARGS);
X    Define_Primitive (P_Popup,   "popup",   2, 2, EVAL);
X    Define_Primitive (P_Popdown, "popdown", 1, 1, EVAL);
X}
END_OF_lib/xt/popup.c
if test 1335 -ne `wc -c <lib/xt/popup.c`; then
    echo shar: \"lib/xt/popup.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/resource.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/resource.c\"
else
echo shar: Extracting \"lib/xt/resource.c\" \(14293 characters\)
sed "s/^X//" >lib/xt/resource.c <<'END_OF_lib/xt/resource.c'
X#include "xt.h"
X#include <X11/Xmu.h>
X
X#include <ctype.h>
X
Xstatic SYMDESCR Orientation_Syms[] = {
X    { "horizontal",         XtorientHorizontal },
X    { "vertical",           XtorientVertical },
X    { 0, 0 }
X};
X
Xstatic SYMDESCR Justify_Syms[] = {
X    { "left",              XtJustifyLeft },
X    { "center",            XtJustifyCenter },
X    { "right",             XtJustifyRight },
X    { 0, 0 }
X};
X
X#define XtRFloat             "Float"
X#define XtRWidget            "Widget"
X
X#define T_Unknown            -1
X#define T_String_Or_Symbol   -2
X#define T_Callbacklist       -3
X#define T_Float              -4
X#define T_Backing_Store      -5
X#define T_Orientation        -6
X#define T_Justify            -7
X#define T_Translations       -8
X
Xstatic Resource_To_Scheme_Type (t) register char *t; {
X    if (streq (XtRBackingStore, t))
X	return T_Backing_Store;
X    else if (streq (XtRBoolean, t))
X	return T_Boolean;
X    else if (streq (XtRCallback, t))
X	return T_Callbacklist;
X    else if (streq (XtRCursor, t))
X	return T_Cursor;
X    else if (streq (XtRDimension, t))
X	return T_Fixnum;
X    else if (streq (XtRDisplay, t))
X	return T_Display;
X    else if (streq (XtRFloat, t))
X	return T_Float;
X    else if (streq (XtRFont, t))
X	return T_Font;
X    else if (streq (XtRFontStruct, t))
X	return T_Font;
X    else if (streq (XtRInt, t))
X	return T_Fixnum;
X    else if (streq (XtRJustify, t))
X	return T_Justify;
X    else if (streq (XtROrientation, t))
X	return T_Orientation;
X    else if (streq (XtRPixel, t))
X	return T_Pixel;
X    else if (streq (XtRPixmap, t))
X	return T_Pixmap;
X    else if (streq (XtRPosition, t))
X	return T_Fixnum;
X    else if (streq (XtRShort, t))
X	return T_Fixnum;
X    else if (streq (XtRString, t))
X	return T_String_Or_Symbol;
X    else if (streq (XtRTranslationTable, t))
X	return T_Translations;
X    else if (streq (XtRUnsignedChar, t))
X	return T_Character;
X    else if (streq (XtRWidget, t))
X	return T_Widget;
X    else if (streq (XtRWindow, t))
X	return T_Window;
X    return T_Unknown;
X}
X
XGet_All_Resources (w, c, rp, np, cp) Widget w; WidgetClass c;
X	XtResource **rp; int *np, *cp; {
X    XtResource *r, *sr, *cr;
X    int nr, snr = 0, cnr = 0;
X
X    XtGetResourceList (c, &r, &nr);
X    if (w == 0) /* Not allowed with get-values and set-values! */
X	Get_Sub_Resource_List (c, &sr, &snr);
X    if (w && XtParent (w))
X	XtGetConstraintResourceList (XtClass (XtParent (w)), &cr, &cnr);
X    *np = nr + snr + cnr;
X    *cp = cnr;
X    *rp = (XtResource *)XtMalloc (*np * sizeof (XtResource));
X    bcopy ((char *)r, (char *)*rp, nr * sizeof (XtResource));
X    XtFree ((char *)r);
X    if (snr)
X	bcopy ((char *)sr, (char *)(*rp + nr), snr * sizeof (XtResource));
X    if (cnr) {
X	bcopy ((char *)cr, (char *)(*rp + nr+snr), cnr * sizeof (XtResource));
X	XtFree ((char *)cr);
X    }
X}
X
XConvert_Args (ac, av, to, widget, class) Object *av; ArgList to;
X	Widget widget; WidgetClass class; {
X    register char *name, *res;
X    register i, j, k;
X    Object arg, val;
X    XtResource *r;
X    int nr, nc;
X    int st, dt;
X    char key[128];
X    PFX converter;
X
X    if (ac & 1)
X	Primitive_Error ("missing argument value");
X    Get_All_Resources (widget, class, &r, &nr, &nc);
X    /* Note:
X     * `r' is not freed in case of error.
X     */
X    for (i = k = 0; k < ac; i++, k++) {
X	arg = av[k];
X	Make_C_String (arg, name);
X	Make_Resource_Name (name);
X	for (j = 0; j < nr && !streq (name, r[j].resource_name); j++)
X	    ;
X	if (j == nr)
X	    Primitive_Error ("no such resource: ~s", arg);
X	res = r[j].resource_name;
X	val = av[++k];
X	st = TYPE(val);
X	dt = Resource_To_Scheme_Type (r[j].resource_type);
X
X	if (widget && j >= nr-nc)
X	    class = XtClass (XtParent (widget));
X	sprintf (key, "%s-%s", Class_Name (class), name);
X	converter = Find_Converter_To_C (key);
X
X	if (converter) {
X	    XtArgVal ret = converter (val);
X	    XtSetArg (to[i], res, ret);
X	} else if (dt == T_String_Or_Symbol) {
X	    char *s;
X
X	    Make_C_String (val, s);
X	    XtSetArg (to[i], res, XtNewString (s));  /* Never freed! */
X	} else if (dt == T_Callbacklist) {
X	    int n;
X	    XtCallbackList callbacks;
X
X	    Check_Callback_List (val);
X	    n = Internal_Length (val);
X	    callbacks = (XtCallbackRec *)  /* Never freed! */
X		    XtMalloc ((n+1) * sizeof (XtCallbackRec));
X	    callbacks[n].callback = 0;
X	    callbacks[n].closure = 0;
X	    Fill_Callbacks (val, callbacks, n,
X		Find_Callback_Converter (class, name, arg));
X	    XtSetArg (to[i], res, callbacks);
X	} else if (dt == T_Float) {
X	    float f = (float)Get_Double (val);
X	    to[i].name = res;
X	    bcopy ((char *)&f, (char *)&to[i].value, sizeof f);
X	} else if (dt == T_Backing_Store) {
X	    XtSetArg (to[i], res, Symbols_To_Bits (val, 0,
X		Backing_Store_Syms));
X	} else if (dt == T_Orientation) {
X	    XtSetArg (to[i], res, Symbols_To_Bits (val, 0, Orientation_Syms));
X	} else if (dt == T_Justify) {
X	    XtSetArg (to[i], res, Symbols_To_Bits (val, 0, Justify_Syms));
X	} else if (dt == T_Translations) {
X	    XtSetArg (to[i], res, Get_Translations (val));
X	} else {
X	    if (st != dt) {
X		char msg[128];
X		if (widget && (st == T_String || st == T_Symbol)) {
X		    char *s;
X		    XrmValue src, dst;
X
X		    Make_C_String (val, s);
X		    src.size = strlen (s);
X		    src.addr = (caddr_t)s;
X		    XtConvert (widget, (String)XtRString, &src,
X			r[j].resource_type, &dst);
X		    if (dst.addr) {
X			XtSetArg (to[i], res, *(XtArgVal *)dst.addr);
X			goto done;
X		    }
X		}
X		sprintf (msg, "%s: can't convert %s ~s to %s", name,
X		    Types[st].name, r[j].resource_type);
X		Primitive_Error (msg, val);
X	    }
X	    if (dt == T_Boolean) {
X		XtSetArg (to[i], res, EQ(val, True));
X	    } else if (dt == T_Cursor) {
X		XtSetArg (to[i], res, CURSOR(val)->cursor);
X	    } else if (dt == T_Fixnum) {
X		XtSetArg (to[i], res, FIXNUM(val));
X	    } else if (dt == T_Display) {
X		XtSetArg (to[i], res, DISPLAY(val)->dpy);
X	    } else if (dt == T_Font) {
X		Open_Font_Maybe (val);
X		if (streq (r[j].resource_type, XtRFontStruct))
X		    XtSetArg (to[i], res, FONT(val)->info);
X		else
X		    XtSetArg (to[i], res, FONT(val)->id);
X	    } else if (dt == T_Pixel) {
X		XtSetArg (to[i], res, PIXEL(val)->pix);
X	    } else if (dt == T_Pixmap) {
X		XtSetArg (to[i], res, PIXMAP(val)->pm);
X	    } else if (dt == T_Character) {
X		XtSetArg (to[i], res, CHAR(val));
X	    } else if (dt == T_Widget) {
X		XtSetArg (to[i], res, WIDGET(val)->widget);
X	    } else if (dt == T_Window) {
X		XtSetArg (to[i], res, WINDOW(val)->win);
X	    } else Panic ("bad conversion type");
X	} 
Xdone: ;
X    }
X    XtFree ((char *)r);
X}
X
XObject Get_Values (w, ac, av) Widget w; Object *av; {
X    register char *name;
X    register i, j;
X    Object arg;
X    XtResource *r;
X    int nr, nc;
X    int t;
X    ArgList argl;
X    Object ret, tail;
X    Display *dpy;
X    char key[128];
X    PFO converter;
X    Widget w2;
X    GC_Node2;
X
X    argl = (Arg *)alloca (ac * sizeof (Arg));
X    Get_All_Resources (w, XtClass (w), &r, &nr, &nc);
X    /* Note:
X     * `r' is not freed in case of error.
X     */
X    for (i = 0; i < ac; i++) {
X	arg = av[i];
X	Check_Type (arg, T_Symbol);
X	Make_C_String (arg, name);
X	Make_Resource_Name (name);
X	for (j = 0; j < nr && !streq (name, r[j].resource_name); j++)
X	    ;
X	if (j == nr)
X	    Primitive_Error ("no such resource: ~s", arg);
X	argl[i].name = name;
X	argl[i].value = (XtArgVal)alloca (r[j].resource_size);
X    }
X    XtGetValues (w, argl, (Cardinal)ac);
X    ret = tail = P_Make_List (Make_Fixnum (ac), Null);
X    GC_Link2 (ret, tail);
X    /*
X     * Display is needed for resources like cursor and pixmap.
X     * XtDisplay(w) is not necessarily the right one!
X     */
X    dpy = XtDisplay (w);
X    for (i = 0; i < ac; i++, tail = Cdr (tail)) {
X	Object o;
X	XtArgVal val = argl[i].value;
X	for (j = 0; j < nr && !streq (argl[i].name, r[j].resource_name); j++)
X	    ;
X	t = Resource_To_Scheme_Type (r[j].resource_type);
X
X	w2 = (j >= nr-nc) ? XtParent (w) : w;
X	sprintf (key, "%s-%s", Class_Name (XtClass (w2)), argl[i].name);
X	converter = Find_Converter_To_Scheme (key);
X
X	if (converter) {
X	    o = converter (*(XtArgVal **)val);
X	} else if (t == T_String_Or_Symbol) {
X	    char *s = *(char **)val;
X
X	    if (s == 0) s = "";
X	    o = Make_String (s, strlen (s));
X	} else if (t == T_Callbacklist) {
X	    register i, n;
X	    Object ret, tail;
X	    XtCallbackList callbacks = *(XtCallbackList *)val;
X	    GC_Node;
X
X	    for (n = 0; callbacks[n].callback; n++)
X		;
X	    ret = tail = P_Make_List (Make_Fixnum (n), Null);
X	    GC_Link2 (ret, tail);
X	    for (i = 0; i < n; i++, tail = Cdr (tail))
X		Car (tail) = Get_Callbackfun (callbacks[i].closure);
X	    GC_Unlink;
X	    o = ret;
X	} else if (t == T_Float) {
X	    o = Make_Reduced_Flonum ((double)*(float *)val);
X	} else if (t == T_Backing_Store) {
X	    o = Bits_To_Symbols ((unsigned long)*(int *)val, 0,
X		Backing_Store_Syms);
X	    if (Nullp (o))
X		Primitive_Error ("invalid backing-store (Xt bug)");
X	} else if (t == T_Orientation) {
X	    o = Bits_To_Symbols ((unsigned long)*(int *)val, 0,
X		Orientation_Syms);
X	} else if (t == T_Justify) {
X	    o = Bits_To_Symbols ((unsigned long)*(int *)val, 0, Justify_Syms);
X	} else if (t == T_Boolean) {
X	    o = (Boolean)*(Boolean *)val ? True : False;
X	} else if (t == T_Cursor) {
X	    o = Make_Cursor (dpy, *(Cursor *)val);
X	} else if (t == T_Fixnum) {
X	    /*
X	     * Assumption: Dimension and Position are short!
X	     */
X	    if (streq (r[j].resource_type, XtRInt))
X		o = Make_Integer (*(int *)val);
X	    else
X		o = Make_Integer (*(short *)val);
X	} else if (t == T_Display) {
X	    o = Make_Display (0, dpy);
X	} else if (t == T_Font) {
X	    if (streq (r[j].resource_type, XtRFontStruct)) {
X		o = Make_Font (dpy, False, (Font)0, *(XFontStruct **)val);
X	    } else {
X		XFontStruct *info;
X		Disable_Interrupts;
X		info = XQueryFont (dpy, *(Font *)val);
X		Enable_Interrupts;
X		o = Make_Font (dpy, False, *(Font *)val, info);
X	    }
X	} else if (t == T_Pixel) {
X	    o = Make_Pixel (*(unsigned long *)val);
X	} else if (t == T_Pixmap) {
X	    o = Make_Pixmap (dpy, *(Pixmap *)val);
X	} else if (t == T_Character) {
X	    o = Make_Char (*(unsigned char *)val);
X	} else if (t == T_Widget) {
X	    o = Make_Widget (*(Widget *)val);
X	} else if (t == T_Window) {
X	    o = Make_Window (0, dpy, *(Window *)val);
X	} else {
X	    char s[128];
X	    sprintf (s, "%s: no converter for %s", argl[i].name,
X		r[j].resource_type);
X	    Primitive_Error (s);
X	}
X	Car (tail) = o;
X    }
X    XtFree ((char *)r);
X    GC_Unlink;
X    return ret;
X}
X
X/* Convert `mapped-when-managed' to `mappedWhenManaged'.
X */
XMake_Resource_Name (s) register char *s; {
X    register char *p;
X
X    for (p = s; *s; ) {
X	if (*s == '-') {
X	    if (*++s) {
X		if (islower (*s))
X		    *s = toupper (*s);
X		*p++ = *s++;
X	    }
X	} else *p++ = *s++;
X    }
X    *p = '\0';
X}
X
XObject Get_Resources (c, fun, freeit) WidgetClass c; void (*fun)(); {
X    XtResource *r;
X    register XtResource *p;
X    int nr;
X    Object ret, tail, tail2, x;
X    GC_Node3;
X    
X    fun (c, &r, &nr);
X    /* Note:
X     * `r' is not freed in case of error.
X     */
X    ret = tail = tail2 = P_Make_List (Make_Fixnum (nr), Null);
X    GC_Link3 (ret, tail, tail2);
X    for (p = r; p < r+nr; p++, tail = Cdr (tail)) {
X	x = tail2 = P_Make_List (Make_Fixnum (3), Null);
X	Car (tail) = tail2 = x;
X	x = Intern (p->resource_name);
X	Car (tail2) = x; tail2 = Cdr (tail2);
X	x = Intern (p->resource_class);
X	Car (tail2) = x; tail2 = Cdr (tail2);
X	x = Intern (p->resource_type);
X	Car (tail2) = x;
X    }
X    GC_Unlink;
X    if (freeit) XtFree ((char *)r);
X    return ret;
X}
X
X/* --------------------------------------------------------------------
X *
X * Delete this when XtGetConstraintResourceList() is provided by
X * the Xt intrinsics.
X *
X * This code has been written by Paul Asente <asente at wsl.dec.com>.
X *
X * Copyright 1985, 1986, 1987, 1988 by the Massachusetts Institute
X * of Technology
X * 
X * Permission to use, copy, modify, and distribute this
X * software and its documentation for any purpose and without
X * fee is hereby granted, provided that the above copyright
X * notice appear in all copies and that both that copyright
X * notice and this permission notice appear in supporting
X * documentation, and that the name of M.I.T. not be used in
X * advertising or publicity pertaining to distribution of the
X * software without specific, written prior permission.
X * M.I.T. makes no representations about the suitability of
X * this software for any purpose.  It is provided "as is"
X * without express or implied warranty.
X *
X */
X
X#include <X11/Intrinsic.h>
X#include <X11/IntrinsicP.h>
X#include <X11/CoreP.h>
X
Xvoid XtGetConstraintResourceList(widget_class, resources, num_resources)
X	WidgetClass widget_class;
X	XtResourceList *resources;
X	Cardinal *num_resources;
X{
X	if (_XtClassIsSubclass(widget_class, constraintWidgetClass)) {
X	    ConstraintWidgetClass cwc = (ConstraintWidgetClass) widget_class;
X
X	    GetResourceList(widget_class, resources, num_resources,
X		    cwc->constraint_class.num_resources,
X		    cwc->constraint_class.resources);
X	} else {
X	    *resources = NULL;
X	    *num_resources = 0;
X	}
X}
X
Xstatic GetResourceList(widget_class, resources, num_resources, count, r_source)
X	WidgetClass widget_class;
X	XtResourceList *resources;
X	Cardinal *num_resources;
X	Cardinal count;
X	XtResourceList r_source;
X{
X	int size = count * sizeof(XtResource);
X	register int i, dest = 0;
X	register XtResourceList dlist;
X	register XtResourceList *source;
X
X	*resources = (XtResourceList) XtMalloc((unsigned) size);
X
X	if (!widget_class->core_class.class_inited) {
X	    /* Easy case */
X
X	    bcopy((char *) r_source, (char *) *resources, size);
X	    *num_resources = count;
X	    return;
X	}
X
X	/* Nope, it's the hard case */
X
X	dlist = *resources;
X	source = (XtResourceList *) r_source;
X	for (i = 0; i < count; i++) {
X	    if (source[i] != NULL) {
X		dlist[dest].resource_name = (String)
X			XrmQuarkToString((XrmQuark) source[i]->resource_name);
X		dlist[dest].resource_class = (String) 
X			XrmQuarkToString((XrmQuark) source[i]->resource_class);
X		dlist[dest].resource_type = (String)
X			XrmQuarkToString((XrmQuark) source[i]->resource_type);
X		dlist[dest].resource_size = source[i]->resource_size;
X		dlist[dest].resource_offset = -(source[i]->resource_offset + 1);
X		dlist[dest].default_type = (String)
X			XrmQuarkToString((XrmQuark) source[i]->default_type);
X		dlist[dest].default_addr = source[i]->default_addr;
X		dest++;
X	    }
X	}
X	*num_resources = dest;
X}
END_OF_lib/xt/resource.c
if test 14293 -ne `wc -c <lib/xt/resource.c`; then
    echo shar: \"lib/xt/resource.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/BUGS -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/BUGS\"
else
echo shar: Extracting \"lib/xt/BUGS\" \(960 characters\)
sed "s/^X//" >lib/xt/BUGS <<'END_OF_lib/xt/BUGS'
XResources that are inherited from a superclass cannot be set
Xby functions like create-widget; they must be set after the
Xwidget has been created by a call to set-values!.
XThis restriction is only there for the first widget of each class.
X
XThe reason for this is that the complete resource list is
Xnot available (through XtGetResourceList) before the class
Xhas been initialized.
X
XConstraint resources also can only be set by means of set-values!.
X
XSubresources, on the other hand, can only be set by functions like
Xcreate-widget (this is a restriction imposed by Xt).  Subresources
Xcannot be read with get-values.  In addition, converters do not
Xwork for subresources (since XtConvert needs a widget instance).
X
X
XCallbacks *must* return; e.g. a (reset) from within a callback is
Xnot allowed.  This is a bug in Xt.
X
X
XMissing: context-add-input, context-remove-input, accelerators
Xresource converters, keycode translators, case converters,
Xshared GCs, selections
END_OF_lib/xt/BUGS
if test 960 -ne `wc -c <lib/xt/BUGS`; then
    echo shar: \"lib/xt/BUGS\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/identifier.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xt/identifier.c\"
else
echo shar: Extracting \"lib/xt/identifier.c\" \(1146 characters\)
sed "s/^X//" >lib/xt/identifier.c <<'END_OF_lib/xt/identifier.c'
X
X#include "xt.h"
X
XGeneric_Predicate (Identifier);
X
Xstatic Object Identifier_Equal (x, y) Object x, y; {
X    register struct S_Identifier *p = IDENTIFIER(x), *q = IDENTIFIER(y);
X    return p->type == q->type && p->val == q->val && !p->free && !q->free;
X}
X
XGeneric_Print (Identifier, "#[identifier %u]", POINTER(x));
X
XObject Make_Id (type, val, num) caddr_t val; {
X    register char *p;
X    Object i;
X
X    i = Find_Object (T_Identifier, (GENERIC)0, Match_Xt_Obj, type, val);
X    if (Nullp (i)) {
X	p = Get_Bytes (sizeof (struct S_Identifier));
X	SET (i, T_Identifier, (struct S_Identifier *)p);
X	IDENTIFIER(i)->tag = Null;
X	IDENTIFIER(i)->type = type;
X	IDENTIFIER(i)->val = val;
X	IDENTIFIER(i)->num = num;
X	IDENTIFIER(i)->free = 0;
X	Register_Object (i, (GENERIC)0, (PFO)0, 0);
X    }
X    return i;
X}
X
Xcaddr_t Use_Id (x, type) Object x; {
X    Check_Type (x, T_Identifier);
X    if (IDENTIFIER(x)->type != type || IDENTIFIER(x)->free)
X	Primitive_Error ("invalid identifier");
X    IDENTIFIER(x)->free = 1;
X    Deregister_Object (x);
X    return IDENTIFIER(x)->val;
X}
X
Xinit_xt_identifier () {
X    Generic_Define (Identifier, "identifier", "identifier?");
X}
END_OF_lib/xt/identifier.c
if test 1146 -ne `wc -c <lib/xt/identifier.c`; then
    echo shar: \"lib/xt/identifier.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d lib/util ; then
    echo shar: Creating directory \"lib/util\"
    mkdir lib/util
fi
if test -f lib/util/symbol.h -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/util/symbol.h\"
else
echo shar: Extracting \"lib/util/symbol.h\" \(142 characters\)
sed "s/^X//" >lib/util/symbol.h <<'END_OF_lib/util/symbol.h'
Xtypedef struct {
X    char *name;
X    unsigned long val;
X} SYMDESCR;
X
Xextern unsigned long Symbols_To_Bits();
Xextern Object Bits_To_Symbols();
END_OF_lib/util/symbol.h
if test 142 -ne `wc -c <lib/util/symbol.h`; then
    echo shar: \"lib/util/symbol.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/objects.h -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/util/objects.h\"
else
echo shar: Extracting \"lib/util/objects.h\" \(56 characters\)
sed "s/^X//" >lib/util/objects.h <<'END_OF_lib/util/objects.h'
Xtypedef Object (*PFO)();
X
Xextern Object Find_Object ();
END_OF_lib/util/objects.h
if test 56 -ne `wc -c <lib/util/objects.h`; then
    echo shar: \"lib/util/objects.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d lib/xhp ; then
    echo shar: Creating directory \"lib/xhp\"
    mkdir lib/xhp
fi
echo shar: End of archive 13 \(of 14\).
cp /dev/null ark13isdone
MISSING=""
for I in 1 2 3 4 5 6 7 8 9 10 11 12 13 14 ; do
    if test ! -f ark${I}isdone ; then
	MISSING="${MISSING} ${I}"
    fi
done
if test "${MISSING}" = "" ; then
    echo You have unpacked all 14 archives.
    rm -f ark[1-9]isdone ark[1-9][0-9]isdone
else
    echo You still need to unpack the following archives:
    echo "        " ${MISSING}
fi
##  End of shell archive.
exit 0



More information about the Comp.sources.misc mailing list