v08i060: Elk (Extension Language Toolkit) part 12 of 14
Brandon S. Allbery - comp.sources.misc
allbery at uunet.UU.NET
Sun Sep 24 07:43:46 AEST 1989
Posting-number: Volume 8, Issue 60
Submitted-by: net at tub.UUCP (Oliver Laumann)
Archive-name: elk/part12
[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 12 (of 14)."
# Contents: lib/xlib/property.c lib/xlib/pointer.c lib/xlib/wm.c
# lib/xaw/Makefile lib/xaw/grip.d lib/xaw/list.d lib/xaw/scroll.d
# lib/xaw/box.d lib/xaw/shell.d lib/xaw/clock.d lib/xaw/dialog.d
# lib/xaw/vpaned.d lib/xaw/ascii.d lib/xaw/viewport.d lib/xt
# lib/xt/examples lib/xt/examples/dialog lib/xt/examples/scrollbar
# lib/xt/examples/scrollbox lib/xt/examples/list
# lib/xt/examples/grip lib/xt/examples/viewport lib/xt/examples/text
# lib/xt/examples/hp-misc lib/xt/examples/hp-arrow
# lib/xt/examples/hp-list lib/xt/examples/hp-menu lib/xt/Makefile
# lib/xt/objects.c lib/xt/error.c
# Wrapped by net at tub on Sun Sep 17 17:32:38 1989
PATH=/bin:/usr/bin:/usr/ucb ; export PATH
if test -f lib/xlib/property.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/property.c\"
else
echo shar: Extracting \"lib/xlib/property.c\" \(7184 characters\)
sed "s/^X//" >lib/xlib/property.c <<'END_OF_lib/xlib/property.c'
X#include "xlib.h"
X
XObject Sym_Now;
X
XGeneric_Predicate (Atom);
X
XGeneric_Simple_Equal (Atom, ATOM, atom);
X
XGeneric_Print (Atom, "#[atom %u]", ATOM(x)->atom);
X
XObject Make_Atom (a) Atom a; {
X register char *p;
X Object atom;
X
X if (a == None)
X return Sym_None;
X atom = Find_Object (T_Atom, (GENERIC)0, Match_X_Obj, a);
X if (Nullp (atom)) {
X p = Get_Bytes (sizeof (struct S_Atom));
X SET (atom, T_Atom, (struct S_Atom *)p);
X ATOM(atom)->tag = Null;
X ATOM(atom)->atom = a;
X Register_Object (atom, (GENERIC)0, (PFO)0, 0);
X }
X return atom;
X}
X
Xstatic Object P_Make_Atom (n) Object n; { /* For debugging */
X return Make_Atom ((Atom)Get_Integer (n));
X}
X
Xstatic Object Internal_Intern_Atom (d, name, flag) Object d, name; {
X register char *s;
X
X Check_Type (d, T_Display);
X Make_C_String (name, s);
X return Make_Atom (XInternAtom (DISPLAY(d)->dpy, s, flag));
X}
X
Xstatic Object P_Intern_Atom (d, name) Object d, name; {
X return Internal_Intern_Atom (d, name, 0);
X}
X
Xstatic Object P_Find_Atom (d, name) Object d, name; {
X return Internal_Intern_Atom (d, name, 1);
X}
X
Xstatic Object P_Atom_Name (d, a) Object d, a; {
X register char *s;
X
X Check_Type (d, T_Display);
X Check_Type (a, T_Atom);
X Disable_Interrupts;
X s = XGetAtomName (DISPLAY(d)->dpy, ATOM(a)->atom);
X Enable_Interrupts;
X return Make_String (s, strlen (s));
X}
X
Xstatic Object P_List_Properties (w) Object w; {
X register i;
X int n;
X register Atom *ap;
X Object v;
X GC_Node;
X
X Check_Type (w, T_Window);
X Disable_Interrupts;
X ap = XListProperties (WINDOW(w)->dpy, WINDOW(w)->win, &n);
X Enable_Interrupts;
X v = Make_Vector (n, Null);
X GC_Link (v);
X for (i = 0; i < n; i++) {
X Object x = Make_Atom (ap[i]);
X VECTOR(v)->data[i] = x;
X }
X GC_Unlink;
X XFree ((char *)ap);
X return v;
X}
X
Xstatic Object P_Get_Property (w, prop, type, start, len, deletep)
X Object w, prop, type, start, len, deletep; {
X Atom req_type = AnyPropertyType, actual_type;
X int format;
X unsigned long nitems, bytes_left;
X unsigned char *data;
X Object ret, t, x;
X register i;
X GC_Node2;
X
X Check_Type (w, T_Window);
X Check_Type (prop, T_Atom);
X if (!EQ(type, False)) {
X Check_Type (type, T_Atom);
X req_type = ATOM(type)->atom;
X }
X Check_Type (deletep, T_Boolean);
X Disable_Interrupts;
X if (XGetWindowProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom,
X (long)Get_Integer (start), (long)Get_Integer (len),
X EQ(deletep, True), req_type, &actual_type, &format,
X &nitems, &bytes_left, &data) != Success)
X Primitive_Error ("cannot get property");
X Enable_Interrupts;
X ret = t = P_Make_List (Make_Fixnum (4), Null);
X GC_Link2 (ret, t);
X x = Make_Atom (actual_type);
X Car (t) = x; t = Cdr (t);
X x = Make_Integer (format);
X Car (t) = x; t = Cdr (t);
X if (nitems) {
X if (format == 8) {
X Object s;
X x = Make_String ((char *)0, (int)nitems);
X s = Car (t) = x;
X bcopy (data, STRING(s)->data, (int)nitems);
X } else {
X Object v = Make_Vector ((int)nitems, Null);
X GC_Node;
X /* Assumes short is 16 bits and int is 32 bits.
X */
X GC_Link (v);
X for (i = 0; i < nitems; i++) {
X x = Make_Integer (format == 16 ?
X *((short *)data + i) : *((int *)data + i));
X VECTOR(v)->data[i] = x;
X }
X Car (t) = v;
X GC_Unlink;
X }
X }
X t = Cdr (t);
X x = Make_Unsigned ((unsigned)bytes_left);
X Car (t) = x;
X GC_Unlink;
X return ret;
X}
X
Xstatic Object P_Change_Property (w, prop, type, format, mode, data)
X Object w, prop, type, format, mode, data; {
X register i, m, x, nitems, f;
X char *buf;
X
X Check_Type (w, T_Window);
X Check_Type (prop, T_Atom);
X Check_Type (type, T_Atom);
X m = Symbols_To_Bits (mode, 0, Propmode_Syms);
X switch (f = Get_Integer (format)) {
X case 8:
X Check_Type (data, T_String);
X buf = STRING(data)->data;
X nitems = STRING(data)->size;
X break;
X case 16: case 32:
X Check_Type (data, T_Vector);
X nitems = VECTOR(data)->size;
X buf = alloca (nitems * (f / sizeof (char)));
X for (i = 0; i < nitems; i++) {
X x = Get_Integer (VECTOR(data)->data[i]);
X if (f == 16) {
X if (x > 65535)
X Primitive_Error ("format mismatch");
X *((short *)buf + i) = x; /* Assumes short is 16 bits */
X } else *((int *)buf + i) = x; /* and int is 32 bits. */
X }
X break;
X default:
X Primitive_Error ("invalid format: ~s", format);
X }
X XChangeProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom,
X ATOM(type)->atom, f, m, buf, nitems);
X return Void;
X}
X
Xstatic Object P_Delete_Property (w, prop) Object w, prop; {
X Check_Type (w, T_Window);
X Check_Type (prop, T_Atom);
X XDeleteProperty (WINDOW(w)->dpy, WINDOW(w)->win, ATOM(prop)->atom);
X return Void;
X}
X
Xstatic Object P_Rotate_Properties (w, v, delta) Object w, v, delta; {
X Atom *p;
X register i, n;
X
X Check_Type (w, T_Window);
X Check_Type (v, T_Vector);
X n = VECTOR(v)->size;
X p = (Atom *)alloca (n * sizeof (Atom));
X for (i = 0; i < n; i++) {
X Object a = VECTOR(v)->data[i];
X Check_Type (a, T_Atom);
X p[i] = ATOM(a)->atom;
X }
X XRotateWindowProperties (WINDOW(w)->dpy, WINDOW(w)->win, p, n,
X Get_Integer (delta));
X return Void;
X}
X
Xstatic Object P_Set_Selection_Owner (d, s, owner, time) Object d, s, owner,
X time; {
X Check_Type (d, T_Display);
X Check_Type (s, T_Atom);
X XSetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom, Get_Window (owner),
X Get_Time (time));
X return Void;
X}
X
Xstatic Object P_Selection_Owner (d, s) Object d, s; {
X Check_Type (d, T_Display);
X Check_Type (s, T_Atom);
X return Make_Window (0, DISPLAY(d)->dpy,
X XGetSelectionOwner (DISPLAY(d)->dpy, ATOM(s)->atom));
X}
X
Xstatic Object P_Convert_Selection (s, target, prop, w, time)
X Object s, target, prop, w, time; {
X Atom p = None;
X
X Check_Type (s, T_Atom);
X Check_Type (target, T_Atom);
X if (!EQ(prop, Sym_None)) {
X Check_Type (prop, T_Atom);
X p = ATOM(prop)->atom;
X }
X Check_Type (w, T_Window);
X XConvertSelection (WINDOW(w)->dpy, ATOM(s)->atom, ATOM(target)->atom,
X p, WINDOW(w)->win, Get_Time (time));
X return Void;
X}
X
Xinit_xlib_property () {
X Define_Symbol (&Sym_Now, "now");
X Generic_Define (Atom, "atom", "atom?");
X Define_Primitive (P_Make_Atom, "make-atom", 1, 1, EVAL);
X Define_Primitive (P_Intern_Atom, "intern-atom", 2, 2, EVAL);
X Define_Primitive (P_Find_Atom, "find-atom", 2, 2, EVAL);
X Define_Primitive (P_Atom_Name, "atom-name", 2, 2, EVAL);
X Define_Primitive (P_List_Properties, "list-properties", 1, 1, EVAL);
X Define_Primitive (P_Get_Property, "get-property", 6, 6, EVAL);
X Define_Primitive (P_Change_Property, "change-property", 6, 6, EVAL);
X Define_Primitive (P_Delete_Property, "delete-property", 2, 2, EVAL);
X Define_Primitive (P_Rotate_Properties, "rotate-properties", 3, 3, EVAL);
X Define_Primitive (P_Set_Selection_Owner, "set-selection-owner!",
X 4, 4, EVAL);
X Define_Primitive (P_Selection_Owner, "selection-owner", 2, 2, EVAL);
X Define_Primitive (P_Convert_Selection, "convert-selection", 5, 5, EVAL);
X}
END_OF_lib/xlib/property.c
if test 7184 -ne `wc -c <lib/xlib/property.c`; then
echo shar: \"lib/xlib/property.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/pointer.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/pointer.c\"
else
echo shar: Extracting \"lib/xlib/pointer.c\" \(6645 characters\)
sed "s/^X//" >lib/xlib/pointer.c <<'END_OF_lib/xlib/pointer.c'
X#include "xlib.h"
X
Xstatic Object Sym_Any;
X
XTime Get_Time (time) Object time; {
X if (EQ(time, Sym_Now))
X return CurrentTime;
X return (Time)Get_Integer (time);
X}
X
Xstatic Get_Mode (m) Object m; {
X Check_Type (m, T_Boolean);
X return EQ(m, True) ? GrabModeSync : GrabModeAsync;
X}
X
Xstatic Object P_Grab_Pointer (win, ownerp, events, psyncp, ksyncp, confine_to,
X cursor, time) Object win, ownerp, events, psyncp, ksyncp, confine_to,
X cursor, time; {
X Check_Type (win, T_Window);
X Check_Type (ownerp, T_Boolean);
X return Bits_To_Symbols ((unsigned long)XGrabPointer (WINDOW(win)->dpy,
X WINDOW(win)->win,
X EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms),
X Get_Mode (psyncp), Get_Mode (ksyncp),
X Get_Window (confine_to), Get_Cursor (cursor), Get_Time (time)),
X 0, Grabstatus_Syms);
X}
X
Xstatic Object P_Ungrab_Pointer (d, time) Object d, time; {
X Check_Type (d, T_Display);
X XUngrabPointer (DISPLAY(d)->dpy, Get_Time (time));
X return Void;
X}
X
Xstatic Object P_Grab_Button (win, button, mods, ownerp, events, psyncp, ksyncp,
X confine_to, cursor) Object win, button, mods, ownerp, events,
X psyncp, ksyncp, confine_to, cursor; {
X Check_Type (win, T_Window);
X Check_Type (ownerp, T_Boolean);
X XGrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
X Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win,
X EQ(ownerp, True), Symbols_To_Bits (events, 1, Event_Syms),
X Get_Mode (psyncp), Get_Mode (ksyncp),
X Get_Window (confine_to), Get_Cursor (cursor));
X return Void;
X}
X
Xstatic Object P_Ungrab_Button (win, button, mods) {
X Check_Type (win, T_Window);
X XUngrabButton (WINDOW(win)->dpy, Symbols_To_Bits (button, 0, Button_Syms),
X Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
X return Void;
X}
X
Xstatic Object P_Change_Active_Pointer_Grab (d, events, cursor, time)
X Object d, events, cursor, time; {
X Check_Type (d, T_Display);
X XChangeActivePointerGrab (DISPLAY(d)->dpy, Symbols_To_Bits (events, 1,
X Event_Syms), Get_Cursor (cursor), Get_Time (time));
X return Void;
X}
X
Xstatic Object P_Grab_Keyboard (win, ownerp, psyncp, ksyncp, time) Object win,
X ownerp, psyncp, ksyncp, time; {
X Check_Type (win, T_Window);
X Check_Type (ownerp, T_Boolean);
X return Bits_To_Symbols ((unsigned long)XGrabKeyboard (WINDOW(win)->dpy,
X WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp),
X Get_Mode (ksyncp), Get_Time (time)),
X 0, Grabstatus_Syms);
X}
X
Xstatic Object P_Ungrab_Keyboard (d, time) Object d, time; {
X Check_Type (d, T_Display);
X XUngrabKeyboard (DISPLAY(d)->dpy, Get_Time (time));
X return Void;
X}
X
Xstatic Object P_Grab_Key (win, key, mods, ownerp, psyncp, ksyncp) Object win,
X key, mods, ownerp, psyncp, ksyncp; {
X int keycode = AnyKey;
X
X Check_Type (win, T_Window);
X if (!EQ(key, Sym_Any))
X keycode = Get_Integer (key);
X Check_Type (ownerp, T_Boolean);
X XGrabKey (WINDOW(win)->dpy, keycode, Symbols_To_Bits (mods, 1, State_Syms),
X WINDOW(win)->win, EQ(ownerp, True), Get_Mode (psyncp),
X Get_Mode (ksyncp));
X return Void;
X}
X
Xstatic Object P_Ungrab_Key (win, key, mods) Object win, key, mods; {
X int keycode = AnyKey;
X
X Check_Type (win, T_Window);
X if (!EQ(key, Sym_Any))
X keycode = Get_Integer (key);
X XUngrabKey (WINDOW(win)->dpy, keycode,
X Symbols_To_Bits (mods, 1, State_Syms), WINDOW(win)->win);
X return Void;
X}
X
Xstatic Object P_Allow_Events (d, mode, time) Object d, mode, time; {
X Check_Type (d, T_Display);
X XAllowEvents (DISPLAY(d)->dpy, Symbols_To_Bits (mode, 0,
X Allow_Events_Syms), Get_Time (time));
X return Void;
X}
X
Xstatic Object P_Grab_Server (d) Object d; {
X Check_Type (d, T_Display);
X XGrabServer (DISPLAY(d)->dpy);
X return Void;
X}
X
Xstatic Object P_Ungrab_Server (d) Object d; {
X Check_Type (d, T_Display);
X XUngrabServer (DISPLAY(d)->dpy);
X return Void;
X}
X
Xstatic Object P_Query_Pointer (win) Object win; {
X Object l, t, z;
X Bool ret;
X Window root, child;
X int r_x, r_y, x, y;
X unsigned int mask;
X GC_Node3;
X
X Check_Type (win, T_Window);
X ret = XQueryPointer (WINDOW(win)->dpy, WINDOW(win)->win, &root, &child,
X &r_x, &r_y, &x, &y, &mask);
X t = l = P_Make_List (Make_Fixnum (8), Null);
X GC_Link3 (l, t, win);
X Car (t) = Make_Fixnum (x); t = Cdr (t);
X Car (t) = Make_Fixnum (y); t = Cdr (t);
X Car (t) = ret ? True : False; t = Cdr (t);
X z = Make_Window (0, WINDOW(win)->dpy, root);
X Car (t) = z; t = Cdr (t);
X Car (t) = Make_Fixnum (r_x); t = Cdr (t);
X Car (t) = Make_Fixnum (r_y); t = Cdr (t);
X z = Make_Window (0, WINDOW(win)->dpy, child);
X Car (t) = z; t = Cdr (t);
X z = Bits_To_Symbols ((unsigned long)mask, 1, State_Syms);
X Car (t) = z;
X GC_Unlink;
X return l;
X}
X
Xstatic Object P_General_Warp_Pointer (dpy, dst, dstx, dsty, src, srcx, srcy,
X srcw, srch) Object dpy, dst, dstx, dsty, src, srcx, srcy, srcw, srch; {
X Check_Type (dpy, T_Display);
X XWarpPointer (DISPLAY(dpy)->dpy, Get_Window (src), Get_Window (dst),
X Get_Integer (srcx), Get_Integer (srcy), Get_Integer (srcw),
X Get_Integer (srch), Get_Integer (dstx), Get_Integer (dsty));
X return Void;
X}
X
Xstatic Object P_Bell (argc, argv) Object *argv; {
X register percent = 0;
X
X Check_Type (argv[0], T_Display);
X if (argc == 2) {
X percent = Get_Integer (argv[1]);
X if (percent < -100 || percent > 100)
X Range_Error (argv[1]);
X }
X XBell (DISPLAY(argv[0])->dpy, percent);
X return Void;
X}
X
Xinit_xlib_pointer () {
X Define_Symbol (&Sym_Any, "any");
X Define_Primitive (P_Grab_Pointer, "grab-pointer", 8, 8, EVAL);
X Define_Primitive (P_Ungrab_Pointer, "ungrab-pointer", 2, 2, EVAL);
X Define_Primitive (P_Grab_Button, "grab-button", 9, 9, EVAL);
X Define_Primitive (P_Ungrab_Button, "ungrab-button", 3, 3, EVAL);
X Define_Primitive (P_Change_Active_Pointer_Grab,
X "change-active-pointer-grab", 4, 4, EVAL);
X Define_Primitive (P_Grab_Keyboard, "grab-keyboard", 5, 5, EVAL);
X Define_Primitive (P_Ungrab_Keyboard, "ungrab-keyboard", 2, 2, EVAL);
X Define_Primitive (P_Grab_Key, "grab-key", 6, 6, EVAL);
X Define_Primitive (P_Ungrab_Key, "ungrab-key", 3, 3, EVAL);
X Define_Primitive (P_Allow_Events, "allow-events", 3, 3, EVAL);
X Define_Primitive (P_Grab_Server, "grab-server", 1, 1, EVAL);
X Define_Primitive (P_Ungrab_Server, "ungrab-server", 1, 1, EVAL);
X Define_Primitive (P_Query_Pointer, "query-pointer", 1, 1, EVAL);
X Define_Primitive (P_General_Warp_Pointer, "general-warp-pointer",
X 9, 9, EVAL);
X Define_Primitive (P_Bell, "bell", 1, 2, VARARGS);
X}
END_OF_lib/xlib/pointer.c
if test 6645 -ne `wc -c <lib/xlib/pointer.c`; then
echo shar: \"lib/xlib/pointer.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xlib/wm.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xlib/wm.c\"
else
echo shar: Extracting \"lib/xlib/wm.c\" \(7029 characters\)
sed "s/^X//" >lib/xlib/wm.c <<'END_OF_lib/xlib/wm.c'
X#include "xlib.h"
X
Xextern XFetchName(), XStoreName(), XGetIconName(), XSetIconName();
X
Xstatic Object Sym_Wm_Hints, Sym_Size_Hints, Sym_Icon_Size;
X
Xstatic Object Get_Name (w, f) Object w; int (*f)(); {
X char *ret;
X Object s;
X
X Check_Type (w, T_Window);
X Disable_Interrupts;
X if (!(*f) (WINDOW(w)->dpy, WINDOW(w)->win, &ret) || ret == 0) {
X Enable_Interrupts;
X return False;
X }
X Enable_Interrupts;
X s = Make_String (ret, strlen (ret));
X XFree (ret);
X return s;
X}
X
Xstatic Object P_Wm_Name (w) Object w; {
X return Get_Name (w, XFetchName);
X}
X
Xstatic Object P_Wm_Icon_Name (w) Object w; {
X return Get_Name (w, XGetIconName);
X}
X
Xstatic Object Set_Name (w, name, f) Object w, name; int (*f)(); {
X register char *s;
X
X Check_Type (w, T_Window);
X Make_C_String (name, s);
X (*f) (WINDOW(w)->dpy, WINDOW(w)->win, s);
X return Void;
X}
X
Xstatic Object P_Set_Wm_Name (w, name) Object w, name; {
X return Set_Name (w, name, XStoreName);
X}
X
Xstatic Object P_Set_Wm_Icon_Name (w, name) Object w, name; {
X return Set_Name (w, name, XSetIconName);
X}
X
Xstatic Object P_Wm_Class (w) Object w; {
X Object ret, x;
X XClassHint c;
X GC_Node;
X
X Check_Type (w, T_Window);
X /*
X * In X11.2 XGetClassHint() returns either 0 or Success, which happens
X * to be defined as 0. So until this bug is fixed, we must
X * explicitly check whether the XClassHint structure has been filled.
X */
X c.res_name = c.res_class = 0;
X Disable_Interrupts;
X (void)XGetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
X Enable_Interrupts;
X ret = Cons (False, False);
X GC_Link (ret);
X if (c.res_name) {
X x = Make_String (c.res_name, strlen (c.res_name));
X Car (ret) = x;
X }
X if (c.res_class) {
X x = Make_String (c.res_class, strlen (c.res_class));
X Cdr (ret) = x;
X }
X GC_Unlink;
X return ret;
X}
X
Xstatic Object P_Set_Wm_Class (w, name, class) Object w, name, class; {
X XClassHint c;
X
X Check_Type (w, T_Window);
X Make_C_String (name, c.res_name);
X Make_C_String (class, c.res_class);
X XSetClassHint (WINDOW(w)->dpy, WINDOW(w)->win, &c);
X return Void;
X}
X
Xstatic Object P_Set_Wm_Command (w, cmd) Object w, cmd; {
X register i, n;
X register char **argv;
X Object c;
X
X Check_Type (w, T_Window);
X Check_List (cmd);
X n = Internal_Length (cmd);
X argv = (char **)alloca (n * sizeof (char *));
X for (i = 0; i < n; i++, cmd = Cdr (cmd)) {
X c = Car (cmd);
X Make_C_String (c, argv[i]);
X }
X XSetCommand (WINDOW(w)->dpy, WINDOW(w)->win, argv, n);
X return Void;
X}
X
Xstatic Object P_Wm_Hints (w) Object w; {
X XWMHints *p;
X
X Check_Type (w, T_Window);
X Disable_Interrupts;
X p = XGetWMHints (WINDOW(w)->dpy, WINDOW(w)->win);
X Enable_Interrupts;
X if (p)
X WMH = *p;
X else
X WMH.flags = 0;
X return Record_To_Vector (Wm_Hints_Rec, Wm_Hints_Size, Sym_Wm_Hints,
X WINDOW(w)->dpy, (unsigned long)WMH.flags);
X}
X
Xstatic Object P_Set_Wm_Hints (w, h) Object w, h; {
X register unsigned long mask;
X
X Check_Type (w, T_Window);
X mask = Vector_To_Record (h, Wm_Hints_Size, Sym_Wm_Hints, Wm_Hints_Rec);
X WMH.flags = mask;
X XSetWMHints (WINDOW(w)->dpy, WINDOW(w)->win, &WMH);
X return Void;
X}
X
Xstatic Object P_Size_Hints (w, a) Object w, a; {
X Check_Type (w, T_Window);
X Check_Type (a, T_Atom);
X Disable_Interrupts;
X if (!XGetSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom))
X SZH.flags = 0;
X Enable_Interrupts;
X if ((SZH.flags & (PPosition|USPosition)) == (PPosition|USPosition))
X SZH.flags &= ~PPosition;
X if ((SZH.flags & (PSize|USSize)) == (PSize|USSize))
X SZH.flags &= ~PSize;
X return Record_To_Vector (Size_Hints_Rec, Size_Hints_Size, Sym_Size_Hints,
X WINDOW(w)->dpy, (unsigned long)SZH.flags);
X}
X
Xstatic Object P_Set_Size_Hints (w, a, h) Object w, a, h; {
X register unsigned long mask;
X
X Check_Type (w, T_Window);
X Check_Type (a, T_Atom);
X bzero ((char *)&SZH, sizeof (SZH)); /* Not portable? */
X mask = Vector_To_Record (h, Size_Hints_Size, Sym_Size_Hints,
X Size_Hints_Rec);
X if ((mask & (PPosition|USPosition)) == (PPosition|USPosition))
X mask &= ~PPosition;
X if ((mask & (PSize|USSize)) == (PSize|USSize))
X mask &= ~PSize;
X SZH.flags = mask;
X XSetSizeHints (WINDOW(w)->dpy, WINDOW(w)->win, &SZH, ATOM(a)->atom);
X return Void;
X}
X
Xstatic Object P_Icon_Sizes (w) Object w; {
X XIconSize *p;
X int i, n;
X Object v, x;
X GC_Node2;
X
X Check_Type (w, T_Window);
X Disable_Interrupts;
X if (!XGetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, &p, &n))
X n = 0;
X Enable_Interrupts;
X v = Make_Vector (n, Null);
X GC_Link2 (v, w);
X for (i = 0; i < n; i++) {
X ISZ = p[i];
X x = Record_To_Vector (Icon_Size_Rec, Icon_Size_Size, Sym_Icon_Size,
X WINDOW(w)->dpy, ~0L);
X VECTOR(v)->data[i] = x;
X }
X GC_Unlink;
X return v;
X}
X
Xstatic Object P_Set_Icon_Sizes (w, v) Object w, v; {
X register i, n;
X XIconSize *p;
X
X Check_Type (w, T_Window);
X Check_Type (v, T_Vector);
X n = VECTOR(v)->size;
X p = (XIconSize *)alloca (n * sizeof (XIconSize));
X for (i = 0; i < n; i++) {
X (void)Vector_To_Record (VECTOR(v)->data[i], Icon_Size_Size,
X Sym_Icon_Size, Icon_Size_Rec);
X p[i] = ISZ;
X }
X XSetIconSizes (WINDOW(w)->dpy, WINDOW(w)->win, p, n);
X return Void;
X}
X
Xstatic Object P_Transient_For (w) Object w; {
X Window win;
X
X Disable_Interrupts;
X if (!XGetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, &win))
X win = None;
X Enable_Interrupts;
X return Make_Window (0, WINDOW(w)->dpy, win);
X}
X
Xstatic Object P_Set_Transient_For (w, pw) Object w, pw; {
X Check_Type (w, T_Window);
X XSetTransientForHint (WINDOW(w)->dpy, WINDOW(w)->win, Get_Window (pw));
X return Void;
X}
X
Xinit_xlib_wm () {
X Define_Symbol (&Sym_Wm_Hints, "wm-hints");
X Define_Symbol (&Sym_Size_Hints, "size-hints");
X Define_Symbol (&Sym_Icon_Size, "icon-size");
X Define_Primitive (P_Wm_Name, "wm-name", 1, 1, EVAL);
X Define_Primitive (P_Wm_Icon_Name, "wm-icon-name", 1, 1, EVAL);
X Define_Primitive (P_Set_Wm_Name, "set-wm-name!", 2, 2, EVAL);
X Define_Primitive (P_Set_Wm_Icon_Name, "set-wm-icon-name!", 2, 2, EVAL);
X Define_Primitive (P_Wm_Class, "wm-class", 1, 1, EVAL);
X Define_Primitive (P_Set_Wm_Class, "set-wm-class!", 3, 3, EVAL);
X Define_Primitive (P_Set_Wm_Command, "set-wm-command!", 2, 2, EVAL);
X Define_Primitive (P_Wm_Hints, "wm-hints", 1, 1, EVAL);
X Define_Primitive (P_Set_Wm_Hints, "set-wm-hints!", 2, 2, EVAL);
X Define_Primitive (P_Size_Hints, "size-hints", 2, 2, EVAL);
X Define_Primitive (P_Set_Size_Hints, "set-size-hints!", 3, 3, EVAL);
X Define_Primitive (P_Icon_Sizes, "icon-sizes", 1, 1, EVAL);
X Define_Primitive (P_Set_Icon_Sizes, "set-icon-sizes!", 2, 2, EVAL);
X Define_Primitive (P_Transient_For, "transient-for", 1, 1, EVAL);
X Define_Primitive (P_Set_Transient_For,"set-transient-for!",2, 2, EVAL);
X}
END_OF_lib/xlib/wm.c
if test 7029 -ne `wc -c <lib/xlib/wm.c`; then
echo shar: \"lib/xlib/wm.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/Makefile\"
else
echo shar: Extracting \"lib/xaw/Makefile\" \(445 characters\)
sed "s/^X//" >lib/xaw/Makefile <<'END_OF_lib/xaw/Makefile'
XWIDGET_SET= xaw
X
XO= ascii.o\
X box.o\
X clock.o\
X command.o\
X dialog.o\
X form.o\
X grip.o\
X label.o\
X list.o\
X scroll.o\
X shell.o\
X viewport.o\
X vpaned.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/xaw/Makefile
if test 445 -ne `wc -c <lib/xaw/Makefile`; then
echo shar: \"lib/xaw/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/grip.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/grip.d\"
else
echo shar: Extracting \"lib/xaw/grip.d\" \(642 characters\)
sed "s/^X//" >lib/xaw/grip.d <<'END_OF_lib/xaw/grip.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'grip "Grip.h")
X
X(define-widget-class 'grip 'gripWidgetClass)
X
X(define-callback 'grip 'callback #t)
X
X(c->scheme 'grip-callback
X" Object args, ret, t = Null;
X register i;
X GripCallData p = (GripCallData)x;
X GC_Node2;
X
X args = Get_Event_Args (p->event);
X ret = Cons (Copy_List (args), Null);
X Destroy_Event_Args (args);
X GC_Link2 (ret, t);
X t = P_Make_List (Make_Fixnum (p->num_params), Null);
X for (i = 0, Cdr (ret) = t; i < p->num_params; i++, t = Cdr (t)) {
X Object s = Make_String (p->params[i], strlen (p->params[i]));
X Car (t) = s;
X }
X GC_Unlink;
X return ret;")
END_OF_lib/xaw/grip.d
if test 642 -ne `wc -c <lib/xaw/grip.d`; then
echo shar: \"lib/xaw/grip.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/list.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/list.d\"
else
echo shar: Extracting \"lib/xaw/list.d\" \(1526 characters\)
sed "s/^X//" >lib/xaw/list.d <<'END_OF_lib/xaw/list.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'list "List.h"
X
X"static char **Get_List (x) Object x; {
X register i, n;
X register char *s, **l;
X
X Check_List (x);
X n = Internal_Length (x);
X l = (char **)XtMalloc ((n+1) * sizeof (char *));
X for (i = 0; i < n; i++, x = Cdr (x)) {
X Make_C_String (Car (x), s);
X l[i] = XtNewString (s);
X }
X l[i] = 0;
X return l;
X}")
X
X(define-widget-class 'list 'listWidgetClass)
X
X(define-callback 'list 'callback #t)
X
X(c->scheme 'list-callback
X" XtListReturnStruct *p = (XtListReturnStruct *)x;
X return Cons (Make_String (p->string, strlen (p->string)),
X Make_Fixnum (p->index));")
X
X(scheme->c 'list-list
X" return (XtArgVal)Get_List (x);")
X
X(define-primitive 'list-change! '(w x resize)
X" Check_Widget_Class (w, listWidgetClass);
X Check_Type (resize, T_Boolean);
X XtListChange (WIDGET(w)->widget, Get_List (x), 0, 0, EQ (resize, True));
X return Void;")
X
X(define-primitive 'list-highlight '(w i)
X" Check_Widget_Class (w, listWidgetClass);
X XtListHighlight (WIDGET(w)->widget, Get_Integer (i));
X return Void;")
X
X(define-primitive 'list-unhighlight '(w)
X" Check_Widget_Class (w, listWidgetClass);
X XtListUnhighlight (WIDGET(w)->widget);
X return Void;")
X
X(define-primitive 'list-current '(w)
X" XtListReturnStruct *p;
X
X Check_Widget_Class (w, listWidgetClass);
X p = XtListShowCurrent (WIDGET(w)->widget);
X if (p->index == XT_LIST_NONE)
X return False;
X return Cons (Make_String (p->string, strlen (p->string)),
X Make_Fixnum (p->index));")
END_OF_lib/xaw/list.d
if test 1526 -ne `wc -c <lib/xaw/list.d`; then
echo shar: \"lib/xaw/list.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/scroll.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/scroll.d\"
else
echo shar: Extracting \"lib/xaw/scroll.d\" \(560 characters\)
sed "s/^X//" >lib/xaw/scroll.d <<'END_OF_lib/xaw/scroll.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'scrollbar "Scroll.h")
X
X(define-widget-class 'scrollbar 'scrollbarWidgetClass)
X
X(define-callback 'scrollbar 'scrollProc #t)
X(define-callback 'scrollbar 'jumpProc #t)
X
X(c->scheme 'scrollbar-scrollProc
X" return Make_Integer ((int)x);")
X
X(c->scheme 'scrollbar-jumpProc
X" return Make_Reduced_Flonum ((double)*(float *)x);")
X
X(define-primitive 'scrollbar-set-thumb! '(w t s)
X" Check_Widget_Class (w, scrollbarWidgetClass);
X XtScrollBarSetThumb (WIDGET(w)->widget, Get_Double (t), Get_Double (s));
X return Void;")
END_OF_lib/xaw/scroll.d
if test 560 -ne `wc -c <lib/xaw/scroll.d`; then
echo shar: \"lib/xaw/scroll.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/box.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/box.d\"
else
echo shar: Extracting \"lib/xaw/box.d\" \(96 characters\)
sed "s/^X//" >lib/xaw/box.d <<'END_OF_lib/xaw/box.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'box "Box.h")
X
X(define-widget-class 'box 'boxWidgetClass)
END_OF_lib/xaw/box.d
if test 96 -ne `wc -c <lib/xaw/box.d`; then
echo shar: \"lib/xaw/box.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/shell.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/shell.d\"
else
echo shar: Extracting \"lib/xaw/shell.d\" \(420 characters\)
sed "s/^X//" >lib/xaw/shell.d <<'END_OF_lib/xaw/shell.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'shell "Shell.h")
X
X(define-widget-class 'shell 'shellWidgetClass)
X(define-widget-class 'override-shell 'overrideShellWidgetClass)
X(define-widget-class 'wm-shell 'wmShellWidgetClass)
X(define-widget-class 'transient-shell 'transientShellWidgetClass)
X(define-widget-class 'toplevel-shell 'topLevelShellWidgetClass)
X(define-widget-class 'application-shell 'applicationShellWidgetClass)
END_OF_lib/xaw/shell.d
if test 420 -ne `wc -c <lib/xaw/shell.d`; then
echo shar: \"lib/xaw/shell.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/clock.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/clock.d\"
else
echo shar: Extracting \"lib/xaw/clock.d\" \(104 characters\)
sed "s/^X//" >lib/xaw/clock.d <<'END_OF_lib/xaw/clock.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'clock "Clock.h")
X
X(define-widget-class 'clock 'clockWidgetClass)
END_OF_lib/xaw/clock.d
if test 104 -ne `wc -c <lib/xaw/clock.d`; then
echo shar: \"lib/xaw/clock.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/dialog.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/dialog.d\"
else
echo shar: Extracting \"lib/xaw/dialog.d\" \(108 characters\)
sed "s/^X//" >lib/xaw/dialog.d <<'END_OF_lib/xaw/dialog.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'dialog "Dialog.h")
X
X(define-widget-class 'dialog 'dialogWidgetClass)
END_OF_lib/xaw/dialog.d
if test 108 -ne `wc -c <lib/xaw/dialog.d`; then
echo shar: \"lib/xaw/dialog.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/vpaned.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/vpaned.d\"
else
echo shar: Extracting \"lib/xaw/vpaned.d\" \(108 characters\)
sed "s/^X//" >lib/xaw/vpaned.d <<'END_OF_lib/xaw/vpaned.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'vpaned "VPaned.h")
X
X(define-widget-class 'vpaned 'vPanedWidgetClass)
END_OF_lib/xaw/vpaned.d
if test 108 -ne `wc -c <lib/xaw/vpaned.d`; then
echo shar: \"lib/xaw/vpaned.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/ascii.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/ascii.d\"
else
echo shar: Extracting \"lib/xaw/ascii.d\" \(1916 characters\)
sed "s/^X//" >lib/xaw/ascii.d <<'END_OF_lib/xaw/ascii.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'ascii "AsciiText.h"
X
X"static SYMDESCR Edittype_Syms[] = {
X { \"text-read\", XttextRead },
X { \"text-append\", XttextAppend },
X { \"text-edit\", XttextEdit },
X { 0, 0 }
X};
Xstatic SYMDESCR Options_Syms[] = {
X { \"word-break\", wordBreak },
X { \"scroll-vertical\", scrollVertical },
X { \"scroll-horizontal\", scrollHorizontal },
X { \"scroll-on-overflow\", scrollOnOverflow },
X { \"resize-width\", resizeWidth },
X { \"resize-height\", resizeHeight },
X { \"editable\", editable },
X { 0, 0 }
X};")
X
X(define-widget-class 'ascii-string 'asciiStringWidgetClass
X '(font Font FontStruct)
X '(foreground Foreground Pixel)
X '(editType EditType EditMode)
X '(length Length Int))
X
X(define-widget-class 'ascii-disk 'asciiDiskWidgetClass
X '(font Font FontStruct)
X '(foreground Foreground Pixel)
X '(editType EditType EditMode))
X
X(define scheme->edit-type
X" return (XtArgVal)Symbols_To_Bits (x, 0, Edittype_Syms);")
X
X(scheme->c 'ascii-string-editType scheme->edit-type)
X(scheme->c 'ascii-disk-editType scheme->edit-type)
X
X(define scheme->text-options
X" return (XtArgVal)Symbols_To_Bits (x, 1, Options_Syms);")
X
X(scheme->c 'ascii-string-textOptions scheme->text-options)
X(scheme->c 'ascii-disk-textOptions scheme->text-options)
X
X(define text-options->scheme
X" return Bits_To_Symbols ((unsigned long)x, 1, Options_Syms);")
X
X(c->scheme 'ascii-string-textOptions text-options->scheme)
X(c->scheme 'ascii-disk-textOptions text-options->scheme)
X
X(scheme->c 'ascii-string-string
X" char *s, *t;
X Make_C_String (x, t);
X if ((s = XtMalloc (1024)) == 0)
X Primitive_Error (\"out of memory\");
X strncpy (s, t, 1024);
X return (XtArgVal)s;")
X
X(scheme->c 'ascii-string-length
X" if (Get_Integer (x) > 1024)
X Primitive_Error (\"invalid length for ascii-string\");
X return (XtArgVal)Get_Integer (x);")
END_OF_lib/xaw/ascii.d
if test 1916 -ne `wc -c <lib/xaw/ascii.d`; then
echo shar: \"lib/xaw/ascii.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xaw/viewport.d -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xaw/viewport.d\"
else
echo shar: Extracting \"lib/xaw/viewport.d\" \(116 characters\)
sed "s/^X//" >lib/xaw/viewport.d <<'END_OF_lib/xaw/viewport.d'
X;;; -*-Scheme-*-
X
X(define-widget-type 'viewport "Viewport.h")
X
X(define-widget-class 'viewport 'viewportWidgetClass)
END_OF_lib/xaw/viewport.d
if test 116 -ne `wc -c <lib/xaw/viewport.d`; then
echo shar: \"lib/xaw/viewport.d\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test ! -d lib/xt ; then
echo shar: Creating directory \"lib/xt\"
mkdir lib/xt
fi
if test ! -d lib/xt/examples ; then
echo shar: Creating directory \"lib/xt/examples\"
mkdir lib/xt/examples
fi
if test -f lib/xt/examples/dialog -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/dialog\"
else
echo shar: Extracting \"lib/xt/examples/dialog\" \(2235 characters\)
sed "s/^X//" >lib/xt/examples/dialog <<'END_OF_lib/xt/examples/dialog'
X;;; -*-Scheme-*-
X;;;
X;;; (Stupid) dialog box demo
X
X(require 'xwidgets)
X(load-widgets shell dialog command box label)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'dialog 'demo))
X(define top (create-shell 'dialog 'demo (find-class 'application-shell) dpy))
X
X(define f (open-font dpy "*courier-bold-r-normal--14*"))
X(define g (open-font dpy "*courier-bold-r-normal--18*"))
X
X(define gray-bits "\10\2\10\2")
X(define gray (create-bitmap-from-data (display-root-window dpy) gray-bits 4 4))
X
X(define box (create-managed-widget (find-class 'box) top))
X(set-values! box 'h-space 14 'v-space 14 'background-pixmap gray)
X
X(define dialog (create-managed-widget (find-class 'dialog) box
X 'value "/tmp/test" 'label "FILENAME:"))
X(set-values! dialog 'width 80)
X(set-values! (name->widget dialog 'label) 'font f)
X
X(define button (create-managed-widget (find-class 'command) dialog))
X(set-values! button 'label "cancel" 'font f)
X
X(define button2 (create-managed-widget (find-class 'command) dialog))
X(set-values! button2 'label "write" 'font f)
X(add-callback button2 'callback
X (lambda (w)
X (format #t "Filename is ~s~%"
X (car (get-values (widget-parent w) 'value)))))
X
X(define bbox (create-managed-widget (find-class 'box) box))
X
X(define l (create-managed-widget (find-class 'label) bbox 'border-width 0
X 'font f 'label "TYPEFACE:"))
X(define b1 (create-managed-widget (find-class 'command) bbox))
X(set-values! b1 'label "normal" 'font f)
X(define b2 (create-managed-widget (find-class 'command) bbox))
X(set-values! b2 'label "bold" 'font f)
X(define b3 (create-managed-widget (find-class 'command) bbox))
X(set-values! b3 'label "italic" 'font f)
X(define b4 (create-managed-widget (find-class 'command) bbox))
X(set-values! b4 'label "faint" 'font f 'sensitive #f)
X
X(define q (create-managed-widget (find-class 'command) box))
X(set-values! q 'label "quit" 'border-width 3 'font g)
X(add-callback q 'callback (lambda (w) (exit)))
X
X(define q2 (create-managed-widget (find-class 'command) box))
X(set-values! q2 'label "apply" 'border-width 3 'font g)
X(add-callback q2 'callback (lambda (w) (set! done #t)))
X
X(define done #f)
X
X(realize-widget top)
X(while (not done) (context-process-event con))
END_OF_lib/xt/examples/dialog
if test 2235 -ne `wc -c <lib/xt/examples/dialog`; then
echo shar: \"lib/xt/examples/dialog\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/scrollbar -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/scrollbar\"
else
echo shar: Extracting \"lib/xt/examples/scrollbar\" \(658 characters\)
sed "s/^X//" >lib/xt/examples/scrollbar <<'END_OF_lib/xt/examples/scrollbar'
X;;; -*-Scheme-*-
X;;;
X;;; Scroll bar demo
X
X(require 'xwidgets)
X(load-widgets shell scroll)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'scroll 'demo))
X(define top (create-shell 'scroll 'demo (find-class 'application-shell) dpy))
X
X(define scroll (create-managed-widget (find-class 'scrollbar) top
X 'thickness 35 'length 400))
X
X(define (sp w x) (format #t "(scroll-proc ~s)~%" x))
X(define (jp w x) (format #t "(jump-proc ~s)~%" x))
X
X(add-callback scroll 'scroll-proc sp)
X(set-values! scroll 'jump-proc (list jp))
X
X(scrollbar-set-thumb! scroll 0.3 0.2)
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/scrollbar
if test 658 -ne `wc -c <lib/xt/examples/scrollbar`; then
echo shar: \"lib/xt/examples/scrollbar\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/scrollbox -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/scrollbox\"
else
echo shar: Extracting \"lib/xt/examples/scrollbox\" \(1118 characters\)
sed "s/^X//" >lib/xt/examples/scrollbox <<'END_OF_lib/xt/examples/scrollbox'
X;;; -*-Scheme-*-
X;;;
X;;; Scroll box demo
X
X(require 'xwidgets)
X(load-widgets shell command box label)
X
X(define items '(Helvetica Courier Times Palatino Zapf\ Chancery Zapf\ Dingbats))
X(set-cdr! (last-pair items) items)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'box 'demo))
X(define top (create-shell 'box 'demo (find-class 'application-shell) dpy))
X
X(define dia-bits "\0\0\100\0\340\0\360\1\370\3\374\7\376\17\374\7\370\3\360\1\340\0\100\0\0\0")
X(define dia (create-bitmap-from-data (display-root-window dpy) dia-bits 13 13))
X
X(define box (create-managed-widget (find-class 'box) top))
X(set-values! box 'width 200)
X
X(define button (create-managed-widget (find-class 'command) box))
X(set-values! button 'bitmap dia)
X
X(define label (create-managed-widget (find-class 'label) box))
X(set-values! label 'width 130 'label (car items) 'resize #f 'justify 'left
X 'font (open-font dpy "*courier-bold-r-normal--14*"))
X(add-callback button 'callback
X (lambda (w)
X (set! items (cdr items))
X (set-values! label 'label (car items))))
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/scrollbox
if test 1118 -ne `wc -c <lib/xt/examples/scrollbox`; then
echo shar: \"lib/xt/examples/scrollbox\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/list -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/list\"
else
echo shar: Extracting \"lib/xt/examples/list\" \(2163 characters\)
sed "s/^X//" >lib/xt/examples/list <<'END_OF_lib/xt/examples/list'
X;;; -*-Scheme-*-
X;;;
X;;; List widget demo (directory browser)
X
X(require 'xwidgets)
X(load-widgets shell form label command list)
X(require 'unix 'unix.o)
X(require 'sort 'qsort)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'list 'demo))
X(define top (create-shell 'list 'demo (find-class 'application-shell) dpy))
X(set-values! top 'allow-shell-resize #t)
X
X(define form (create-managed-widget (find-class 'form) top))
X
X(define quit (create-managed-widget (find-class 'command) form))
X(set-values! quit 'label "quit")
X(add-callback quit 'callback (lambda x (exit)))
X
X(define back (create-managed-widget (find-class 'command) form))
X(set-values! back 'label "back" 'from-horiz quit)
X(add-callback back 'callback (lambda x (goto "..")))
X
X(define lab (create-managed-widget (find-class 'label) form))
X(set-values! lab 'border-width 0 'from-horiz back 'resizable #t)
X
X;; List widget is broken; ``list'' resource *must* be initialized:
X(define lst (create-managed-widget (find-class 'list) form 'list ()))
X(set-values! lst 'from-vert lab 'resizable #t 'vertical-list #t)
X
X(add-callback lst 'callback
X (lambda (w i)
X (let ((stat (file-status (string-append where "/" (car i)))))
X (set-values! lab 'label stat)
X (if (eq? stat 'directory)
X (goto (car i))))))
X
X(define (goto dir)
X (if (string=? dir "..")
X (begin
X (if (not (string=? where "/"))
X (begin
X (set! where
X (substring where 0
X (do ((i (- (string-length where) 2) (1- i)))
X ((char=? (string-ref where i) #\/) i))))
X (if (eqv? where "")
X (set! where "/")))))
X (if (not (or (string=? dir "/") (string=? where "/")))
X (set! where (string-append where "/")))
X (set! where (string-append where dir)))
X (set-values! lab 'label where)
X (define l ())
X (for-each (lambda (d) (if (not (member d '("." "..")))
X (set! l (cons d l))))
X (read-directory where))
X (set-values! lst 'default-columns
X (max 2 (ceiling (/ (length l) 40))))
X (list-change! lst (sort l string<?) #t))
X
X(define where "")
X(goto "/")
X(set-values! lab 'label "Select directory:")
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/list
if test 2163 -ne `wc -c <lib/xt/examples/list`; then
echo shar: \"lib/xt/examples/list\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/grip -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/grip\"
else
echo shar: Extracting \"lib/xt/examples/grip\" \(649 characters\)
sed "s/^X//" >lib/xt/examples/grip <<'END_OF_lib/xt/examples/grip'
X;;; -*-Scheme-*-
X;;;
X;;; Grip widget demo
X
X(require 'xwidgets)
X(load-widgets shell grip)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'grip 'demo))
X(define top (create-shell 'grip 'demo (find-class 'application-shell) dpy))
X(set-values! top 'width 50 'height 50)
X
X(define g (create-managed-widget (find-class 'grip) top))
X
X(augment-translations g
X" <Btn1Down>: GripAction(press)
X <Btn1Motion>: GripAction(move)
X <Btn1Up>: GripAction(release,done)")
X
X(add-callback g 'callback
X (lambda (w x)
X (format #t "Action: ~s Event: ~s~%" (cdr x) (caar x))))
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/grip
if test 649 -ne `wc -c <lib/xt/examples/grip`; then
echo shar: \"lib/xt/examples/grip\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/viewport -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/viewport\"
else
echo shar: Extracting \"lib/xt/examples/viewport\" \(535 characters\)
sed "s/^X//" >lib/xt/examples/viewport <<'END_OF_lib/xt/examples/viewport'
X;;; -*-Scheme-*-
X
X(require 'xwidgets)
X(load-widgets shell clock viewport)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'viewport 'demo))
X(define top (create-shell 'viewport 'demo (find-class 'application-shell) dpy))
X
X(define v (create-managed-widget (find-class 'viewport) top
X 'force-bars #t 'allow-horiz #t 'allow-vert #t))
X(set-values! v 'width 120 'height 120)
X
X(define c (create-managed-widget (find-class 'clock) v))
X(set-values! c 'width 200 'height 200)
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/viewport
if test 535 -ne `wc -c <lib/xt/examples/viewport`; then
echo shar: \"lib/xt/examples/viewport\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/text -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/text\"
else
echo shar: Extracting \"lib/xt/examples/text\" \(1220 characters\)
sed "s/^X//" >lib/xt/examples/text <<'END_OF_lib/xt/examples/text'
X;;; -*-Scheme-*-
X
X(require 'xwidgets)
X(load-widgets shell ascii box command label)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'text 'demo))
X(define top (create-shell 'text 'demo (find-class 'application-shell) dpy))
X
X(define box (create-managed-widget (find-class 'box) top))
X
X(define lab (create-managed-widget (find-class 'label) box))
X(set-values! lab 'border-width 0 'label "Enter a number:")
X
X;;; string resource *must* be specified (bug in Xaw):
X(define txt (create-managed-widget (find-class 'ascii-string) box
X 'string "" 'length 100 'edit-type 'text-edit))
X
X(define can (create-managed-widget (find-class 'command) box))
X(set-values! can 'label "CANCEL")
X(add-callback can 'callback (lambda foo (exit)))
X
X(define acc (create-managed-widget (find-class 'command) box))
X(set-values! acc 'label "ACCEPT")
X(add-callback acc 'callback
X (lambda foo
X (let ((s (car (get-values txt 'string))))
X (if (not (number-string? s))
X (format #t "~s is not a number!~%" s)
X (format #t "Result is ~a~%" s)
X (exit)))))
X
X(define (number-string? s)
X (not (or (eqv? s "") (memq #f (map char-numeric? (string->list s))))))
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/text
if test 1220 -ne `wc -c <lib/xt/examples/text`; then
echo shar: \"lib/xt/examples/text\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/hp-misc -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/hp-misc\"
else
echo shar: Extracting \"lib/xt/examples/hp-misc\" \(1993 characters\)
sed "s/^X//" >lib/xt/examples/hp-misc <<'END_OF_lib/xt/examples/hp-misc'
X;;; -*-Scheme-*-
X;;;
X;;; HP widgets demo
X
X(require 'xwidgets)
X(set! widget-load-path '(xhp xaw))
X(load-widgets arrow bboard box pbutton sash scroll shell stext toggle)
X(load-widgets valuator vpw)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'widgets 'demo))
X(define top (create-shell 'widgets 'demo (find-class 'application-shell) dpy))
X
X(define box (create-managed-widget (find-class 'box) top))
X
X(define t1 (create-managed-widget (find-class 'toggle) box))
X(set-values! t1 'traversal-type "highlight_enter" 'highlight-thickness 3)
X(define t2 (create-managed-widget (find-class 'toggle) box 'square #f))
X(set-values! t2 'traversal-type "highlight_enter" 'highlight-thickness 3)
X
X(define vpw (create-managed-widget (find-class 'vpw) box))
X
X(define a1 (create-managed-widget (find-class 'arrow) vpw))
X(set-values! a1 'width 75 'height 75)
X(set-values! (name->widget vpw 'sash) 'background "black")
X(define a2 (create-managed-widget (find-class 'arrow) vpw))
X(set-values! a2 'height 75 'arrow-direction "arrow_down")
X
X(define val (create-managed-widget (find-class 'valuator) box))
X(set-values! val 'slider-origin 20 'cursor "sb_right_arrow")
X(add-callback val 'slider-moved (lambda (w x)
X (set-values! s 'string (format #f "~s" x))))
X
X(define s (create-managed-widget (find-class 'static-text) box 'string "20"))
X(set-values! s 'recompute-size #f)
X
X(define sb (create-managed-widget (find-class 'scrollbar) box))
X(set-values! sb 'width 20 'height 150)
X
X(realize-widget top)
X
X(define bb (create-managed-widget (find-class 'bboard) box))
X(set-values! bb 'background-tile "50_foreground")
X(do ((x '(0 40 0 40) (cdr x)) (y '(0 0 40 40) (cdr y))) ((null? x))
X (define s (create-managed-widget (find-class 'static-text) bb
X 'string (format #f "~s,~s" (car x) (car y)) 'x (car x) 'y (car y))))
X
X(define p1 (create-managed-widget (find-class 'push-button) box))
X(set-values! p1 'label "Quit Button")
X(add-callback p1 'select (lambda (w) (exit)))
X
X(context-main-loop con)
END_OF_lib/xt/examples/hp-misc
if test 1993 -ne `wc -c <lib/xt/examples/hp-misc`; then
echo shar: \"lib/xt/examples/hp-misc\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/hp-arrow -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/hp-arrow\"
else
echo shar: Extracting \"lib/xt/examples/hp-arrow\" \(1156 characters\)
sed "s/^X//" >lib/xt/examples/hp-arrow <<'END_OF_lib/xt/examples/hp-arrow'
X;;; -*-Scheme-*-
X;;;
X;;; Demo with arrow, vpw, and push button
X
X(require 'xwidgets)
X(load-widgets arrow sash shell pbutton vpw)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'arrow 'demo))
X(define top (create-shell 'arrow 'demo (find-class 'application-shell) dpy))
X(set-values! top 'allow-shell-resize #t)
X
X(define pane (create-managed-widget (find-class 'vpw) top))
X
X(define button (create-managed-widget (find-class 'push-button) pane))
X(set-values! button 'width 150 'label "Rotate Arrow")
X
X(set-values! (name->widget pane 'sash) 'background "black")
X
X(define arrow (create-managed-widget (find-class 'arrow) pane))
X(set-values! arrow 'height 150 'traversal-type "highlight_enter"
X 'highlight-thickness 3)
X
X(add-callback arrow 'select (lambda (w) (print '[select])))
X(add-callback arrow 'release (lambda (w) (print '[release])))
X
X(define curr '(arrow_up arrow_right arrow_down arrow_left))
X(set-cdr! (last-pair curr) curr)
X(set! curr (cdr curr))
X
X(add-callback button 'select
X (lambda (w)
X (set-values! arrow 'arrow-direction (car curr))
X (set! curr (cdr curr))))
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/hp-arrow
if test 1156 -ne `wc -c <lib/xt/examples/hp-arrow`; then
echo shar: \"lib/xt/examples/hp-arrow\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/hp-list -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/hp-list\"
else
echo shar: Extracting \"lib/xt/examples/hp-list\" \(2637 characters\)
sed "s/^X//" >lib/xt/examples/hp-list <<'END_OF_lib/xt/examples/hp-list'
X;;; -*-Scheme-*-
X;;;
X;;; List widget demo
X
X(require 'xwidgets)
X(set! widget-load-path '(xhp xaw))
X(load-widgets bboard list pbutton shell stext)
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'list 'demo))
X(define top (create-shell 'list 'demo (find-class 'application-shell) dpy))
X
X(define bb (create-managed-widget (find-class 'bboard) top))
X
X(define lst (create-managed-widget (find-class 'list) bb 'num-columns 3))
X(set-values! lst 'x 0 'y 130 'column-width 60 'element-highlight "invert"
X 'element-height 21)
X
X(define instant #t)
X(define p1 (create-managed-widget (find-class 'push-button) bb))
X(set-values! p1 'x 10 'y 10 'label "selection-style: instant")
X(add-callback p1 'release
X (lambda r
X (set-values! p1 'label
X (if instant "selection-style: sticky" "selection-style: instant"))
X (set! instant (not instant))
X (set-values! lst 'selection-style (if instant "instant" "sticky"))))
X
X(define single #t)
X(define p2 (create-managed-widget (find-class 'push-button) bb))
X(set-values! p2 'x 10 'y 40 'label "selection-method: single")
X(add-callback p2 'release
X (lambda r
X (set-values! p2 'label
X (if single "selection-method: multiple" "selection-method: single"))
X (set! single (not single))
X (set-values! lst 'selection-method (if single "single" "multiple"))))
X
X(define biases '(no_bias row_bias col_bias))
X(define bias 0)
X(define p3 (create-managed-widget (find-class 'push-button) bb))
X(set-values! p3 'x 10 'y 70 'label "selection-bias: none")
X(add-callback p3 'release
X (lambda r
X (set! bias (1+ bias)) (set! bias (modulo bias 3))
X (set-values! p3 'label
X (format #f "selection-bias: ~s" (list-ref biases bias)))
X (set-values! lst 'selection-bias (list-ref biases bias))))
X
X(define invert #t)
X(define p4 (create-managed-widget (find-class 'push-button) bb))
X(set-values! p4 'x 10 'y 100 'label "element-highlight: invert")
X(add-callback p4 'release
X (lambda r
X (set-values! p4 'label
X (if invert "element-highlight: border" "element-highlight: invert"))
X (set! invert (not invert))
X (set-values! lst 'element-highlight (if invert "invert" "border"))))
X
X(define p5 (create-managed-widget (find-class 'push-button) bb))
X(set-values! p5 'x 250 'y 10 'label 'QUIT)
X(add-callback p5 'release (lambda r (exit)))
X
X(do ((i 0 (1+ i))) ((= i 80))
X (define w (create-managed-widget (find-class 'static-text) lst
X 'string (format #f "item ~s" i)))
X (set-values! w 'highlight-thickness 2)
X (add-callback w 'select
X (lambda (w) (format #t "selected ~s~%" (car (get-values w 'string))))))
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/hp-list
if test 2637 -ne `wc -c <lib/xt/examples/hp-list`; then
echo shar: \"lib/xt/examples/hp-list\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/examples/hp-menu -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/examples/hp-menu\"
else
echo shar: Extracting \"lib/xt/examples/hp-menu\" \(3228 characters\)
sed "s/^X//" >lib/xt/examples/hp-menu <<'END_OF_lib/xt/examples/hp-menu'
X;;; -*-Scheme-*-
X;;;
X;;; HP menu demo
X
X(require 'xwidgets)
X(load-widgets bboard cascade menubutton menusep popupmgr shell toggle)
X
X(define (make-menu name attach-to)
X (let* ((sh (create-popup-shell (find-class 'shell) attach-to))
X (menu (create-managed-widget name (find-class 'popup-manager) sh)))
X menu))
X
X(define (add-pane where title attach-to)
X (let* ((sh (create-popup-shell (find-class 'shell) where))
X (pane (create-managed-widget (find-class 'cascade) sh)))
X (set-values! pane 'title-string title 'attach-to attach-to)
X pane))
X
X(define (add-button where label)
X (let ((b (create-managed-widget label (find-class 'menu-button) where)))
X (set-values! b 'label label)
X b))
X
X(define (add-separator where style)
X (let ((s (create-managed-widget (find-class 'menu-separator) where)))
X (set-values! s 'separator-type style)
X s))
X
X(define con (create-context))
X(define dpy (initialize-display con #f 'menu 'demo))
X(define top (create-shell 'menu 'demo (find-class 'application-shell) dpy))
X
X(define bb (create-managed-widget (find-class 'bboard) top))
X(define bb1 (create-managed-widget (find-class 'bboard) bb))
X(set-values! bb1 'width 300 'height 30 'layout "ignore")
X(define bb2 (create-managed-widget (find-class 'bboard) bb))
X(set-values! bb2 'y 30 'width 300 'height 150)
X
X(define menu (make-menu 'menu bb2))
X
X(define pane1 (add-pane menu "main menu" 'menu))
X
X(add-button pane1 'search)
X(add-button pane1 'change)
X(add-button pane1 'create)
X(add-button pane1 'destroy)
X(define sep (add-separator pane1 "single_line"))
X(add-button pane1 'help)
X(add-button pane1 'quit)
X
X(define pane2 (add-pane menu "change menu" 'change))
X
X(add-button pane2 'typeface)
X(add-button pane2 'font)
X(add-button pane2 'help)
X
X(define pane3 (add-pane menu "typeface menu" 'typeface))
X
X(add-button pane3 'bold)
X(add-button pane3 'italic)
X(add-button pane3 'underlined)
X(add-button pane3 'double\ underlined)
X(add-button pane3 'crossed\ out)
X(add-button pane3 'negative)
X(add-button pane3 'faint)
X
X(define pane4 (add-pane menu "font menu" 'font))
X
X(do ((i 0 (1+ i))) ((= i 10))
X (add-button pane4 (format #f "font #~s" i)))
X
X(add-callback (name->widget pane1 'quit) 'select (lambda (w) (exit)))
X
X(define (change-separator-style _)
X (set-values! sep 'separator-type
X (if (car (get-values t2 'set))
X (if (car (get-values t3 'set))
X "double_dashed_line"
X "double_line")
X (if (car (get-values t3 'set))
X "single_dashed_line"
X "single_line"))))
X
X(define (change-sticky _)
X (set-values! menu 'sticky-menus (car (get-values t1 'set))))
X
X(define t1 (create-managed-widget (find-class 'toggle) bb1))
X(set-values! t1 'x 10 'y 10 'label "sticky")
X(add-callback t1 'select change-sticky)
X(add-callback t1 'release change-sticky)
X
X(define t2 (create-managed-widget (find-class 'toggle) bb1))
X(set-values! t2 'x 90 'y 10 'label 'double-line)
X(add-callback t2 'select change-separator-style)
X(add-callback t2 'release change-separator-style)
X
X(define t3 (create-managed-widget (find-class 'toggle) bb1))
X(set-values! t3 'x 190 'y 10 'label 'dashed-line)
X(add-callback t3 'select change-separator-style)
X(add-callback t3 'release change-separator-style)
X
X(realize-widget top)
X(context-main-loop con)
END_OF_lib/xt/examples/hp-menu
if test 3228 -ne `wc -c <lib/xt/examples/hp-menu`; then
echo shar: \"lib/xt/examples/hp-menu\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/Makefile -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/Makefile\"
else
echo shar: Extracting \"lib/xt/Makefile\" \(901 characters\)
sed "s/^X//" >lib/xt/Makefile <<'END_OF_lib/xt/Makefile'
XH= ../../src/config.h\
X ../../src/object.h\
X ../../src/extern.h\
X ../../src/macros.h\
X ../util/objects.h\
X ../xlib/xlib.h\
X xt.h
X
XC= callback.c\
X class.c\
X context.c\
X converter.c\
X error.c\
X identifier.c\
X objects.c\
X popup.c\
X resource.c\
X translation.c\
X widget.c
X
XO= callback.o\
X class.o\
X context.o\
X converter.o\
X error.o\
X identifier.o\
X objects.o\
X popup.o\
X resource.o\
X translation.o\
X widget.o
X
Xall: ../xt.o ../xt-only.o
X
X../xt.o: $(O) ../xlib.o
X ld -r -x $(O) -lXt ../xlib.o -lX11; mv a.out ../xt.o; chmod 644 ../xt.o
X
X../xt-only.o: $(O)
X ld -r -x $(O); mv a.out ../xt-only.o; chmod 644 ../xt-only.o
X
Xcallback.o: $(H)
Xclass.o: $(H)
Xcontext.o: $(H)
Xconverter.o: $(H)
Xerror.o: $(H)
Xidentifier.o: $(H)
Xobjects.o: $(H)
Xpopup.o: $(H)
Xresource.o: $(H)
Xtranslation.o: $(H)
Xwidget.o: $(H)
X
Xlint:
X lint $(LINTFLAGS) -abxh $(C) | egrep -v '\?\?\?'
X
Xclean:
X rm -f *.o core a.out ../xt.o ../xt-only.o
END_OF_lib/xt/Makefile
if test 901 -ne `wc -c <lib/xt/Makefile`; then
echo shar: \"lib/xt/Makefile\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/objects.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/objects.c\"
else
echo shar: Extracting \"lib/xt/objects.c\" \(556 characters\)
sed "s/^X//" >lib/xt/objects.c <<'END_OF_lib/xt/objects.c'
X#include <varargs.h>
X
X#include "xt.h"
X
XMatch_Xt_Obj (x, v) Object x; va_list v; {
X register type = TYPE(x);
X
X if (type == T_Context) {
X return va_arg (v, XtAppContext) == CONTEXT(x)->context;
X } else if (type == T_Class) {
X return va_arg (v, WidgetClass) == CLASS(x)->class;
X } else if (type == T_Widget) {
X return va_arg (v, Widget) == WIDGET(x)->widget;
X } else if (type == T_Identifier) {
X return va_arg (v, int) == IDENTIFIER(x)->type
X && va_arg (v, caddr_t) == IDENTIFIER(x)->val;
X } else Panic ("Match_Xt_Obj");
X return 0;
X}
END_OF_lib/xt/objects.c
if test 556 -ne `wc -c <lib/xt/objects.c`; then
echo shar: \"lib/xt/objects.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
if test -f lib/xt/error.c -a "${1}" != "-c" ; then
echo shar: Will not over-write existing file \"lib/xt/error.c\"
else
echo shar: Extracting \"lib/xt/error.c\" \(486 characters\)
sed "s/^X//" >lib/xt/error.c <<'END_OF_lib/xt/error.c'
X#include "xt.h"
X
Xstatic Object V_Xt_Warning_Handler;
X
XXt_Warning (msg) char *msg; {
X Object args, fun;
X
X args = Cons (Make_String (msg, strlen (msg)), Null);
X fun = Val (V_Xt_Warning_Handler);
X if (TYPE(fun) == T_Compound)
X (void)Funcall (fun, args, 0);
X Format (Curr_Output_Port, msg, strlen (msg), 0, (Object *)0);
X P_Newline (0);
X}
X
Xinit_xt_error () {
X Define_Variable (&V_Xt_Warning_Handler, "xt-warning-handler", Null);
X XtSetWarningHandler (Xt_Warning);
X}
END_OF_lib/xt/error.c
if test 486 -ne `wc -c <lib/xt/error.c`; then
echo shar: \"lib/xt/error.c\" unpacked with wrong size!
fi
# end of overwriting check
fi
echo shar: End of archive 12 \(of 14\).
cp /dev/null ark12isdone
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