v08i062: Elk (Extension Language Toolkit) part 14 of 14

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


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

[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 14 (of 14)."
# Contents:  lib/util/symbol.c lib/util/Makefile lib/util/string.h
#   lib/util/objects.c lib/Makefile lib/chdir.c lib/when.c lib/debug.c
#   lib/hunk.c lib/string.c lib/struct.c lib/hack.c lib/monitor.c
#   lib/README.mon lib/c++.c lib/unix.c lib/xhp/Makefile
#   lib/xhp/arrow.d lib/xhp/bboard.d lib/xhp/toggle.d
#   lib/xhp/menusep.d lib/xhp/form.d lib/xhp/sash.d lib/xhp/cascade.d
#   lib/xhp/pbutton.d lib/xhp/list.d lib/xhp/menubutton.d
#   lib/xhp/vpw.d lib/xhp/popupmgr.d lib/xhp/valuator.d
#   lib/xhp/rowcol.d lib/xhp/scroll.d lib/xhp/stext.d
#   lib/xhp/textedit.d stk stk/Makefile stk/test1.c stk/test2.c
# Wrapped by net at tub on Sun Sep 17 17:32:44 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f lib/util/symbol.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/util/symbol.c\"
else
echo shar: Extracting \"lib/util/symbol.c\" \(1267 characters\)
sed "s/^X//" >lib/util/symbol.c <<'END_OF_lib/util/symbol.c'
X#include <scheme.h>
X#include "symbol.h"
X
Xunsigned long Symbols_To_Bits (x, mflag, stab) Object x; SYMDESCR *stab; {
X    register SYMDESCR *syms;
X    register unsigned long mask = 0;
X    Object l, s;
X    register char *p;
X    register n;
X
X    for (l = x; !Nullp (l); l = Cdr (l)) {
X	if (mflag) {
X	    Check_Type (l, T_Pair);
X	    x = Car (l);
X	}
X	Check_Type (x, T_Symbol);
X	s = SYMBOL(x)->name;
X	p = STRING(s)->data;
X	n = STRING(s)->size;
X	for (syms = stab; syms->name; syms++)
X	    if (n && strncmp (syms->name, p, n) == 0) break;
X	if (syms->name == 0)
X	    Primitive_Error ("invalid argument: ~s", x);
X	mask |= syms->val;
X	if (!mflag) break;
X    }
X    return mask;
X}
X
XObject Bits_To_Symbols (x, mflag, stab) unsigned long x; SYMDESCR *stab; {
X    register SYMDESCR *syms;
X    Object list, tail, cell;
X    GC_Node2;
X
X    if (mflag) {
X	GC_Link2 (list, tail);
X	for (list = tail = Null, syms = stab; syms->name; syms++)
X	    if ((x & syms->val) && syms->val != ~0) {
X		Object z = Intern (syms->name);
X		cell = Cons (z, Null);
X		if (Nullp (list))
X		    list = cell;
X		else
X		    P_Setcdr (tail, cell);
X		tail = cell;
X	    }
X	GC_Unlink;
X	return list;
X    }
X    for (syms = stab; syms->name; syms++)
X	if (syms->val == x)
X	    return Intern (syms->name);
X    return Null;
X}
END_OF_lib/util/symbol.c
if test 1267 -ne `wc -c <lib/util/symbol.c`; then
    echo shar: \"lib/util/symbol.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/util/Makefile\"
else
echo shar: Extracting \"lib/util/Makefile\" \(283 characters\)
sed "s/^X//" >lib/util/Makefile <<'END_OF_lib/util/Makefile'
XH=	../../src/config.h\
X	../../src/object.h\
X	../../src/extern.h\
X	../../src/macros.h
X
XC=	objects.c\
X	symbol.c
X
XO=	objects.o\
X	symbol.o
X
Xall:	$(O)
X
Xobjects.o:	$(H) objects.h
Xsymbol.o:	$(H) symbol.h
X
Xlint:
X	lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
Xclean:
X	rm -f *.o core a.out
END_OF_lib/util/Makefile
if test 283 -ne `wc -c <lib/util/Makefile`; then
    echo shar: \"lib/util/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/string.h -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/util/string.h\"
else
echo shar: Extracting \"lib/util/string.h\" \(328 characters\)
sed "s/^X//" >lib/util/string.h <<'END_OF_lib/util/string.h'
X#define Make_C_String(from,to) {\
X    register _n_;\
X    if (TYPE(from) == T_Symbol)\
X	from = SYMBOL(from)->name;\
X    else if (TYPE(from) != T_String)\
X	Wrong_Type_Combination (from, "string or symbol");\
X    _n_ = STRING(from)->size;\
X    to = alloca (_n_+1);\
X    bcopy (STRING(from)->data, to, _n_);\
X    to[_n_] = '\0';\
X}
END_OF_lib/util/string.h
if test 328 -ne `wc -c <lib/util/string.h`; then
    echo shar: \"lib/util/string.h\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/util/objects.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/util/objects.c\"
else
echo shar: Extracting \"lib/util/objects.c\" \(3536 characters\)
sed "s/^X//" >lib/util/objects.c <<'END_OF_lib/util/objects.c'
X#include <varargs.h>
X#include <scheme.h>
X#include "objects.h"
X
X#define INIT_SIZE	50
X#define SIZE_INCR	20
X
Xtypedef struct {
X    GENERIC group;
X    Object obj;
X    PFO term;
X    char flags;
X} OBJECT;
Xstatic OBJECT *Pool;
Xstatic pool_size = INIT_SIZE;
X
X#define USED    0x1   /* flags */
X#define LEADER  0x2
X#define MARK    0x4
X
Xextern char *malloc(), *realloc();
X
X/* Register an object with the given group and termination function;
X * object can be marked as LEADER.
X */
XRegister_Object (obj, group, term, leader_flag) Object obj; GENERIC group;
X	PFO term; {
X    register OBJECT *p;
X
X    for (p = Pool; p < Pool+pool_size; p++)
X	if (!(p->flags & USED)) break;
X    if (p == Pool+pool_size) {
X	pool_size += SIZE_INCR;
X	if ((Pool = (OBJECT *)realloc ((char *)Pool,
X		pool_size * sizeof (OBJECT))) == 0)
X	    Fatal_Error ("realloc: out of memory");
X	p = Pool + pool_size - SIZE_INCR;
X	Clear_Pool (p, SIZE_INCR);
X    }
X    p->obj = obj;
X    p->group = group;
X    p->term = term;
X    p->flags = leader_flag ? (USED|LEADER) : USED;
X}
X
XDeregister_Object (obj) Object obj; {
X    register OBJECT *p;
X
X    for (p = Pool; p < Pool+pool_size; p++)
X	if ((p->flags & USED) && EQ(p->obj, obj))
X	    p->flags = 0;
X}
X
X/* Search for an object of a given type and group.
X * Use the given match function; it is called with an object and
X * the remaining arguments of Find_Object() (a va_list).
X * Null is returned when the object has not been found.
X */
X/*VARARGS*/
XObject Find_Object (va_alist) va_dcl {
X    register OBJECT *p;
X    register type;
X    register GENERIC group;
X    PFO match;
X    va_list args;
X
X    va_start (args);
X    type = va_arg (args, int);
X    group = va_arg (args, GENERIC);
X    match = va_arg (args, PFO);
X    for (p = Pool; p < Pool+pool_size; p++) {
X	if (!(p->flags & USED) || TYPE(p->obj) != type || p->group != group)
X	    continue;
X	if (match (p->obj, args)) {
X	    va_end (args);
X	    return p->obj;
X	}
X    }
X    va_end (args);
X    return Null;
X}
X
X/* Terminate all objects belonging to the given group except LEADERs.
X */
XTerminate_Group (group) GENERIC group; {
X    register OBJECT *p;
X
X    for (p = Pool; p < Pool+pool_size; p++)
X	if ((p->flags & USED) && p->group == group && !(p->flags & LEADER)) {
X	    if (p->term)
X		(void)p->term (p->obj);
X	    p->flags = 0;
X	}
X}
X
X/* The after-GC function.  LEADERs are terminated in a second pass.
X */
Xstatic void Terminate_Objects () {
X    register OBJECT *p;
X    register Object *tag;
X
X    for (p = Pool; p < Pool+pool_size; p++) {
X	if (!(p->flags & USED))
X	    continue;
X	tag = (Object *)POINTER(p->obj);
X	if (TYPE(*tag) == T_Broken_Heart) {
X	    SETPOINTER(p->obj, POINTER(*tag));
X	} else if (p->flags & LEADER) {
X	    p->flags |= MARK;
X	} else {
X	    if (p->term)
X		(void)p->term (p->obj);
X	    p->flags = 0;
X	}
X    }
X    for (p = Pool; p < Pool+pool_size; p++) {
X	if (p->flags & MARK) {
X	    if (p->term)
X		(void)p->term (p->obj);
X	    p->flags = 0;
X	}
X    }
X}
X
X/* Compute a unique integer from an object.
X * -1 is returned if the object is not in the pool.
X */
XUnique_Id (obj) Object obj; {
X    register OBJECT *p;
X
X    for (p = Pool; p < Pool+pool_size; p++)
X	if ((p->flags & USED) && EQ(p->obj, obj))
X	    return Make_Fixnum (p-Pool);
X    return -1;
X}
X
Xstatic Clear_Pool (p, n) register OBJECT *p; register n; {
X    for ( ; n > 0; n--, p++)
X	p->flags = 0;
X}
X
Xinit_util_objects () {
X    if ((Pool = (OBJECT *)malloc (INIT_SIZE *
X	    (sizeof (OBJECT)))) == 0)
X	Fatal_Error ("malloc: out of memory");
X    Clear_Pool (Pool, INIT_SIZE);
X    Register_After_GC (Terminate_Objects);
X}
END_OF_lib/util/objects.c
if test 3536 -ne `wc -c <lib/util/objects.c`; then
    echo shar: \"lib/util/objects.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/Makefile\"
else
echo shar: Extracting \"lib/Makefile\" \(516 characters\)
sed "s/^X//" >lib/Makefile <<'END_OF_lib/Makefile'
XH=	../src/config.h\
X	../src/object.h\
X	../src/extern.h\
X	../src/macros.h\
X	util/string.h
X
XC=	string.c\
X	when.c\
X	chdir.c\
X	hunk.c\
X	monitor.c\
X	struct.c\
X	hack.c\
X	debug.c\
X	unix.c\
X	c++.c
X
XO=	string.o\
X	when.o\
X	chdir.o\
X	hunk.o\
X	monitor.o\
X	struct.o\
X	hack.o\
X	debug.o\
X	unix.o\
X	c++.o
X
Xall:		$(O)
X
Xstring.o:	$(H)
Xwhen.o:		$(H)
Xchdir.o:	$(H)
Xhunk.o:		$(H)
Xstruct.o:	$(H)
Xhack.o:		$(H)
Xdebug.o:	$(H)
Xunix.o:		$(H)
Xc++.o:		$(H)
X
Xlint:
X	lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
X
Xclean:
X	rm -f *.o core a.out
END_OF_lib/Makefile
if test 516 -ne `wc -c <lib/Makefile`; then
    echo shar: \"lib/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/chdir.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/chdir.c\"
else
echo shar: Extracting \"lib/chdir.c\" \(678 characters\)
sed "s/^X//" >lib/chdir.c <<'END_OF_lib/chdir.c'
X#include <scheme.h>
X
Xextern char *getenv(), *alloca();
XObject V_Home;
X
Xstatic Object P_Chdir (argc, argv) Object *argv; {
X    Object dir;
X    register n;
X    register char *s;
X
X    dir = argc == 0 ? Val (V_Home) : argv[0];
X    Check_Type (dir, T_String);
X    n = STRING(dir)->size;
X    s = alloca (n+1);
X    bcopy (STRING(dir)->data, s, n);
X    s[n] = '\0';
X    if (chdir (s) < 0) {
X	Saved_Errno = errno;
X	Primitive_Error ("~s: ~E", dir);
X    }
X    return Void;
X}
X
Xinit_lib_chdir () {
X    register char *p = getenv ("HOME");
X
X    if (p == 0)
X	p = ".";
X    Define_Variable (&V_Home, "home", Make_String (p, strlen (p)));
X    Define_Primitive (P_Chdir, "chdir", 0, 1, VARARGS);
X}
END_OF_lib/chdir.c
if test 678 -ne `wc -c <lib/chdir.c`; then
    echo shar: \"lib/chdir.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/when.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/when.c\"
else
echo shar: Extracting \"lib/when.c\" \(380 characters\)
sed "s/^X//" >lib/when.c <<'END_OF_lib/when.c'
X#include <scheme.h>
X
X/* (when condition form1 form2 ...)
X */
Xstatic Object P_When (argl) Object argl; {
X    Object cond;
X    GC_Node;
X    TC_Prolog;
X
X    GC_Link (argl);
X    TC_Disable;
X    cond = Eval (Car (argl));
X    TC_Enable;
X    GC_Unlink;
X    return Truep (cond) ? Begin (Cdr (argl)) : False;
X}
X
Xinit_lib_when () {
X    Define_Primitive (P_When, "when", 2, MANY, NOEVAL);
X}
END_OF_lib/when.c
if test 380 -ne `wc -c <lib/when.c`; then
    echo shar: \"lib/when.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/debug.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/debug.c\"
else
echo shar: Extracting \"lib/debug.c\" \(217 characters\)
sed "s/^X//" >lib/debug.c <<'END_OF_lib/debug.c'
X#include <scheme.h>
X
Xstatic Object P_Debug (on) Object on; {
X    Check_Type (on, T_Boolean);
X    GC_Debug = EQ(on, True);
X    return Void;
X}
X
Xinit_lib_debug () {
X    Define_Primitive (P_Debug, "debug", 1, 1, EVAL);
X}
END_OF_lib/debug.c
if test 217 -ne `wc -c <lib/debug.c`; then
    echo shar: \"lib/debug.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/hunk.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/hunk.c\"
else
echo shar: Extracting \"lib/hunk.c\" \(2073 characters\)
sed "s/^X//" >lib/hunk.c <<'END_OF_lib/hunk.c'
X#include <scheme.h>
X
X#define T_Hunk3  (T_Last+1)
X
X#define HUNK3(x)  ((struct S_Hunk3 *)POINTER(x))
X
Xstruct S_Hunk3 {
X    Object first, second, third;
X};
X
Xstatic Object P_Hunk3_Cons (a, b, c) Object a, b, c; {
X    register char *p;
X    Object h;
X    GC_Node3;
X
X    GC_Link3 (a, b, c);
X    p = Get_Bytes (sizeof (struct S_Hunk3));
X    SET(h, T_Hunk3, (struct S_Hunk3 *)p);
X    HUNK3(h)->first = a; HUNK3(h)->second = b; HUNK3(h)->third = c;
X    GC_Unlink;
X    return h;
X}
X
Xstatic Object P_Hunk3p (x) Object x; {
X    return TYPE(x) == T_Hunk3 ? True : False;
X}
X
Xstatic Object P_Hunk3_Cxr (h, n) Object h, n; {
X    Check_Type (h, T_Hunk3);
X    switch (Get_Integer (n)) {
X    case 0: return HUNK3(h)->first;
X    case 1: return HUNK3(h)->second;
X    case 2: return HUNK3(h)->third;
X    default: Range_Error (n);
X    }
X}
X
Xstatic Object P_Hunk3_Set_Cxr (h, n, val) Object h, n, val; {
X    Check_Type (h, T_Hunk3);
X    switch (Get_Integer (n)) {
X    case 0: HUNK3(h)->first  = val; break;
X    case 1: HUNK3(h)->second = val; break;
X    case 2: HUNK3(h)->third  = val; break;
X    default: Range_Error (n);
X    }
X    return h;
X}
X
Xstatic Hunk3_Eqv (a, b) Object a, b; { return EQ(a,b); }
X
Xstatic Hunk3_Equal (a, b) Object a, b; {
X    return Equal (HUNK3(a)->first,  HUNK3(b)->first)  &&
X           Equal (HUNK3(a)->second, HUNK3(b)->second) &&
X           Equal (HUNK3(a)->third,  HUNK3(b)->third);
X}
X
Xstatic Hunk3_Print (h, port, raw, depth, length) Object h, port; {
X    Printf (port, "#[hunk3 %u]", POINTER(h));
X}
X
Xstatic Hunk3_Visit (hp, f) Object *hp; int (*f)(); {
X    (*f)(&HUNK3(*hp)->first);
X    (*f)(&HUNK3(*hp)->second);
X    (*f)(&HUNK3(*hp)->third);
X}
X
Xinit_lib_hunk () {
X    Define_Type (T_Hunk3, "hunk3", NOFUNC, sizeof (struct S_Hunk3),
X	Hunk3_Eqv, Hunk3_Equal, Hunk3_Print, Hunk3_Visit);
X    Define_Primitive (P_Hunk3_Cons,    "hunk3-cons",     3, 3, EVAL);
X    Define_Primitive (P_Hunk3p,        "hunk3?",         1, 1, EVAL);
X    Define_Primitive (P_Hunk3_Cxr,     "hunk3-cxr",      2, 2, EVAL);
X    Define_Primitive (P_Hunk3_Set_Cxr, "hunk3-set-cxr!", 3, 3, EVAL);
X}
END_OF_lib/hunk.c
if test 2073 -ne `wc -c <lib/hunk.c`; then
    echo shar: \"lib/hunk.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/string.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/string.c\"
else
echo shar: Extracting \"lib/string.c\" \(345 characters\)
sed "s/^X//" >lib/string.c <<'END_OF_lib/string.c'
X#include <scheme.h>
X
Xstatic Object P_String_Reverse (str) Object str; {
X    register char c, *s, *t;
X
X    Check_Type (str, T_String);
X    for (s = STRING(str)->data, t = s+STRING(str)->size; --t > s; s++)
X	c = *s, *s = *t, *t = c;
X    return str;
X}
X
Xinit_lib_string () {
X    Define_Primitive (P_String_Reverse, "string-reverse!", 1, 1, EVAL);
X}
END_OF_lib/string.c
if test 345 -ne `wc -c <lib/string.c`; then
    echo shar: \"lib/string.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/struct.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/struct.c\"
else
echo shar: Extracting \"lib/struct.c\" \(3257 characters\)
sed "s/^X//" >lib/struct.c <<'END_OF_lib/struct.c'
X#include <scheme.h>
X
X#define STRUCT(x)  ((struct S_Struct *)POINTER(x))
X
Xstruct S_Struct {
X    Object name;
X    Object slots;
X    Object values;
X};
X
Xint T_Struct;
X
Xstatic Object P_Structurep (x) Object x; {
X    return TYPE(x) == T_Struct ? True : False;
X}
X
Xstatic Object P_Structure_Name (x) Object x; {
X    Check_Type (x, T_Struct);
X    return STRUCT(x)->name;
X}
X
Xstatic Object P_Structure_Slots (x) Object x; {
X    Check_Type (x, T_Struct);
X    return P_Vector_To_List (STRUCT(x)->slots);
X}
X
Xstatic Object P_Structure_Values (x) Object x; {
X    Check_Type (x, T_Struct);
X    return P_Vector_To_List (STRUCT(x)->values);
X}
X
Xstatic Check_Structure_Type (x, t) Object x, t; {
X    Check_Type (x, T_Struct);
X    Check_Type (t, T_Symbol);
X    if (!EQ(STRUCT(x)->name, t))
X	Primitive_Error ("wrong structure type ~s (expected ~s)",
X	    STRUCT(x)->name, t);
X}
X
Xstatic Object P_Structure_Ref (x, t, n) Object x, t, n; {
X    Check_Structure_Type (x, t);
X    return P_Vector_Ref (STRUCT(x)->values, n);
X}
X
Xstatic Object P_Structure_Set (x, t, n, obj) Object x, t, n, obj; {
X    Check_Structure_Type (x, t);
X    return P_Vector_Set (STRUCT(x)->values, n, obj);
X}
X
Xstatic Object P_Make_Structure (name, slots) Object name, slots; {
X    register char *p;
X    register n;
X    Object s, vec, *vp;
X    GC_Node3;
X
X    Check_Type (name, T_Symbol);
X    Check_List (slots);
X    s = Null;
X    GC_Link3 (s, name, slots);
X    p = Get_Bytes (sizeof (struct S_Struct));
X    SET(s, T_Struct, (struct S_Struct *)p);
X    STRUCT(s)->name = name;
X    n = Internal_Length (slots);
X    vec = Make_Vector (n, Null);
X    STRUCT(s)->values = vec;
X    vec = Make_Vector (n, Null);
X    STRUCT(s)->slots = vec;
X    GC_Unlink;
X    for (vp = VECTOR(vec)->data; n--; slots = Cdr (slots)) {
X	Check_Type (Car (slots), T_Symbol);
X	*vp++ = Car (slots);
X    }
X    return s;
X}
X
Xstatic Structure_Eqv (a, b) Object a, b; { return EQ(a,b); }
X
Xstatic Structure_Equal (a, b) Object a, b; {
X    return EQ(STRUCT(a)->name,STRUCT(b)->name) &&
X	   Equal (STRUCT(a)->slots, STRUCT(b)->slots) &&
X	   Equal (STRUCT(a)->values, STRUCT(b)->values);
X}
X
Xstatic Structure_Print (x, port, raw, depth, length) Object x, port; {
X    GC_Node2;
X
X    GC_Link2 (port, x);
X    Printf (port, "#[");
X    Print_Object (STRUCT(x)->name, port, raw, depth, length);
X    Printf (port, "-structure %u]", POINTER(x));
X    GC_Unlink;
X}
X
Xstatic Structure_Visit (sp, f) register Object *sp; register (*f)(); {
X    (*f)(&STRUCT(*sp)->name);
X    (*f)(&STRUCT(*sp)->slots);
X    (*f)(&STRUCT(*sp)->values);
X}
X
Xinit_lib_struct () {
X    T_Struct = Define_Type (0, "structure", NOFUNC, sizeof (struct S_Struct),
X	Structure_Eqv, Structure_Equal, Structure_Print, Structure_Visit);
X    Define_Primitive (P_Structurep,       "structure?",       1, 1, EVAL);
X    Define_Primitive (P_Structure_Name,   "structure-name",   1, 1, EVAL);
X    Define_Primitive (P_Structure_Slots,  "structure-slots",  1, 1, EVAL);
X    Define_Primitive (P_Structure_Values, "structure-values", 1, 1, EVAL);
X    Define_Primitive (P_Structure_Ref,    "structure-ref",    3, 3, EVAL);
X    Define_Primitive (P_Structure_Set,    "structure-set!",   4, 4, EVAL);
X    Define_Primitive (P_Make_Structure,   "make-structure",   2, 2, EVAL);
X    P_Provide (Intern ("structures"));
X}
END_OF_lib/struct.c
if test 3257 -ne `wc -c <lib/struct.c`; then
    echo shar: \"lib/struct.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/hack.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/hack.c\"
else
echo shar: Extracting \"lib/hack.c\" \(347 characters\)
sed "s/^X//" >lib/hack.c <<'END_OF_lib/hack.c'
X#include <scheme.h>
X
Xstatic Object P_Hack_Procedure_Environment (p, e) Object p, e; {
X    Check_Type (p, T_Compound);
X    Check_Type (e, T_Environment);
X    COMPOUND(p)->env = e;
X    return p;
X}
X
Xinit_lib_hack () {
X    Define_Primitive (P_Hack_Procedure_Environment,
X	"hack-procedure-environment!", 2, 2, EVAL);
X    P_Provide (Intern ("hack"));
X}
END_OF_lib/hack.c
if test 347 -ne `wc -c <lib/hack.c`; then
    echo shar: \"lib/hack.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/monitor.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/monitor.c\"
else
echo shar: Extracting \"lib/monitor.c\" \(433 characters\)
sed "s/^X//" >lib/monitor.c <<'END_OF_lib/monitor.c'
X#include <scheme.h>
X
X#define MONSTART 2
X
Xstatic monitoring;
X
Xstatic Object P_Monitor (on) Object on; {
X    char *brk;
X
X    Check_Type (on, T_Boolean);
X    if (Truep (on)) {
X	if (!monitoring) {
X	    brk = sbrk (0);
X	    monstartup (MONSTART, (int (*)())brk);
X	    monitoring = 1;
X	}
X    } else {
X	monitor (0);
X	monitoring = 0;
X    }
X    return Void;
X}
X
Xinit_lib_monitor () {
X    Define_Primitive (P_Monitor, "monitor", 1, 1, EVAL);
X}
END_OF_lib/monitor.c
if test 433 -ne `wc -c <lib/monitor.c`; then
    echo shar: \"lib/monitor.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/README.mon -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/README.mon\"
else
echo shar: Extracting \"lib/README.mon\" \(322 characters\)
sed "s/^X//" >lib/README.mon <<'END_OF_lib/README.mon'
XBSD:
X     1) ar x /lib/libc.a mon.o
X     2) In the symboltable of mon.o replace mcount by Mcount
X	and _moncontrol by _Moncontrol (using emacs).
X
XSun:
X     1) cp /lib/mcrt0.o mon.o
X     2) In the symboltable of mon.o replace start by Start
X	and _environ by _Environ.
X
X3) ld -r mon.o monitor.o; mv a.out monitor.o; rm mon.o
END_OF_lib/README.mon
if test 322 -ne `wc -c <lib/README.mon`; then
    echo shar: \"lib/README.mon\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/c++.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/c++.c\"
else
echo shar: Extracting \"lib/c++.c\" \(483 characters\)
sed "s/^X//" >lib/c++.c <<'END_OF_lib/c++.c'
X#include <scheme.h>
X
Xstatic Object New_Handler;
X
Xstatic void New_Handler_Proc () {
X    (void)Funcall (New_Handler, Null, 0);
X}
X
Xstatic Object P_Set_New_Handler (p) Object p; {
X    Object old;
X
X    Check_Procedure (p);
X    old = New_Handler;
X    New_Handler = p;
X    return old;
X}
X
Xinit_lib_cplusplus () {
X    New_Handler = Null;
X    Global_GC_Link (New_Handler);
X    set_new_handler (New_Handler_Proc);
X    Define_Primitive (P_Set_New_Handler, "set-c++-new-handler!", 1, 1, EVAL);
X}
END_OF_lib/c++.c
if test 483 -ne `wc -c <lib/c++.c`; then
    echo shar: \"lib/c++.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/unix.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/unix.c\"
else
echo shar: Extracting \"lib/unix.c\" \(2889 characters\)
sed "s/^X//" >lib/unix.c <<'END_OF_lib/unix.c'
X#include <sys/types.h>
X#include <sys/stat.h>
X#include <errno.h>
X#include <signal.h>
X
X#include <scheme.h>
X#include "util/string.h"
X
X#ifdef DIRENT
X#  include <dirent.h>
X#else
X#  include <sys/dir.h>
X#endif
X
Xextern char *getenv();
X
Xstatic Object P_Read_Directory (name) Object name; {
X    register char *s;
X    register DIR *d;
X#ifdef DIRENT
X    register struct dirent *dp;
X#else
X    register struct direct *dp;
X#endif
X    Object ret;
X    GC_Node;
X
X    ret = Null;
X    GC_Link (ret);
X    Make_C_String (name, s);
X    Disable_Interrupts;
X    if ((d = opendir (s)) == NULL)
X	Primitive_Error ("cannot open directory ~s", name);
X    while ((dp = readdir (d)) != NULL) {
X	Object x = Make_String (dp->d_name, strlen (dp->d_name));
X	ret = Cons (x, ret);
X    }
X    closedir (d);
X    Enable_Interrupts;
X    GC_Unlink;
X    return ret;
X}
X
Xstatic Object P_File_Status (name) Object name; {
X    register char *s;
X    struct stat st;
X
X    Make_C_String (name, s);
X    if (stat (s, &st) == -1) {
X	switch (errno) {
X	case ENOTDIR:
X	case EINVAL:
X	case ENOENT:
X	case EACCES:
X#ifdef ENAMETOOLONG
X	case ENAMETOOLONG:
X#endif
X#ifdef ELOOP
X	case ELOOP:
X#endif
X	    s = "non-existent"; break;
X	default:
X	    Saved_Errno = errno;
X	    Primitive_Error ("cannot stat ~s: ~E", name);
X	}
X    } else {
X	switch (st.st_mode & S_IFMT) {
X	case S_IFDIR: s = "directory"; break;
X	case S_IFCHR: s = "character-special"; break;
X	case S_IFBLK: s = "block-special"; break;
X	case S_IFREG: s = "regular"; break;
X#ifdef S_IFSOCK
X	case S_IFSOCK: s = "socket"; break;
X#endif
X#ifdef S_IFFIFO
X	case S_IFFIFO: s = "fifo"; break;
X#endif
X	default: s = "unknown"; break;
X	}
X    }
X    return Intern (s);
X}
X
Xstatic Object P_System (cmd) Object cmd; {
X    register char *s;
X    register i, n, pid;
X    int status;
X
X    Make_C_String (cmd, s);
X#ifdef VFORK
X    switch (pid = vfork ()) {
X#else
X    switch (pid = fork ()) {
X#endif
X    case -1:
X	Saved_Errno = errno;
X	Primitive_Error ("cannot fork: ~E");
X    case 0:
X#ifdef MAX_OFILES
X	n = MAX_OFILES;
X#else
X	n = getdtablesize ();
X#endif
X	for (i = 3; i < n; i++)
X	    (void)close (i);
X	execl ("/bin/sh", "sh", "-c", s, (char *)0);
X	_exit (127);
X    default:
X	Disable_Interrupts;
X	while ((i = wait (&status)) != pid && i != -1)
X		;
X	Enable_Interrupts;
X    }
X    if (i == -1)
X	return False;
X    if (n = (status & 0377))
X	return Cons (Make_Fixnum (n), Null);
X    return Make_Fixnum ((status >> 8) & 0377);
X}
X
Xstatic Object P_Getenv (e) Object e; {
X    register char *s;
X
X    Make_C_String (e, s);
X    return (s = getenv (s)) ? Make_String (s, strlen (s)) : False;
X}
X
Xinit_lib_unix () {
X    Define_Primitive (P_Read_Directory, "read-directory", 1, 1, EVAL);
X    Define_Primitive (P_File_Status,    "file-status",    1, 1, EVAL);
X    Define_Primitive (P_System,         "system",         1, 1, EVAL);
X    Define_Primitive (P_Getenv,         "getenv",         1, 1, EVAL);
X    P_Provide (Intern ("unix"));
X}
END_OF_lib/unix.c
if test 2889 -ne `wc -c <lib/unix.c`; then
    echo shar: \"lib/unix.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/Makefile\"
else
echo shar: Extracting \"lib/xhp/Makefile\" \(509 characters\)
sed "s/^X//" >lib/xhp/Makefile <<'END_OF_lib/xhp/Makefile'
XWIDGET_SET= xhp
X
XO= arrow.o\
X   bboard.o\
X   cascade.o\
X   form.o\
X   list.o\
X   menubutton.o\
X   menusep.o\
X   pbutton.o\
X   popupmgr.o\
X   rowcol.o\
X   sash.o\
X   scroll.o\
X   stext.o\
X   textedit.o\
X   toggle.o\
X   valuator.o\
X   vpw.o
X
X.SUFFIXES: .d .c .o
X
X.d.c:
X	../../src/scheme -l ../xt/make-widget $< $@ $(WIDGET_SET)
X
X.d.o:
X	../../src/scheme -l ../xt/make-widget $< $*.c $(WIDGET_SET)
X	$(CC) $(CFLAGS) -c $*.c
X
Xall: $(O)
X
Xlint:
X	lint $(LINTFLAGS) -abxh *.c | egrep -v '\?\?\?'
X
Xclean:
X	rm -f *.o *.c
END_OF_lib/xhp/Makefile
if test 509 -ne `wc -c <lib/xhp/Makefile`; then
    echo shar: \"lib/xhp/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/arrow.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/arrow.d\"
else
echo shar: Extracting \"lib/xhp/arrow.d\" \(180 characters\)
sed "s/^X//" >lib/xhp/arrow.d <<'END_OF_lib/xhp/arrow.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'arrow "Arrow.h")
X
X(define-widget-class 'arrow 'XwarrowWidgetClass)
X
X(define-callback 'arrow 'select #f)
X(define-callback 'arrow 'release #f)
END_OF_lib/xhp/arrow.d
if test 180 -ne `wc -c <lib/xhp/arrow.d`; then
    echo shar: \"lib/xhp/arrow.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/bboard.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/bboard.d\"
else
echo shar: Extracting \"lib/xhp/bboard.d\" \(117 characters\)
sed "s/^X//" >lib/xhp/bboard.d <<'END_OF_lib/xhp/bboard.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'bboard "BBoard.h")
X
X(define-widget-class 'bboard 'XwbulletinBoardWidgetClass)
END_OF_lib/xhp/bboard.d
if test 117 -ne `wc -c <lib/xhp/bboard.d`; then
    echo shar: \"lib/xhp/bboard.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/toggle.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/toggle.d\"
else
echo shar: Extracting \"lib/xhp/toggle.d\" \(186 characters\)
sed "s/^X//" >lib/xhp/toggle.d <<'END_OF_lib/xhp/toggle.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'toggle "Toggle.h")
X
X(define-widget-class 'toggle 'XwtoggleWidgetClass)
X
X(define-callback 'toggle 'select #f)
X(define-callback 'toggle 'release #f)
END_OF_lib/xhp/toggle.d
if test 186 -ne `wc -c <lib/xhp/toggle.d`; then
    echo shar: \"lib/xhp/toggle.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/menusep.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/menusep.d\"
else
echo shar: Extracting \"lib/xhp/menusep.d\" \(121 characters\)
sed "s/^X//" >lib/xhp/menusep.d <<'END_OF_lib/xhp/menusep.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'menusep "MenuSep.h")
X
X(define-widget-class 'menu-separator 'XwmenuSepWidgetClass)
END_OF_lib/xhp/menusep.d
if test 121 -ne `wc -c <lib/xhp/menusep.d`; then
    echo shar: \"lib/xhp/menusep.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/form.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/form.d\"
else
echo shar: Extracting \"lib/xhp/form.d\" \(102 characters\)
sed "s/^X//" >lib/xhp/form.d <<'END_OF_lib/xhp/form.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'form "Form.h")
X
X(define-widget-class 'form 'XwformWidgetClass)
END_OF_lib/xhp/form.d
if test 102 -ne `wc -c <lib/xhp/form.d`; then
    echo shar: \"lib/xhp/form.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/sash.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/sash.d\"
else
echo shar: Extracting \"lib/xhp/sash.d\" \(102 characters\)
sed "s/^X//" >lib/xhp/sash.d <<'END_OF_lib/xhp/sash.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'sash "Sash.h")
X
X(define-widget-class 'sash 'XwsashWidgetClass)
END_OF_lib/xhp/sash.d
if test 102 -ne `wc -c <lib/xhp/sash.d`; then
    echo shar: \"lib/xhp/sash.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/cascade.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/cascade.d\"
else
echo shar: Extracting \"lib/xhp/cascade.d\" \(114 characters\)
sed "s/^X//" >lib/xhp/cascade.d <<'END_OF_lib/xhp/cascade.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'cascade "Cascade.h")
X
X(define-widget-class 'cascade 'XwcascadeWidgetClass)
END_OF_lib/xhp/cascade.d
if test 114 -ne `wc -c <lib/xhp/cascade.d`; then
    echo shar: \"lib/xhp/cascade.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/pbutton.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/pbutton.d\"
else
echo shar: Extracting \"lib/xhp/pbutton.d\" \(207 characters\)
sed "s/^X//" >lib/xhp/pbutton.d <<'END_OF_lib/xhp/pbutton.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'pbutton "PButton.h")
X
X(define-widget-class 'push-button 'XwpushButtonWidgetClass)
X
X(define-callback 'push-button 'select #f)
X(define-callback 'push-button 'release #f)
END_OF_lib/xhp/pbutton.d
if test 207 -ne `wc -c <lib/xhp/pbutton.d`; then
    echo shar: \"lib/xhp/pbutton.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/list.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/list.d\"
else
echo shar: Extracting \"lib/xhp/list.d\" \(102 characters\)
sed "s/^X//" >lib/xhp/list.d <<'END_OF_lib/xhp/list.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'list "List.h")
X
X(define-widget-class 'list 'XwlistWidgetClass)
END_OF_lib/xhp/list.d
if test 102 -ne `wc -c <lib/xhp/list.d`; then
    echo shar: \"lib/xhp/list.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/menubutton.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/menubutton.d\"
else
echo shar: Extracting \"lib/xhp/menubutton.d\" \(167 characters\)
sed "s/^X//" >lib/xhp/menubutton.d <<'END_OF_lib/xhp/menubutton.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'menubutton "MenuBtn.h")
X
X(define-widget-class 'menu-button 'XwmenubuttonWidgetClass)
X
X(define-callback 'menu-button 'select #f)
END_OF_lib/xhp/menubutton.d
if test 167 -ne `wc -c <lib/xhp/menubutton.d`; then
    echo shar: \"lib/xhp/menubutton.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/vpw.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/vpw.d\"
else
echo shar: Extracting \"lib/xhp/vpw.d\" \(101 characters\)
sed "s/^X//" >lib/xhp/vpw.d <<'END_OF_lib/xhp/vpw.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'vpw "VPW.h")
X
X(define-widget-class 'vpw 'XwvPanedWidgetClass)
END_OF_lib/xhp/vpw.d
if test 101 -ne `wc -c <lib/xhp/vpw.d`; then
    echo shar: \"lib/xhp/vpw.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/popupmgr.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/popupmgr.d\"
else
echo shar: Extracting \"lib/xhp/popupmgr.d\" \(123 characters\)
sed "s/^X//" >lib/xhp/popupmgr.d <<'END_OF_lib/xhp/popupmgr.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'popupmgr "PopupMgr.h")
X
X(define-widget-class 'popup-manager 'XwpopupMgrWidgetClass)
END_OF_lib/xhp/popupmgr.d
if test 123 -ne `wc -c <lib/xhp/popupmgr.d`; then
    echo shar: \"lib/xhp/popupmgr.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/valuator.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/valuator.d\"
else
echo shar: Extracting \"lib/xhp/valuator.d\" \(470 characters\)
sed "s/^X//" >lib/xhp/valuator.d <<'END_OF_lib/xhp/valuator.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'valuator "Valuator.h")
X
X(define-widget-class 'valuator 'XwvaluatorWidgetClass)
X
X(define-callback 'valuator 'sliderMoved #t)
X(define-callback 'valuator 'sliderReleased #t)
X(define-callback 'valuator 'areaSelected #t)
X
X(c->scheme 'valuator-sliderMoved
X"    return Make_Integer ((int)x);")
X(c->scheme 'valuator-sliderReleased
X"    return Make_Integer ((int)x);")
X(c->scheme 'valuator-areaSelected
X"    return Make_Integer ((int)x);")
END_OF_lib/xhp/valuator.d
if test 470 -ne `wc -c <lib/xhp/valuator.d`; then
    echo shar: \"lib/xhp/valuator.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/rowcol.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/rowcol.d\"
else
echo shar: Extracting \"lib/xhp/rowcol.d\" \(114 characters\)
sed "s/^X//" >lib/xhp/rowcol.d <<'END_OF_lib/xhp/rowcol.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'rowcol "RCManager.h")
X
X(define-widget-class 'row-col 'XwrowColWidgetClass)
END_OF_lib/xhp/rowcol.d
if test 114 -ne `wc -c <lib/xhp/rowcol.d`; then
    echo shar: \"lib/xhp/rowcol.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/scroll.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/scroll.d\"
else
echo shar: Extracting \"lib/xhp/scroll.d\" \(480 characters\)
sed "s/^X//" >lib/xhp/scroll.d <<'END_OF_lib/xhp/scroll.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'scrollbar "ScrollBar.h")
X
X(define-widget-class 'scrollbar 'XwscrollbarWidgetClass)
X
X(define-callback 'scrollbar 'sliderMoved #t)
X(define-callback 'scrollbar 'sliderReleased #t)
X(define-callback 'scrollbar 'areaSelected #t)
X
X(c->scheme 'scrollbar-sliderMoved
X"    return Make_Integer ((int)x);")
X(c->scheme 'scrollbar-sliderReleased
X"    return Make_Integer ((int)x);")
X(c->scheme 'scrollbar-areaSelected
X"    return Make_Integer ((int)x);")
END_OF_lib/xhp/scroll.d
if test 480 -ne `wc -c <lib/xhp/scroll.d`; then
    echo shar: \"lib/xhp/scroll.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/stext.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/stext.d\"
else
echo shar: Extracting \"lib/xhp/stext.d\" \(203 characters\)
sed "s/^X//" >lib/xhp/stext.d <<'END_OF_lib/xhp/stext.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'stext "SText.h")
X
X(define-widget-class 'static-text 'XwstatictextWidgetClass)
X
X(define-callback 'static-text 'select #f)
X(define-callback 'static-text 'release #f)
END_OF_lib/xhp/stext.d
if test 203 -ne `wc -c <lib/xhp/stext.d`; then
    echo shar: \"lib/xhp/stext.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xhp/textedit.d -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"lib/xhp/textedit.d\"
else
echo shar: Extracting \"lib/xhp/textedit.d\" \(1236 characters\)
sed "s/^X//" >lib/xhp/textedit.d <<'END_OF_lib/xhp/textedit.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'textedit "TextEdit.h"
X
X"static SYMDESCR Sourcetype_Syms[] = {
X    { \"string\",        XwstringSrc },
X    { \"disk\",          XwdiskSrc },
X    { \"prog-defined\",  XwprogDefinedSrc },
X    { 0, 0 }
X};
Xstatic SYMDESCR Edittype_Syms[] = {
X    { \"text-read\",     XwtextRead },
X    { \"text-append\",   XwtextAppend },
X    { \"text-edit\",     XwtextEdit },
X    { 0, 0 }
X};")
X
X(scheme->c 'text-edit-editType
X"   return (XtArgVal)Symbols_To_Bits (x, 0, Edittype_Syms);")
X
X(scheme->c 'text-edit-sourceType
X"   return (XtArgVal)Symbols_To_Bits (x, 0, Sourcetype_Syms);")
X
X(define-widget-class 'text-edit 'XwtexteditWidgetClass
X  '(string String String)
X  '(maximumSize Length Int)
X  '(file String String)
X  '(editType EditType EditMode)
X  '(font Font FontStruct)
X  '(foreground Foreground Pixel))
X
X(define-primitive 'text-copy-buffer '(w)
X"   char *b;
X    Object ret;
X    Check_Widget_Class (w, XwtexteditWidgetClass);
X    b = (char *)XwTextCopyBuffer (WIDGET(w)->widget);
X    ret = Make_String (b, strlen (b));
X    XtFree (b);
X    return ret;")
X
X(define-primitive 'text-clear-buffer '(w)
X"   Check_Widget_Class (w, XwtexteditWidgetClass);
X    XwTextClearBuffer (WIDGET(w)->widget);
X    return Void;")
END_OF_lib/xhp/textedit.d
if test 1236 -ne `wc -c <lib/xhp/textedit.d`; then
    echo shar: \"lib/xhp/textedit.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d stk ; then
    echo shar: Creating directory \"stk\"
    mkdir stk
fi
if test -f stk/Makefile -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"stk/Makefile\"
else
echo shar: Extracting \"stk/Makefile\" \(364 characters\)
sed "s/^X//" >stk/Makefile <<'END_OF_stk/Makefile'
XMACHTYPE= 68k
X
Xall: test1 test2
X
Xtest1: test1.o ../src/stack.o
X	$(CC) $(CFLAGS) -o test1 test1.c ../src/stack.o
X
Xtest2: test2.o ../src/stack.o
X	$(CC) $(CFLAGS) -o test2 test2.c ../src/stack.o
X
X../src/stack.o: ../src/stack.s
X	cp ../src/stack.s.$(MACHTYPE) ../src/stack.s
X	/lib/cpp <../src/stack.s | sed '/^#/d' >stack.ss
X	as -o ../src/stack.o stack.ss
X	rm stack.ss
END_OF_stk/Makefile
if test 364 -ne `wc -c <stk/Makefile`; then
    echo shar: \"stk/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f stk/test1.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"stk/test1.c\"
else
echo shar: Extracting \"stk/test1.c\" \(658 characters\)
sed "s/^X//" >stk/test1.c <<'END_OF_stk/test1.c'
X/* This program tests whether stksize() is producing reasonable
X * results.
X */
X
Xint Special;
Xchar *stkbase;
X
Xmain () {
X    char foo;
X
X    stkbase = &foo;
X    f ();
X    printf ("stksize() seems to work fine.\n");
X    exit (0);
X}
X
Xf () {
X    int s, t;
X    char buf[100];
X
X    s = stksize ();
X    if (s < 100 || s > 100000) {
X	printf ("There seems to be a problem [1] with stksize().\n");
X	exit (1);
X    }
X    (void)alloca (100);
X    t = stksize ();
X    if (t < s) {
X	printf ("There seems to be a problem [2] with stksize().\n");
X	exit (1);
X    }
X    if (t > s + 104) {
X	printf ("There seems to be a problem with stksize() or alloca().\n");
X	exit (1);
X    }
X}
END_OF_stk/test1.c
if test 658 -ne `wc -c <stk/test1.c`; then
    echo shar: \"stk/test1.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f stk/test2.c -a "${1}" != "-c" ; then 
  echo shar: Will not over-write existing file \"stk/test2.c\"
else
echo shar: Extracting \"stk/test2.c\" \(857 characters\)
sed "s/^X//" >stk/test2.c <<'END_OF_stk/test2.c'
X/* If saveenv() and jmpenv() are working correctly, this program
X * prints the numbers 0 to 9.
X */
X
Xchar *malloc();
Xchar *env, *env2;
Xchar *stkbase;
Xint Special;
X
Xint i, r = 1;
X
Xmain () {
X    char foo;
X
X    stkbase = &foo;
X    i = inner ();
X    if (i == 7)
X	jmpenv (env2, 9);
X    jmpenv (env, r++);
X    printf ("There seems to be a problem [1] with saveenv or jmpenv.\n");
X    exit (1);
X}
X
Xinner () {
X    int r, len;
X
X    inner2 ();
X    len = stksize ();
X    env = malloc (len);
X    r = saveenv (env);
X    printf ("%d\n", r+1);
X    return r;
X}
X
Xinner2 () {
X    int r, len = stksize ();
X    int a[10000];
X    a[0] = 1; a[9999] = 2;
X
X    env2 = malloc (len);
X    r = saveenv (env2);
X    printf ("%d\n", r);
X    if (a[0] != 1 || a[9999] != 2) {
X	printf ("There seems to be a problem [2] with saveenv or jmpenv.\n");
X	exit (1);
X    }
X    if (r > 0)
X	exit ();
X}
END_OF_stk/test2.c
if test 857 -ne `wc -c <stk/test2.c`; then
    echo shar: \"stk/test2.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 14 \(of 14\).
cp /dev/null ark14isdone
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