XWorkstat.st
author Claus Gittinger <cg@exept.de>
Tue, 06 May 1997 14:47:24 +0200
changeset 1709 342fc0eb3517
parent 1695 46d9101e4bee
child 1718 886b895eb2f3
permissions -rw-r--r--
pass drawableId to clip methods (req'd for Windows)

"
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"

DeviceWorkstation subclass:#XWorkstation
	instanceVariableNames:'screen hasShapeExtension hasShmExtension hasDPSExtension
		hasMbufExtension hasXVideoExtension hasSaveUnder hasPEXExtension
		hasImageExtension hasInputExtension ignoreBackingStore blackpixel
		whitepixel protocolsAtom deleteWindowAtom saveYourselfAtom
		quitAppAtom primaryAtom secondaryAtom cutBuffer0Atom stringAtom
		lengthAtom wmStateAtom listOfXFonts buttonsPressed eventRootX
		eventRootY displayName eventTrace dispatchingExpose rgbVisual
		virtualRootId rootId eventBuffer altModifierMask metaModifierMask
		multiClickTime deviceErrorSignal deviceIOErrorSignal'
	classVariableNames:'RawKeysymTranslation ConservativeSync'
	poolDictionaries:''
	category:'Interface-Graphics'
!

!XWorkstation primitiveDefinitions!
%{

#ifdef LINUX
# define SHM
#endif

#define COUNT_RESOURCES
#ifdef COUNT_RESOURCES

static int __cnt_color = 0;
static int __cnt_bitmap = 0;
static int __cnt_view = 0;
static int __cnt_gc = 0;
static int __cnt_cursor = 0;
static int __cnt_font = 0;

#endif

/*
 * x does a typedef Time - I need Object Time ...
 */
#define Time XTime

/*
 * x does a #define True / False
 * we are lucky - the ST/X True/False are not needed
 */
#undef True
#undef False

#ifdef memset
# undef memset
#endif

#include <stdio.h>
#include <X11/Xlib.h>
#include <X11/Xutil.h>
#include <X11/Xatom.h>

#define XK_MISCELLANY
#include <X11/keysymdef.h>

#include <X11/cursorfont.h>

/*
 * this define suppresses XAllocColor/XFreeColor on
 * TrueColor systems - I am not certain, if this is
 * always legal to do (it works with XFree servers).
 */
#define QUICK_TRUE_COLORS

/*
 * shape support works; enabled by -DSHAPE in makefile
 * see RoundClock and RoundGlobe examples
 */
#ifdef SHAPE
# include <X11/extensions/shape.h>
#endif

/*
 * shared memory extension access is currently not supported
 * (only query is implemented)
 */
#ifdef SHM
# include <X11/extensions/XShm.h>
#endif

/*
 * multiBuffer extension access is currently not supported
 * (only query is implemented)
 */
#ifdef MBUF
# include <X11/extensions/multibuf.h>
#endif

/*
 * XVideo extension access is currently not supported
 * (only query is implemented)
 */
#ifdef XVIDEO
# include <X11/extensions/Xv.h>
#endif

/*
 * PEX extension - if available
 */
#ifdef PEX5
# include <PEX5/PEX.h>
#endif

/*
 * XImage extension - if available
 */
#ifdef XIE
# include <X11/extensions/XIE.h>
#endif

/*
 * when I have more time to check it out, I will support display-PS
 */
#ifdef DPS
# ifdef sgi
#  include <X11/extensions/XDPS.h>
#  include <X11/extensions/XDPSlib.h>
#  include <X11/extensions/dpsXclient.h>
# else
#  include <DPS/XDPS.h>
#  include <DPS/XDPSlib.h>
#  include <DPS/dpsXclient.h>
# endif
#endif

#if defined(IRIX5) || (XlibSpecificationRelease == 6)
  /*
   * accessing private data in Display ... sorry
   */
# define DISPLAYACCESS(d) ((_XPrivDisplay)d)
#else
# define DISPLAYACCESS(d) d
#endif

/*
 * some defines - tired of typing ...
 */
#define _DisplayVal(o)       (Display *)(__MKCP(o))
#define _WindowVal(o)        (Window)(__MKCP(o))
#define _PixmapVal(o)        (Pixmap)(__MKCP(o))
#define _GCVal(o)            (GC)(__MKCP(o))
#define _CursorVal(o)        (Cursor)(__MKCP(o))
#define _FontVal(o)          (XFontStruct *)(__MKCP(o))
#define _DPSContextVal(o)    (DPSContext)(__MKCP(o))

#define __MKATOMOBJ(a)       __MKSMALLINT(a)
#define _AtomVal(o)          __intVal(o)
#define __isAtomID(o)        __isSmallInteger(o)

#define myDpy                _DisplayVal(__INST(displayId))
#define ISCONNECTED          (__INST(displayId) != nil)

#ifndef THISCONTEXT_IN_REGISTER

# define BEGIN_INTERRUPTSBLOCKED /* */
# define END_INTERRUPTSBLOCKED /* */

#else

# define BEGIN_INTERRUPTSBLOCKED        \
    {                                   \
	int needUnblock = 0;            \
					\
	__BEGIN_PROTECT_REGISTERS__     \
	if (!__interruptsBlocked) {     \
	    __BLOCKINTERRUPTS();        \
	    needUnblock = 1;            \
	}

# define END_INTERRUPTSBLOCKED_NOW      \
	__END_PROTECT_REGISTERS__       \
	if (needUnblock) {              \
	    __UNBLOCKINTERRUPTS();      \
	}                               \
    }

# define END_INTERRUPTSBLOCKED          \
	__END_PROTECT_REGISTERS__

#endif
%}
! !

!XWorkstation primitiveVariables!
%{
/*
 * remembered info from private error handler
 */
static char lastErrorMsg[80] = "";
static unsigned lastRequestCode = 0;
static unsigned lastMinorCode = 0;
static unsigned lastResource = 0;

static int __debug__ = 0;
#define DPRINTF(x)      if (__debug__) { printf x; }
%}
! !

!XWorkstation primitiveFunctions!
%{

/*
 * some systems need a dummy reference to force the linker
 * to include that stuff. Should be #ifdef'd ...
 */
#ifndef ELF

# ifdef __GNUC__
VOLATILE 
# endif
static
dummyToForceLoading() {
	XCreateSimpleWindow(0, 0, 0, 0, 0, 0, 0, 0, 0);
	XCloseDisplay(0);
	XCreateImage(0, 0, 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0);
	XSetWindowColormap(0, 0, 0);
	XQueryColors(0,0,0,0);
# ifdef SHM
	XShmAttach(0, 0);
	XShmCreateImage(0, 0, 0, 0, 0, 0, 0 ,0);
	XShmDetach(0, 0);
	XShmPutImage(0, 0, 0, 0 , 0,0,0,0,0,0,0);
	shmctl(0,0,0);
	fgetc(0);
# endif
}
#endif

/*
 * catch X-errors and forward as errorInterrupt:#DisplayError,
 * (which itself invokes my handler and optionally raises an exceptionSignal)
 * the implementation below is somewhat wrong: it will
 * report all errors for Display, even though there could be
 * more than one display connection. (being fixed, new errorInterrupt mechanism
 * allows passing an additional argument, which is the displayID ...)
 */

__XErrorHandler__(dpy, event)
    Display *dpy;
    XErrorEvent *event;
{
    XGetErrorText(dpy, event->error_code, lastErrorMsg, 79);
    lastErrorMsg[79] = '\0';

    if (lastErrorMsg[0] == '\0') {
	sprintf(lastErrorMsg, "code: %d", event->error_code);
    }
    lastRequestCode = event->request_code;
    lastMinorCode = event->minor_code;
    lastResource = event->resourceid;
    if ((event->error_code == BadWindow) && (lastRequestCode == 4) && (lastMinorCode == 0)) {
	/* 
	 * this is a BadWindow error for X_DestroyWindow.
	 * ignore it here, since it results from the GC freeing windows
	 * in non bottom-up window order.
	 */
	return 0;
    }

    if (@global(ErrorPrinting) == true) {
	fprintf(stderr, "XWorkstation [error]: x-error cought maj=%d (0x%x) min=%d (0x%x) resource=%x\n",
			event->request_code, event->request_code, 
			event->minor_code, event->minor_code, event->resourceid);
	fprintf(stderr, "XWorkstation [error]: x-error message is [%d] '%s'\n", event->error_code, lastErrorMsg);
    }

    __errorInterruptWithIDAndParameter__(@symbol(DisplayError), __MKOBJ(dpy));
    return 0;
}

/*
 * much like the above, but for IO Errors;
 * In single display apps, handling those here does not
 * really make sense (except, for a controlled cleanup).
 * However, in multiDisplay apps, a single broken
 * connection should not affect the other users.
 */
__XIOErrorHandler__(dpy)
    Display *dpy;
{
    if (@global(ErrorPrinting) == true) {
	fprintf(stderr, "XWorkstation [error]: I/O error\n");
    }
    __immediateErrorInterruptWithIDAndParameter__(@symbol(DisplayIOError), __MKOBJ(dpy));
    __internalError("unhandled display I/O error");
    __terminateProcess(0);      /* soft terminate */
    __terminateProcess(1);      /* hard terminate */
}

#ifdef VIRTUAL_ROOT
/*
 * added since RootWindow-macro is not sufficient
 * when virtual root-windows are involved (i.e. tvtwm)
 */
static Window
getRootWindow(dpy, screen)
    Display *dpy;
{
    Window root;
    Atom vRootAtom = None;
    int i;
    Window rootReturn, parentReturn;
    Window* children = (Window *)0;
    unsigned int numChildren;

    root = RootWindow(dpy, screen);
    /*
     * on IRIS, this creates a badwindow error - why ?
     * children contains a funny window (000034)
     */
# if !defined(IRIS) || defined(IRIX5)
    if (XQueryTree(dpy, root, &rootReturn, &parentReturn, &children, &numChildren)) {
	vRootAtom = XInternAtom(dpy, "__SWM_VROOT", True );
	if (vRootAtom != None) {
	    for (i=0; i < numChildren; i++) {
		Atom actual_type;
		int actual_format;
		unsigned long nitems, bytesafter;
		Window* newRoot = (Window*) 0;

		if (children[i]) {
		    if (XGetWindowProperty(dpy, children[i], vRootAtom,
					   0L, 1L, False, XA_WINDOW,
					   &actual_type, &actual_format, &nitems, &bytesafter,
					   (unsigned char**) &newRoot) == Success && newRoot) {
			root = *newRoot;
			XFree(newRoot); /* XXX */
			break;
		    }
		}
	    }
	}
	if (children) XFree( children );
    }
# endif
    return root;
}
#endif
%}
! !

!XWorkstation class methodsFor:'documentation'!

copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
	      All Rights Reserved

 This software is furnished under a license and may be used
 only in accordance with the terms of that license and with the
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 other person.  No title to or ownership of the software is
 hereby transferred.
"
!

documentation
"
    this class provides the interface to X11. It redefines all required methods
    from DeviceWorkstation. Notice, that in Smalltalk/X you are not technically
    limited to one display - in theory, you can create Views on many displays
    simultanously. However, the default setup is for one display only.
    To support multiple displays, you will have to start another event dispatcher
    process for the other display(s) and create the other views with a slightly
    different protocol. However, 'normal' applications do not have to care for
    all of this ...

    See more documentation in my superclass, DeviceWorkstation.

    [author:]
	Claus Gittinger
"
! !

!XWorkstation class methodsFor:'initialization'!

initialize
    |d|

    super initialize.

    RawKeysymTranslation isNil ifTrue:[
	"/ the following table maps X-keyevents to ST/X
	"/ device independed events. 
	"/ It is NOT meant as a keyboardMap replacement.

	RawKeysymTranslation := d := Dictionary new.
	d at:'Delete_line' put:#DeleteLine.
	d at:'Delete_word' put:#DeleteWord.
	d at:'Down' put:#CursorDown.
	d at:'Up' put:#CursorUp.
	d at:'Left' put:#CursorLeft.
	d at:'Right' put:#CursorRight.
    ]
! !

!XWorkstation class methodsFor:'error handling'!

debug:aBoolean
%{  /* NOCONTEXT */

    __debug__ = (aBoolean == true) ? 1 : 0;
%}
!

debugResources
%{
#ifdef COUNT_RESOURCES
    printf("colors:%d bitmaps:%d views:%d gc:%d cursors:%d fonts:%d\n",
	    __cnt_color, __cnt_bitmap,
	    __cnt_view, __cnt_gc, __cnt_cursor, __cnt_font);
#endif
%}

    "
     XWorkstation debugResources
    "
!

errorStringOfLastError
%{
    RETURN ( __MKSTRING(lastErrorMsg) );
%}
!

lastErrorString
    "return the last X-error string - 
     when buffering is on, this may be
     an error for a long-ago operation"

    |string requestCode s match line|

    string := self errorStringOfLastError.
    requestCode := self requestCodeOfLastError.
    "
     X specific: search the requestCode in '/usr/lib/X11/XErrorDB',
     and append the name of the corresponding X-request
    "
    s := '/usr/lib/X11/XErrorDB' asFilename readStream.
    s notNil ifTrue:[
	match := 'XRequest.' , requestCode printString.
	line := s peekForLineStartingWith:match.
	line notNil ifTrue:[
	    string := string , ' in ' , (line copyFrom:(line indexOf:$:)+1)
	].
	s close.
    ].
    ^ string
!

minorCodeOfLastError
%{  /* NOCONTEXT */

    RETURN ( __MKSMALLINT(lastMinorCode) );
%}
!

requestCodeOfLastError
%{  /* NOCONTEXT */

    RETURN ( __MKSMALLINT(lastRequestCode) );
%}
!

resourceIdOfLastError
%{  /* NOCONTEXT */

    RETURN ( __MKOBJ(lastResource) );
%}
! !

!XWorkstation class methodsFor:'queries'!

platformName
    "ST-80 compatibility.
     Return a string describing the display systems platform."

    ^ 'X11'  "I don't know what ST-80 returns for X ..."

    "Modified: 26.5.1996 / 15:32:46 / cg"
! !

!XWorkstation methodsFor:'Signal constants'!

deviceErrorSignal
    "return the per-device signal, which is raised when some
     X-Error occurs."

    ^ deviceErrorSignal
!

deviceIOrrorSignal
    "return the per-device signal, which is raised when a fatal
    IO error (i.e. broken connection) occurs."

    ^ deviceIOErrorSignal
! !

!XWorkstation methodsFor:'accessing & queries'!

anyButtonMotionMask
    "return the state-mask for any button in motion events' state-field.
     This is the devices mask."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(Button1MotionMask | Button2MotionMask | Button3MotionMask));
%}.
    ^ nil
!

blackpixel
    "return the colornumber of black"

    ^ blackpixel
!

button1MotionMask
    "return the state-mask for button1 in motion events' state-field.
     For backward compatibility."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(Button1MotionMask));
%}

    "
     Display button1MotionMask
    "
!

button2MotionMask
    "return the state-mask for button2 in motion events' state-field
     For backward compatibility."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(Button2MotionMask));
%}
!

button3MotionMask
    "return the state-mask for button3 in motion events' state-field
     For backward compatibility."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(Button3MotionMask));
%}
!

buttonMotionMask:aButton
    "return the state-mask for button1 in motion events state-field.
     This is the devices mask."

%{  /* NOCONTEXT */
    if (aButton == __MKSMALLINT(1)) {
	RETURN (__MKSMALLINT(Button1MotionMask));
    }
    if (aButton == __MKSMALLINT(2)) {
	RETURN (__MKSMALLINT(Button2MotionMask));
    }
    if (aButton == __MKSMALLINT(3)) {
	RETURN (__MKSMALLINT(Button3MotionMask));
    }
%}.
    ^ nil
!

controlMask
    "return the state-mask for the CTRL modified in motion events' state-field."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(ControlMask));
%}
!

defaultEventMask
    "return a mask to enable some events by default."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT( ExposureMask | StructureNotifyMask |
			 KeyPressMask | KeyReleaseMask |
			 EnterWindowMask | LeaveWindowMask |
			 ButtonPressMask | ButtonMotionMask | ButtonReleaseMask ));
%}
!

displayFileDescriptor
    "return the displays fileNumber - for select"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	RETURN ( __MKSMALLINT(ConnectionNumber(myDpy)) );
    }
    RETURN (nil);
%}
!

displayName
    "return the X-connections display name.
     This is (currently) nil for the default display, 
     something like foo:0 for any other remote display.
     Future versions may return non-nil strings for the default display as well."

    ^ displayName
!

protocolVersion
    "return the X-servers protocol version - should normally not be of
     any interest"

%{  /* NOCONTEXT */
    if (ISCONNECTED) {
	RETURN ( __MKSMALLINT(XProtocolVersion(myDpy)) );
    }
    RETURN (nil);
%}

    "
     Display protocolVersion
    "
!

serverVendor
    "return the X-server vendor string - this should normally not be of
     any interest, but can be for special cases
     (to avoid bugs in certain implementations)"
%{
    if (ISCONNECTED) {
	RETURN ( __MKSTRING(XServerVendor(myDpy)) );
    }
    RETURN (nil);
%}

    "
     Display serverVendor
    "
!

shiftMask
    "return the state-mask for the SHIFT modified in motion events' state-field."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(ShiftMask));
%}
!

translatePoint:aPoint from:windowId1 to:windowId2
    "given a point in window1, return the coordinate in window2.
     This expects a device coordinate (relative to the first views origin)
     in aPoint and returns a device coordinate relative to the 2nd views origin.
     - use to xlate points from a window to rootwindow"

    |x1 y1 x2 y2|

    x1 := x2 := aPoint x truncated.
    y1 := y2 := aPoint y truncated.
%{
    int xpos, ypos;
    Window w1, w2, child_return;
    int screen = __intVal(__INST(screen));

    if (ISCONNECTED
     && __isExternalAddress(windowId1)
     && __isExternalAddress(windowId2)
     && __bothSmallInteger(x1, y1)) {
	Display *dpy = myDpy;

	w1 = _WindowVal(windowId1);
	w2 = _WindowVal(windowId2);
#ifdef VIRTUAL_ROOT
	if ((w1 == RootWindow(dpy, screen))
	 || (w2 == RootWindow(dpy, screen))) {
	    if (w1 == RootWindow(dpy, screen)) {
		w1 = getRootWindow(dpy, screen);
	    }
	    if (w2 == RootWindow(dpy, screen)) {
		w2 = getRootWindow(dpy, screen);
	    }
	}
#endif
	BEGIN_INTERRUPTSBLOCKED
	XTranslateCoordinates(dpy, w1, w2,
			      __intVal(x1), __intVal(y1), 
			      &xpos, &ypos, &child_return);
	END_INTERRUPTSBLOCKED
	x2 = __MKSMALLINT(xpos);
	y2 = __MKSMALLINT(ypos);
    }
%}.

    ^ (x2 @ y2)
!

vendorRelease
    "return the X-servers vendor release - should normally not be of
     any interest, but can be for special cases.
     (to avoid bugs in certain implementations)"

%{  /* NOCONTEXT */
    if (ISCONNECTED) {
	RETURN ( __MKSMALLINT(XVendorRelease(myDpy)) );
    }
    RETURN (nil);
%}

    "
     Display vendorRelease
    "
!

viewIdFromPoint:aPoint in:windowId
    "given a point in rootWindow, return the viewId of the subview of windowId
     hit by this coordinate. Return nil if no view was hit.
     The returned id may be the id of a non ST view.
     - used to find the window to drop objects after a cross-view drag."

%{  /* NOCONTEXT */

    int screen = __intVal(__INST(screen));
    OBJ xp, yp;
    int xpos, ypos;
    Window child_return;

    if (ISCONNECTED
     && __isExternalAddress(windowId)
     && __isPoint(aPoint)) {
	Display *dpy = myDpy;

	xp = _point_X(aPoint);
	yp = _point_Y(aPoint);
	if (__bothSmallInteger(xp, yp)) {
	    BEGIN_INTERRUPTSBLOCKED
	    XTranslateCoordinates(dpy,
				  RootWindow(dpy, screen),
				  _WindowVal(windowId),
				  __intVal(xp), __intVal(yp), 
				  &xpos, &ypos, &child_return);
	    END_INTERRUPTSBLOCKED
	    if (child_return) {
		RETURN ( __MKOBJ(child_return) );
	    }
	    RETURN ( nil );
	}
    }
%}.
    windowId notNil ifTrue:[
	aPoint isPoint ifTrue:[
	    ^ self viewIdFromPoint:aPoint asPoint truncated in:windowId
	]
    ].

    ^ nil
!

virtualExtent
    "return the virtual extent of the display (in pixels).
     On most systems, this is the same as the physical width;
     except, if a window manager with a virtual desktop like olvwm
     (simulating a bigger screen) is running."

%{
    if (ISCONNECTED
     && (__INST(rootId) != __INST(virtualRootId)) 
     && __isExternalAddress(__INST(virtualRootId))) {
	Window vRootWin;
	Window root;
	int x, y;
	unsigned int width, height;
	unsigned int dummy;

	vRootWin = _WindowVal(__INST(virtualRootId));
	if (XGetGeometry(myDpy, vRootWin, &root, &x, &y, &width, &height,
					  &dummy, &dummy)) {
	    RETURN ( __MKPOINT_INT(width, height) );
	}
    }
%}.
    ^ width @ height
!

whitepixel
    "return the colornumber of white"

    ^ whitepixel
! !

!XWorkstation methodsFor:'accessing display capabilities'!

hasDPS
    "return true, if this workstation supports display postscript.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasDPSExtension

    "
     Display hasDPS 
    "
!

hasExtension:extensionString
    "query for an X extension. The argument, extensionString
     should be the name of the extension (i.e. 'SHAPE', 'XInputExtension' etc).
     Return true, if that extension is available in the server.
     (which does not imply, that there is support in smalltalk for it."

%{
    int dummy;

    if (__isString(extensionString) && ISCONNECTED) {
	if (XQueryExtension(myDpy, __stringVal(extensionString), &dummy, &dummy, &dummy)) {
	    RETURN ( true );
	}
    }
%}.
    ^ false

    "
     Display hasExtension:'XVideo' 
     Display hasExtension:'Input' 
     Display hasExtension:'GLX' 
     Display hasExtension:'X3D-PEX' 
     Display hasExtension:'XInputExtension' 
     Display hasExtension:'SHAPE' 
     Display hasExtension:'MIT-SHM' 
     Display hasExtension:'SGIFullScreenStereo' 
    "
!

hasImageExtension
    "return true, if this workstation supports the X image extension.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasImageExtension

    "
     Display hasImageExtension 
    "
!

hasInputExtension
    "return true, if this workstation supports the X input extension.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasInputExtension

    "
     Display hasInputExtension 
    "
!

hasMultibuffer
    "return true, if this workstation supports the multibuffer extension.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasMbufExtension

    "
     Display hasMultibuffer 
    "
!

hasPEX
    "return true, if this workstation supports PEX 3D graphics.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasPEXExtension

    "
     Display hasPEX 
    "
!

hasShape
    "return true, if this workstation supports non-rectangular windows.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasShapeExtension

    "
     Display hasShape   
    "
!

hasShm
    "return true, if this workstation supports the shared pixmap extension.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasShmExtension

    "
     Display hasShm 
    "
!

hasXVideo
    "return true, if this workstation supports the XVideo extension.
     Both the server must support it, and the feature must have been
     enabled in the smalltalk system, for true to be returned."

    ^ hasXVideoExtension

    "
     Display hasXVideo 
    "
!

iconSizes
    "Get the preferred/supported icon sizes. These are set by the window manager.
     We return nil (if not set) or an OrderedCollection of iconSize specs."

    |xIconSizes count ret|

%{
    int screen = __intVal(__INST(screen));
    XIconSize *sizeList;
    int cnt;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (XGetIconSizes(myDpy, RootWindow(dpy, screen), &sizeList, &cnt) > 0) {
	   xIconSizes = __MKEXTERNALBYTES(sizeList);
	   count = __MKSMALLINT(cnt);
	}
    }
%}.
    xIconSizes isNil ifTrue:[^ nil].

    ret := OrderedCollection new:count.
    1 to:count do:[ :i |
	|minWidth minHeight maxWidth maxHeight widthStep heightStep d|

%{
	XIconSize *slp;

	slp = &((XIconSize *)__externalBytesAddress(xIconSizes))[__intVal(i)-1];
	minWidth = __MKSMALLINT(slp->min_width);
	minHeight = __MKSMALLINT(slp->min_height);
	maxWidth = __MKSMALLINT(slp->max_width);
	maxHeight = __MKSMALLINT(slp->max_height);
	widthStep = __MKSMALLINT(slp->width_inc);
	heightStep = __MKSMALLINT(slp->height_inc);
%}.
	d := IdentityDictionary new.
	d at:#minWidth put:minWidth.
	d at:#maxWidth put:maxWidth.
	d at:#widthStep put:widthStep.
	d at:#minHeight put:minHeight.
	d at:#maxHeight put:maxHeight.
	d at:#heightStep put:heightStep.

	ret add:d
    ].

    xIconSizes free.
    ^ ret

    "
     Display iconSizes
    "
!

ignoreBackingStore:aBoolean
    "if the argument is true, the views backingStore setting will be ignored, and
     no backing store used - this can be used on servers where backing store is
     very slow or is broken (can be put into display-rc-file)"

    ignoreBackingStore := aBoolean
!

preferredIconSize
    "return the displays preferred size for icons.
     Redefined to return a special value on SGI servers."

    self serverVendor = 'Silicon Graphics' ifTrue:[
	^ 86@68
    ].
    ^ super preferredIconSize

    "Created: 10.6.1996 / 21:06:48 / cg"
!

scrollsAsynchronous
    "return true, if this display asynchronously sends expose events after a
     scroll operation. False otherwise. Asynchronous expose events are an X
     speciality, which affects a few methods outside of the display class (sorry)"

    ^ true
!

supportedImageFormats
    "return an array with supported image formats; 
     each array entry is an attribute dictionary, consisting of 
     depth, bitsPerPixel and padding values."

    |nFormats "{ Class: SmallInteger }"
     formatArray|
%{
    Display *dpy;

    if (! ISCONNECTED) {
	RETURN (nil);
    }

    dpy = myDpy;
    nFormats = __MKSMALLINT(DISPLAYACCESS(dpy)->nformats);
%}.
    formatArray := Array new:nFormats.
    1 to:nFormats do:[:index |
	|info bitsPerPixelInfo depthInfo paddingInfo i|

	i := index.
%{
	ScreenFormat *format;
	Display *dpy = myDpy;

	format = DISPLAYACCESS(dpy)->pixmap_format;
	format += (__intVal(i)-1);
	bitsPerPixelInfo = __MKSMALLINT(format->bits_per_pixel);
	depthInfo = __MKSMALLINT(format->depth);
	paddingInfo = __MKSMALLINT(format->scanline_pad);
%}.
	info := IdentityDictionary new.
	info at:#depth put:depthInfo.
	info at:#bitsPerPixel put:bitsPerPixelInfo.
	info at:#padding put:paddingInfo.
	formatArray at:index put:info.
    ].
    ^ formatArray

    "
     Display supportedImageFormats 
    "
!

supportsIconViews
    "return true, if this device supports views as icons.
     Only Xservers (currently) support this."

    ^ true

    "
     Display supportsIconViews 
    "

    "Modified: 10.6.1996 / 20:11:48 / cg"
    "Created: 10.6.1996 / 21:08:18 / cg"
!

supportsViewGravity
    "return true, if this device supports gravity attributes.
     We do not depend on it being implemented, but some resizing operations
     are faster, it is is."

    ^ true
! !

!XWorkstation methodsFor:'bitmap/window creation'!

createBitmapFromArray:anArray width:w height:h
    |bitmapId|

    bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
    bitmapId isNil ifTrue:[
	self primitiveFailed
    ].
    ^ bitmapId
!

createBitmapFromFile:aString for:aForm
    |id w h|

%{
    int screen = __intVal(__INST(screen));
    Pixmap newBitmap;
    char *filename;
    unsigned b_width, b_height;
    int b_x_hot, b_y_hot;
    int status;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (__isString(aString) || __isSymbol(aString)) {
	    filename = (char *)_stringVal(aString);

	    BEGIN_INTERRUPTSBLOCKED
	    status = XReadBitmapFile(dpy, RootWindow(dpy, screen),
				     filename, &b_width, &b_height, &newBitmap,
				     &b_x_hot, &b_y_hot);
	    END_INTERRUPTSBLOCKED

	    if ((status == BitmapSuccess)  && newBitmap) {
#ifdef COUNT_RESOURCES
		__cnt_bitmap++;
#endif
		w = __MKSMALLINT(b_width);
		h = __MKSMALLINT(b_height);
		id = __MKOBJ(newBitmap);
	    }
	}
    }
%}.
    id notNil ifTrue:[
	aForm setWidth:w height:h
    ].
    ^ id
!

createBitmapWidth:w height:h
    "allocate a bitmap on the Xserver, the contents is undefined
     (i.e. random). Return a bitmap id or nil"

%{  /* NOCONTEXT */

    int screen = __intVal(__INST(screen));
    Pixmap newBitmap;

    if (__bothSmallInteger(w, h) && ISCONNECTED) {
	Display *dpy = myDpy;

	BEGIN_INTERRUPTSBLOCKED
	newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
				       __intVal(w), __intVal(h), 1);
#ifdef COUNT_RESOURCES
	if (newBitmap)
	    __cnt_bitmap++;
#endif
	END_INTERRUPTSBLOCKED
	RETURN ( (newBitmap != (Pixmap)0) ? __MKOBJ(newBitmap) : nil );
    }
%}
.
    self primitiveFailed.
    ^ nil
!

createPixmapWidth:w height:h depth:d
    "allocate a pixmap on the Xserver, the contents is undefined
     (i.e. random). Return a bitmap id or nil"

%{  /* NOCONTEXT */

    int screen = __intVal(__INST(screen));
    Pixmap newBitmap;

    if (__bothSmallInteger(w, h) && ISCONNECTED) {
	Display *dpy = myDpy;

	BEGIN_INTERRUPTSBLOCKED
	newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
				       __intVal(w), __intVal(h), __intVal(d));
#ifdef COUNT_RESOURCES
	if (newBitmap)
	    __cnt_bitmap++;
#endif
	END_INTERRUPTSBLOCKED
	RETURN ( (newBitmap != (Pixmap)0) ? __MKOBJ(newBitmap) : nil );
    }
%}.
    self primitiveFailed.
    ^ nil
!

createWindowFor:aView type:typeSymbol
		 origin:origin
		 extent:extent
		 minExtent:minExt 
		 maxExtent:maxExt
		 borderWidth:bWidth
		 subViewOf:wsuperView
		 style:wStyle
		 inputOnly:winputOnly
		 label:wlabel
		 cursor:wcursor
		 icon:wicon iconMask:wiconMask
		 iconView:wiconView

    |xpos ypos wwidth wheight minWidth minHeight maxWidth maxHeight 
     bColorId wsuperViewId wcursorId wiconId wiconMaskId windowId
     weventMask wiconViewId bitGravity viewGravity vBgColor
     vBgForm deepForm preferredVisual preferredDepth|

    displayId isNil ifTrue:[
	self primitiveFailed.
	^ nil
    ].

    origin notNil ifTrue:[
	xpos := origin x.
	ypos := origin y.
    ] ifFalse:[
	xpos := ypos := 0.
    ].
    extent notNil ifTrue:[
	wwidth := extent x.
	wheight := extent y.
    ] ifFalse:[
	wwidth := wheight := 100.
    ].
    minExt notNil ifTrue:[
	minWidth := minExt x.
	minHeight := minExt y
    ].
    maxExt notNil ifTrue:[
	maxWidth := maxExt x.
	maxHeight := maxExt y
    ].

    wsuperView notNil ifTrue:[
	wsuperViewId := wsuperView id
    ].
    wcursor isNil ifTrue:[
	'XWorkstation [info]: cursor nil - defaulted' infoPrintCR
    ] ifFalse:[
	wcursorId := wcursor id
    ].

    wicon notNil ifTrue:[
	wiconId := wicon id.
	wiconMask notNil ifTrue:[
	    wiconMaskId := wiconMask id
	]
    ].
    wiconView notNil ifTrue:[
	wiconViewId := wiconView id
    ].
    weventMask := aView eventMask.

    preferredVisual := aView preferredVisual.
    preferredDepth := aView preferredDepth.

%{  /* STACK:16000 */
    Display *dpy = myDpy;
    int screen = __intVal(__INST(screen));
    Visual visual;
    XGCValues xgcv;
    XSetWindowAttributes xswa;
    XSizeHints sizehints;
    XWMHints wmhints;
    int bw, bd, bg;
    Window newWindow, parentWindow;
    char *windowName;
    XFontStruct *f;
    Pixmap backPixmap = (Pixmap)0, 
	   iconBitmap = (Pixmap)0,
	   iconMask = (Pixmap)0;
    int flags = 0, depth, ioClass;
    Window iconWindow;
    Atom WmDeleteWindowAtom, WmSaveYourselfAtom, WmProtocolsAtom;
    Atom WmQuitAppAtom;
    Atom atoms[3];
    int atomCount = 0, isTopWindow = 0;

    sizehints.flags = 0;
    sizehints.width = 100;
    sizehints.height = 100;
    sizehints.x = 0;
    sizehints.y = 0;

    if (__bothSmallInteger(wwidth, wheight)) {
	sizehints.flags |= PSize;
	sizehints.width = __intVal(wwidth);
	sizehints.height = __intVal(wheight);
    }
    if (__bothSmallInteger(xpos, ypos)) {
	sizehints.flags |= PPosition;
	sizehints.x = __intVal(xpos);
	sizehints.y = __intVal(ypos);
    }
    if (__bothSmallInteger(minWidth, minHeight)) {
	sizehints.flags |= PMinSize;
	sizehints.min_width = __intVal(minWidth);
	sizehints.min_height = __intVal(minHeight);
    }
    if (__bothSmallInteger(maxWidth, maxHeight)) {
	sizehints.flags |= PMaxSize;
	sizehints.max_width = __intVal(maxWidth);
	sizehints.max_height = __intVal(maxHeight);
    }

    bg = WhitePixel(dpy, screen);

    if (__isSmallInteger(bWidth)) {
	bw = __intVal(bWidth);
    } else {
	bw = 0;
    }

    bd = BlackPixel(dpy, screen);

    if (__isExternalAddress(wsuperViewId)) {
	parentWindow = _WindowVal(wsuperViewId);
    } else {
	parentWindow = RootWindow(dpy, screen);
	isTopWindow = 1;
    }

    if (wStyle == @symbol(popUp))
	xswa.override_redirect = 1;
    else 
	xswa.override_redirect = 0;

    if (winputOnly == true) 
	ioClass = InputOnly;
    else 
	ioClass = InputOutput;

    if (__isSmallInteger(weventMask)) {
	xswa.event_mask = __intVal(weventMask);
    } else {
	xswa.event_mask = 0;
    }

    if (ioClass == InputOnly) {
	bw = 0;
	depth = 0;
	flags |= CWEventMask;
    } else {
	depth = DefaultDepth(dpy,screen);
	flags |= CWEventMask | CWBorderPixel | CWOverrideRedirect;

	if (backPixmap != (Pixmap)0) {
	    xswa.background_pixmap = backPixmap;
	    flags |= CWBackPixmap;
	} else {
	    xswa.background_pixel = bg;
	    flags |= CWBackPixel;
	}
	xswa.border_pixel = bd;
    }

    visual.visualid = CopyFromParent;
    if (__isSmallInteger(preferredDepth)) {
	depth = __intVal(preferredDepth);
    }

    BEGIN_INTERRUPTSBLOCKED
    if (preferredVisual != nil) {
	XVisualInfo vi;
	int cls;

	if (preferredVisual == @symbol(StaticGray))
	    cls = StaticGray;
	else if (preferredVisual == @symbol(GrayScale)) 
	    cls = GrayScale;
	else if (preferredVisual == @symbol(StaticColor)) 
	    cls = StaticColor;
	else if (preferredVisual == @symbol(PseudoColor)) 
	    cls = PseudoColor;
	else if (preferredVisual == @symbol(TrueColor)) 
	    cls = TrueColor;
	else if (preferredVisual == @symbol(DirectColor)) 
	    cls = DirectColor;
	else
	    cls = PseudoColor;

	if (XMatchVisualInfo(dpy, screen, depth, cls, &vi)) {
	    visual.visualid = vi.visualid;
/*
	    printf("visualId=%x\n", vi.visualid);
*/
	}
    }

    newWindow = XCreateWindow(dpy, parentWindow,
			   sizehints.x, sizehints.y,
			   sizehints.width, sizehints.height,
			   bw, depth, ioClass, &visual,
			   flags, &xswa);
    END_INTERRUPTSBLOCKED

    if (! newWindow) {
	RETURN ( nil );
    }

#ifdef COUNT_RESOURCES
    __cnt_view++;
#endif

    BEGIN_INTERRUPTSBLOCKED
    /*
     * define its cursor
     */
    if (__isExternalAddress(wcursorId)) {
	XDefineCursor(dpy, newWindow, _CursorVal(wcursorId));
    }

    /*
     * define its icon and name
     * (only makes sense for topWindows)
     */
    if (isTopWindow) {
	if (__isExternalAddress(wiconId))
	    iconBitmap = _PixmapVal(wiconId);
	else
	    iconBitmap = (Pixmap)0;

	if (__isExternalAddress(wiconMaskId))
	    iconMask = _PixmapVal(wiconMaskId);
	else
	    iconMask = (Pixmap)0;

	if (__isExternalAddress(wiconViewId))
	    iconWindow = _WindowVal(wiconViewId);
	else
	    iconWindow = (Window)0;

	if (__isString(wlabel) || __isSymbol(wlabel))
	    windowName = (char *)_stringVal(wlabel);
	else
	    windowName = "";

	if (iconBitmap || windowName) {
	    XSetStandardProperties(dpy, newWindow,
					windowName, windowName,
					iconBitmap,
					0, 0, &sizehints);

	}

	wmhints.flags = 0;
	if (iconBitmap) {
	    wmhints.flags |= IconPixmapHint;
	    wmhints.icon_pixmap = iconBitmap;
	}
	if (iconMask) {
	    wmhints.flags |= IconMaskHint;
	    wmhints.icon_mask = iconMask;
	}
	if (iconWindow) {
	    wmhints.flags |= IconWindowHint;
	    wmhints.icon_window = iconWindow;
	}
/*
	wmhints.flags |= InputHint;
	wmhints.input = True;
*/
	XSetWMHints(dpy, newWindow, &wmhints);

	/*
	 * tell window manager to not kill us but send an event instead
	 */
	/*
	 * get atoms first (if not already known)
	 */
	if (__INST(protocolsAtom) == nil) {
	    WmProtocolsAtom = XInternAtom(dpy, "WM_PROTOCOLS", False);
	    __INST(protocolsAtom) = __MKATOMOBJ(WmProtocolsAtom);
#ifdef USE_SAVEYOURSELF_ATOM
	    WmSaveYourselfAtom = XInternAtom(dpy, "WM_SAVE_YOURSELF", False);
	    __INST(saveYourselfAtom) = __MKATOMOBJ(WmSaveYourselfAtom);
#endif
#ifdef USE_QUIT_APP_ATOM
	    WmQuitAppAtom = XInternAtom(dpy, "_WM_QUIT_APP", False);
	    __INST(quitAppAtom) = __MKATOMOBJ(WmQuitAppAtom);
#endif
	    WmDeleteWindowAtom = XInternAtom(dpy, "WM_DELETE_WINDOW", False);
	    __INST(deleteWindowAtom) = __MKATOMOBJ(WmDeleteWindowAtom);
	} else {
#ifdef USE_QUIT_APP_ATOM
	    WmQuitAppAtom = _AtomVal(__INST(quitAppAtom));
#else
	    WmQuitAppAtom = 0;
#endif
	    WmProtocolsAtom = _AtomVal(__INST(protocolsAtom));
	    WmDeleteWindowAtom = _AtomVal(__INST(deleteWindowAtom));
#ifdef USE_SAVEYOURSELF_ATOM
	    WmSaveYourselfAtom = _AtomVal(__INST(saveYourselfAtom));
#else
	    WmSaveYourselfAtom = 0;
#endif
	}

	atoms[0] = WmDeleteWindowAtom; atomCount++;
#ifdef USE_SAVEYOURSELF_ATOM
	atoms[atomCount] = WmSaveYourselfAtom; atomCount++;
#endif
#ifdef USE_QUIT_APP_ATOM
	atoms[atomCount] = WmQuitAppAtom; atomCount++;
#endif
	XChangeProperty(dpy, newWindow, WmProtocolsAtom, XA_ATOM,
			32, PropModeReplace, (unsigned char *)atoms, atomCount);
    }

    END_INTERRUPTSBLOCKED

    windowId = __MKOBJ(newWindow);
%}.
    self addKnownView:aView withId:windowId.
    ^ windowId
!

destroyGC:aGCId

%{  /* NOCONTEXT */

    if (! ISCONNECTED) {
	RETURN ( self );
    }

    if (__isExternalAddress(aGCId)) {
	GC gc = _GCVal(aGCId);

	if (gc) {
	    BEGIN_INTERRUPTSBLOCKED
	    XFreeGC(myDpy, gc);
#ifdef COUNT_RESOURCES
	    __cnt_gc--;
#endif
	    END_INTERRUPTSBLOCKED
	}
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

destroyPixmap:aDrawableId

%{  /* NOCONTEXT */

    if (! ISCONNECTED) {
	RETURN ( self );
    }

    if (__isExternalAddress(aDrawableId)) {
	Pixmap pix = _PixmapVal(aDrawableId);

	if (pix) {
	    BEGIN_INTERRUPTSBLOCKED
	    XFreePixmap(myDpy, pix);
#ifdef COUNT_RESOURCES
	    __cnt_bitmap--;
#endif
	    END_INTERRUPTSBLOCKED
	}
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

destroyView:aView withId:aWindowId
%{
    if (! ISCONNECTED) {
	RETURN ( self );
    }

    if (__isExternalAddress(aWindowId)) {
	Window win = _WindowVal(aWindowId);

	if (win) {
	    BEGIN_INTERRUPTSBLOCKED
	    XDestroyWindow(myDpy, win);
#ifdef COUNT_RESOURCES
	    __cnt_view--;
#endif
	    END_INTERRUPTSBLOCKED
	}
    }
%}.
    self removeKnownView:aView withId:aWindowId
!

dpsContextFor:aDrawableId and:aGCId

%{  /* NOCONTEXT */
#ifdef XXDPS
    int screen = __intVal(__INST(screen));
    DPSContext dps;
    int height;

    if (__isExternalAddress(aDrawableId)
     && __isExternalAddress(aGCId)
     && ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	dps = XDPSCreateContext(myDpy, (Drawable)_WindowVal(aDrawableId),
				       _GCVal(aGCId),
				       0, height, 0, colormap, NULL, 0,
				       XDPSDefaultTextBackstop,
				       XDPSDefaultErrorProc,
				       NULL);
	END_INTERRUPTSBLOCKED
	RETURN ( dps ? __MKOBJ(dps) : nil );
    }
#endif
%}
.
    self primitiveFailed.
    ^ nil
!

gcFor:aDrawableId

%{  /* NOCONTEXT */
    int screen = __intVal(__INST(screen));
    GC gc;

    if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	gc = XCreateGC(myDpy, (Drawable)_WindowVal(aDrawableId),
			      0L, (XGCValues *)0);

#ifdef COUNT_RESOURCES
	if (gc)
	    __cnt_gc++;
#endif

	END_INTERRUPTSBLOCKED
	RETURN ( gc ? __MKOBJ(gc) : nil );
    }
%}.
    self primitiveFailed.
    ^ nil
!

gcForBitmap:aDrawableId
    "with X, this is the same as a normal gc"

%{  /* NOCONTEXT */
    int screen = __intVal(__INST(screen));
    GC gc;

    if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	gc = XCreateGC(myDpy, (Drawable)_WindowVal(aDrawableId),
			      0L, (XGCValues *)0);

#ifdef COUNT_RESOURCES
	if (gc)
	    __cnt_gc++;
#endif

	END_INTERRUPTSBLOCKED
	RETURN ( gc ? __MKOBJ(gc) : nil );
    }
%}.
    self primitiveFailed.
    ^ nil
!

primCreateBitmapFromArray:anArray width:w height:h

%{  /* UNLIMITEDSTACK */

    Display *dpy;
    int screen = __intVal(__INST(screen));
    Pixmap newBitmap;
    unsigned int b_width, b_height;
    REGISTER unsigned char *cp;
    REGISTER unsigned char *pBits;
    unsigned char *b_bits, *allocatedBits;
    int index, row;
    REGISTER int col;
    unsigned bits;
    static char reverseBitTable[256];
    static firstCall = 1;
    int nBytes;
    unsigned char fastBits[10000];
    OBJ num, *op;
    int bytesPerRow;

    if (! ISCONNECTED) {
	RETURN (nil);
    }

    dpy = myDpy;
    if (firstCall) {
	for (index=0; index < 256; index++) {
	    reverseBitTable[index] = 0;
	    if (index & 128) reverseBitTable[index] |=   1;
	    if (index &  64) reverseBitTable[index] |=   2;
	    if (index &  32) reverseBitTable[index] |=   4;
	    if (index &  16) reverseBitTable[index] |=   8;
	    if (index &   8) reverseBitTable[index] |=  16;
	    if (index &   4) reverseBitTable[index] |=  32;
	    if (index &   2) reverseBitTable[index] |=  64;
	    if (index &   1) reverseBitTable[index] |= 128;
	}
	firstCall = 0;
    }

    if (__bothSmallInteger(w, h) && _isNonNilObject(anArray)) {
	newBitmap = (Pixmap)0;
	b_width = __intVal(w);
	b_height = __intVal(h);
	bytesPerRow = (b_width + 7) / 8;
	nBytes = b_height * bytesPerRow;
	if (nBytes < sizeof(fastBits)) {
	    cp = b_bits = fastBits;
	    allocatedBits = 0;
	} else {
	    cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
	    if (! cp) goto fail;
	}

	if (__qClass(anArray) == @global(Array)) {
	    index = 1;
	    op = &(__ArrayInstPtr(anArray)->a_element[index - 1]);
	    for (row = b_height; row; row--) {
		for (col = bytesPerRow; col; col--) {
		    num = *op++;
		    if (! __isSmallInteger(num)) goto fail;
		    bits = __intVal(num);
		    *cp++ = reverseBitTable[bits];
		}
	    }
	} else {
	    if (__qClass(anArray) == @global(ByteArray)) {
		pBits = __ByteArrayInstPtr(anArray)->ba_element;
		for (col = b_height*bytesPerRow; col; col--) {
		    *cp++ = reverseBitTable[*pBits++];
		}
	    } else {
		goto fail;
	    }
	}

	BEGIN_INTERRUPTSBLOCKED
	newBitmap = XCreateBitmapFromData(dpy, RootWindow(dpy, screen),
					       (char *)b_bits, 
					       b_width, b_height);
#ifdef COUNT_RESOURCES
	if (newBitmap)
	    __cnt_bitmap++;
#endif

	END_INTERRUPTSBLOCKED
fail: ;
	if (allocatedBits)
	    free(allocatedBits);
	RETURN ( newBitmap ? __MKOBJ(newBitmap) : nil );
    }
%}
!

realRootWindowFor:aView
    "the name of this method is historic;
     - it will vanish"

    |id|

    id := self realRootWindowId.
    self addKnownView:aView withId:id.
    ^ id
!

realRootWindowId
    "return the id of the real root window.
     This may not be the window you see as background,
     since some window managers install a virtual root window on top
     of it. Except for very special cases, use #rootWindowId, which takes
     care of any virtual root."

%{
    int screen = __intVal(__INST(screen));
    Window root;
    OBJ id;

    if (__INST(rootId) != nil) {
	RETURN (__INST(rootId));
    }

    if (ISCONNECTED) {
	root = RootWindow(myDpy, screen);
	if (! root) {
	    id = nil;
	} else {
	    __INST(rootId) = id = __MKOBJ(root); __STORE(self, id);
	}
	RETURN (id);
    }
%}.
    self primitiveFailed
!

rootWindowFor:aView
    |id|

    id := self rootWindowId.
    self addKnownView:aView withId:id.
    ^ id
!

rootWindowId
    "return the id of the root window.
     This is the window you see as background, 
     however, it may or may not be the real physical root window,
     since some window managers install a virtual root window on top
     of the real one. If this is the case, that views id is returned here."

%{
    int screen = __intVal(__INST(screen));
    Window rootWin, vRootWin;
    OBJ id;

    if (__INST(virtualRootId) != nil) {
	RETURN (__INST(virtualRootId));
    }

    if (ISCONNECTED) {
	vRootWin = rootWin = RootWindow(myDpy, screen);
#ifndef IRIS
	BEGIN_INTERRUPTSBLOCKED
	/*
	 * on IRIS, this creates a badwindow error - why ?
	 * children contains a funny window (000034)
	 */

	/*
	 * care for virtual root windows (tvtwm & friends)
	 */
	{
	    Atom vRootAtom = None;
	    int i;
	    Window rootReturn, parentReturn;
	    Window* children = (Window *)0;
	    unsigned int numChildren;

	    if (XQueryTree(myDpy, rootWin, 
			   &rootReturn, &parentReturn, 
			   &children, &numChildren)) {
		vRootAtom = XInternAtom(myDpy, "__SWM_VROOT", True );
		if (vRootAtom != None) {
		    for (i=0; i < numChildren; i++) {
			Atom actual_type;
			int actual_format;
			unsigned long nitems, bytesafter;
			Window* newRoot = (Window*) 0;

			if (children[i]) {
			    if (XGetWindowProperty(myDpy, children[i], vRootAtom, 
						     0L, 1L, False, XA_WINDOW,
						     &actual_type, &actual_format, 
						     &nitems, &bytesafter,
						     (unsigned char**) &newRoot
						   ) == Success && newRoot) {
				vRootWin = *newRoot;
				XFree(newRoot); /* XXX */
				break;
			    }
			}
		    }
		}
		if (children) XFree( children );
	    }
	}
	END_INTERRUPTSBLOCKED
#endif
    }

    /* cannot happen */
    if (! vRootWin) {
	vRootWin = rootWin;
	if (! rootWin) {
	    RETURN ( nil );
	}
    }
    __INST(rootId) = id = __MKOBJ(rootWin); __STORE(self, id);
    __INST(virtualRootId) = id = __MKOBJ(vRootWin); __STORE(self, id);
    RETURN ( id );
%}
! !

!XWorkstation methodsFor:'color stuff'!

colorCell
    "allocate a color cell - return the color index (i.e. colorID).
     This method will return nil for StaticGrey, StaticGrey and TrueColor displays."

%{  /* NOCONTEXT */

    int screen = __intVal(__INST(screen));
    XColor color;
    unsigned long dummy;
    Status ok;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	BEGIN_INTERRUPTSBLOCKED
	ok = XAllocColorCells(dpy, DefaultColormap(dpy, screen), (Bool)0,
				   &dummy, 0, &color.pixel, 1);
	END_INTERRUPTSBLOCKED
	if (ok) {
#ifdef COUNT_RESOURCES
	    __cnt_color++;
#endif
	    RETURN ( __MKSMALLINT(color.pixel) );
	}
    }
%}.
    ^ nil
!

colorNamed:aString
    "allocate a color with color name - return the color index (i.e. colorID).
     Dont use this method, colornames are mostly X specific"

%{  /* NOCONTEXT */

    char *colorname;
    XColor scolor, ecolor;
    int screen = __intVal(__INST(screen));
    int id;
    Status ok;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (__isString(aString) || __isSymbol(aString)) {
	    colorname = (char *)_stringVal(aString);

	    BEGIN_INTERRUPTSBLOCKED
	    ok = XParseColor(dpy, DefaultColormap(dpy, screen), colorname, &ecolor);
	    if (ok) {
#ifdef QUICK_TRUE_COLORS
		if (__INST(visualType) == @symbol(TrueColor)) {
		    id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
		    id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
		    id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
		    RETURN ( __MKSMALLINT(id) );
		}
#endif
		ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
	    }
	    END_INTERRUPTSBLOCKED
	    if (! ok) {
		RETURN ( nil );
	    }
#ifdef COUNT_RESOURCES
	    __cnt_color++;
#endif
	    RETURN ( __MKSMALLINT(ecolor.pixel) );
	}
    }
%}.
    self primitiveFailed.
    ^ nil
!

colorRed:redVal green:greenVal blue:blueVal
    "allocate a color with rgb values (0..100) - return the color index (i.e. colorID).
     This method is obsoleted by #colorScaledRed:scaledGreen:scaledBlue:"

    |r g b|

    r := self percentToXColorValue:redVal.
    g := self percentToXColorValue:greenVal.
    b := self percentToXColorValue:blueVal.
    ^ self colorScaledRed:r scaledGreen:g scaledBlue:b
!

colorScaledRed:r scaledGreen:g scaledBlue:b
    "allocate a color with rgb values (0..16rFFFF) - return the color index (i.e. colorID)"
%{
    Display *dpy;
    XColor ecolor;
    int screen = __intVal(__INST(screen));
    Status ok;
    int id;

    if (__bothSmallInteger(r, g) 
     && __isSmallInteger(b)
     && ISCONNECTED) {
	ecolor.red = __intVal(r);
	ecolor.green= __intVal(g);
	ecolor.blue = __intVal(b);
#ifdef QUICK_TRUE_COLORS
	if (__INST(visualType) == @symbol(TrueColor)) {
	    id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
	    id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
	    id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
	    RETURN ( __MKSMALLINT(id) );
	}
#endif
	dpy = myDpy;
	BEGIN_INTERRUPTSBLOCKED
	ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
	END_INTERRUPTSBLOCKED
	if (! ok) {
	    RETURN ( nil );
	}
#ifdef COUNT_RESOURCES
	__cnt_color++;
#endif
	RETURN ( __MKSMALLINT(ecolor.pixel) );
    }
%}.
    self primitiveFailed.
    ^ nil
!

freeColor:colorIndex
    "free a display color when its no longer needed"

%{  /* NOCONTEXT */

    Display *dpy;
    unsigned long color;
    int screen = __intVal(__INST(screen));

#ifdef QUICK_TRUE_COLORS
    if (__INST(visualType) == @symbol(TrueColor)) {
	/* no need to do anything on TrueColor displays ... */
	RETURN (self);
    }
#endif

    if (! ISCONNECTED) {
	RETURN (self);
    }

    if (__isSmallInteger(colorIndex)) {
	dpy = myDpy;
	color = (long) __intVal(colorIndex);
	BEGIN_INTERRUPTSBLOCKED
	XFreeColors(dpy, DefaultColormap(dpy, screen), &color, 1, 0L);
#ifdef COUNT_RESOURCES
	__cnt_color--;
#endif
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

getRGBFrom:index into:aBlock
    "get rgb components (0..100) of color in map at:index,
     and evaluate the 3-arg block, aBlock with them"

    |val|

    self getScaledRGBFrom:index into:[:r :g :b |
	val := aBlock 
		value:(r * 100.0 / 16rFFFF)
		value:(g * 100.0 / 16rFFFF)
		value:(b * 100.0 / 16rFFFF)
    ].
    ^ val
!

getRGBFromName:colorName into:aBlock
    "get rgb components (0..100) of color named colorName,
     and evaluate the 3-arg block, aBlock with them"
    |val|

    self getScaledRGBFromName:colorName into:[:r :g :b |
	r isNil ifTrue:[
	    ^ nil
	].
	val := aBlock 
	    value:(r * 100.0 / 16rFFFF)
	    value:(g * 100.0 / 16rFFFF)
	    value:(b * 100.0 / 16rFFFF)
    ].
    ^ val

    "Modified: 6.3.1997 / 02:36:43 / cg"
!

getScaledRGBFrom:index into:aBlock
    "get rgb components (0 .. 16rFFFF) of color in map at:index,
     and evaluate the 3-arg block, aBlock with them"

    |r g b|
%{
    int screen = __intVal(__INST(screen));
    XColor color;
    int sr, sg, sb;
    int bits, scale, shift;

    if (ISCONNECTED
     && __isSmallInteger(index)) {
	Display *dpy = myDpy;

	color.pixel = __intVal(index);
	BEGIN_INTERRUPTSBLOCKED
	XQueryColor(dpy, DefaultColormap(dpy, screen), &color);
	END_INTERRUPTSBLOCKED

	/* 
	 * have to compensate for an error in X ?, which does not scale
	 * colors correctly if lesser than 16bits are valid in a color,
	 * (for example, color white on a 4bitsPerRGB server will return
	 * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
	 */
	bits = __intVal(__INST(bitsPerRGB));
	scale = (1<<bits) - 1;
	shift = 16 - bits;

	sr = ((double)(color.red>>shift) / scale) * 0xFFFF;
	sg = ((double)(color.green>>shift) / scale) * 0xFFFF;
	sb = ((double)(color.blue>>shift) / scale) * 0xFFFF;
	r = __MKSMALLINT(sr);
	g = __MKSMALLINT(sg);
	b = __MKSMALLINT(sb);
    }
%}.
    ^ aBlock value:r value:g value:b
!

getScaledRGBFromName:colorName into:aBlock
    "get rgb components (0..16rFFFF) of color named colorName,
     and evaluate the 3-arg block, aBlock with them"

    |r g b|

    displayId isNil ifTrue:[
	self pimitiveFailed.
	^ nil
    ].
%{
    int screen = __intVal(__INST(screen));
    XColor color;
    int sr, sg, sb;
    double floor();
    int bits, scale, shift;

    if (ISCONNECTED
     && __isString(colorName) || __isSymbol(colorName)) {
	Display *dpy = myDpy;
        
	BEGIN_INTERRUPTSBLOCKED
	if (XParseColor(dpy, DefaultColormap(dpy, screen), 
			     (char *)_stringVal(colorName), &color)) {
	    /* 
	     * have to compensate for an error in X ?, which does not scale
	     * colors correctly if lesser than 16bits are valid in a color,
	     * (for example, color white on a 4bitsPerRGB server will return
	     * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
	     */
	    bits = __intVal(__INST(bitsPerRGB));
	    scale = (1<<bits) - 1;
	    shift = 16 - bits;

	    sr = ((double)(color.red>>shift) / scale) * 0xFFFF;
	    sg = ((double)(color.green>>shift) / scale) * 0xFFFF;
	    sb = ((double)(color.blue>>shift) / scale) * 0xFFFF;
	    r = __MKSMALLINT(sr);
	    g = __MKSMALLINT(sg);
	    b = __MKSMALLINT(sb);
	}
	END_INTERRUPTSBLOCKED
    }
%}.
    ^ aBlock value:r value:g value:b
!

listOfAvailableColors
    "return a list of all available colornames.
     This should not be used, since colornames are very
     display-specific (here X-specific)."

    |aStream list line index colorName|

    aStream := FileStream readonlyFileNamed:'/usr/lib/X11/rgb.txt'.
    aStream isNil ifTrue:[^ nil].
    list := OrderedCollection new.
    [aStream atEnd] whileFalse:[
	line := aStream nextLine.
	line notNil ifTrue:[
	    "skip the r/g/b numbers"
	    index := 1.
	    [(line at:index) isSeparator] whileTrue:[index := index + 1].
	    [(line at:index) isDigit] whileTrue:[index := index + 1].
	    [(line at:index) isSeparator] whileTrue:[index := index + 1].
	    [(line at:index) isDigit] whileTrue:[index := index + 1].
	    [(line at:index) isSeparator] whileTrue:[index := index + 1].
	    [(line at:index) isDigit] whileTrue:[index := index + 1].
	    [(line at:index) isSeparator] whileTrue:[index := index + 1].
	    colorName := line copyFrom:index.
	    ((colorName occurrencesOf:(Character space)) == 0) ifTrue:[
		list add:colorName
	    ]
	]
    ].
    aStream close.
    ^ list sort

    "
     Screen current listOfAvailableColors
    "

    "Modified: 11.9.1996 / 15:26:28 / stefan"
!

percentToXColorValue:aPercentage
    "given a color-component value in percent (0..100), return the corresponding
     x-component value (0..65k) as an integer"

%{  /* NOCONTEXT */

    if (__isSmallInteger(aPercentage)) {
	RETURN ( __MKSMALLINT(0xFFFF * __intVal(aPercentage) / 100) );
    }
    if (__isFloat(aPercentage)) {
	RETURN ( __MKSMALLINT(0xFFFF * (int)(__floatVal(aPercentage)) / 100) );
    }
%}.
    ^ (16rFFFF * aPercentage / 100) rounded
!

setColor:index scaledRed:sred scaledGreen:sgreen scaledBlue:sblue
    "change color in map at:index to rgb (0..16rFFFF).
     This method is a noop for StaticGrey, StaticGrey and TrueColor displays."

%{  /* NOCONTEXT */

    char *colorname;
    XColor color;
    int screen = __intVal(__INST(screen));
    int r, g, b;
    int ok = 1;

    if (__isSmallInteger(sred))
	r = __intVal(sred);
    else ok = 0;

    if (__isSmallInteger(sgreen))
	g = __intVal(sgreen);
    else ok = 0;

    if (__isSmallInteger(sblue))
	b = __intVal(sblue);
    else ok = 0;

    if (ISCONNECTED
     && __isSmallInteger(index) && ok) {
	Display *dpy = myDpy;

	color.pixel = __intVal(index);
	color.red = r;
	color.green = g;
	color.blue = b;
	color.flags = DoRed | DoGreen | DoBlue;

	BEGIN_INTERRUPTSBLOCKED
	XStoreColor(dpy, DefaultColormap(dpy, screen), &color);
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
%}.
    self primitiveFailed
! !

!XWorkstation methodsFor:'cursor stuff'!

builtInCursorShapes
    "return a collection of standard cursor names.
     Those are built into the XServer and need not be created as
     user cursors.
     (actually, there are more than those below ...)"

    "/ if you add something here, also add to #shapeNumberFromCursor ...

    ^ #(
	#upLeftArrow            "/ XC_top_left_arrow
	#upRightHand            "/ XC_hand1
	#upDownArrow            "/ XC_sb_v_double_arrow
	#leftRightArrow         "/ XC_sb_h_double_arrow
	#upLimitArrow           "/ XC_top_side         
	#downLimitArrow         "/ XC_bottom_side   
	#leftLimitArrow         "/ XC_left_side
	#rightLimitArrow        "/ XC_right_side
	#text                   "/ XC_xterm     
	#upRightArrow           "/ XC_draft_large
	#leftHand               "/ XC_hand2   
	#questionMark           "/ XC_question_arrow
	#cross                  "/ XC_X_cursor    
	#wait                   "/ XC_watch   
	#crossHair              "/ XC_tcross  
	#origin                 "/ XC_ul_angle
	#topLeft                "/ XC_ul_angle    
	#corner                 "/ XC_lr_angle
	#bottomRight            "/ XC_lr_angle      
	#topRight               "/ XC_ur_angle    
	#bottomLeft             "/ XC_ll_angle      
	#square                 "/ XC_dotbox     
	#fourWay                "/ XC_fleur     
	#crossCursor            "/ XC_X_cursor 
      )

    "Created: 8.4.1997 / 10:12:30 / cg"
    "Modified: 8.4.1997 / 10:31:46 / cg"
!

colorCursor:aCursorId foreground:fgColor background:bgColor
    "change a cursors colors"

    |fgR fgG fgB bgR bgG bgB|

    fgR := fgColor scaledRed.
    fgG := fgColor scaledGreen.
    fgB := fgColor scaledBlue.
    bgR := bgColor scaledRed.
    bgG := bgColor scaledGreen.
    bgB := bgColor scaledBlue.
%{
    XColor fgcolor, bgcolor;

    if (ISCONNECTED
     && __isExternalAddress(aCursorId)
     && __bothSmallInteger(fgG, fgB)
     && __bothSmallInteger(bgR, bgG) 
     && __bothSmallInteger(bgB, fgR)) {

	fgcolor.red = __intVal(fgR);
	fgcolor.green= __intVal(fgG);
	fgcolor.blue = __intVal(fgB);
	bgcolor.red = __intVal(bgR);
	bgcolor.green= __intVal(bgG);
	bgcolor.blue = __intVal(bgB);
	BEGIN_INTERRUPTSBLOCKED
	XRecolorCursor(myDpy, _CursorVal(aCursorId), &fgcolor, &bgcolor);
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

createCursorShape:aShape
    "create a cursor given a shape-symbol. This only works
     for a few standard cursors, and returns nil if no such cursor exists.
     Always care for a fallBack, in case of a nil return."

    |number id|

    displayId isNil ifTrue:[
	self primitiveFailed.
	^ nil
    ].
    number := self shapeNumberFromSymbol:aShape.
%{
    Cursor newCursor;

    if (ISCONNECTED
     && __isSmallInteger(number)) {
	BEGIN_INTERRUPTSBLOCKED
	newCursor = XCreateFontCursor(myDpy, __intVal(number));
#ifdef COUNT_RESOURCES
	if (newCursor)
	    __cnt_cursor++;
#endif
	END_INTERRUPTSBLOCKED
	if (newCursor != (Cursor)0) {
	    id = __MKOBJ(newCursor);
	}
    }
%}.
    ^ id
!

createCursorSourceForm:sourceForm maskForm:maskForm hotX:hx hotY:hy width:w height:h
    "create a cursor given 2 bitmaps (source, mask) and a hotspot"

    |id sourceId maskId|

    displayId isNil ifTrue:[
	self primitiveFailed.
	^ nil
    ].
    sourceId := sourceForm id.
    maskId := maskForm id.
%{
    Cursor newCursor;
    XColor fgColor, bgColor;

    if (ISCONNECTED
     && __isExternalAddress(sourceId)
     && __isExternalAddress(maskId)
     && __bothSmallInteger(hx, hy)) {
	fgColor.red = 0;        /* fg is black */
	fgColor.green = 0;
	fgColor.blue = 0;
	bgColor.red = 0xFFFF;   /* bg is white */
	bgColor.green = 0xFFFF;
	bgColor.blue = 0xFFFF;

	BEGIN_INTERRUPTSBLOCKED
	newCursor = XCreatePixmapCursor(myDpy,
				_PixmapVal(sourceId),
				_PixmapVal(maskId),
				&fgColor, &bgColor, __intVal(hx), __intVal(hy));
#ifdef COUNT_RESOURCES
	if (newCursor)
	    __cnt_cursor++;
#endif
	END_INTERRUPTSBLOCKED
	if (newCursor != (Cursor)0) {
	    id = __MKOBJ(newCursor);
	}
    }
%}.
    ^ id
!

destroyCursor:aCursorId
    "release a cursor - frees any device resources"

%{  /* NOCONTEXT */

    if (! ISCONNECTED) {
	RETURN ( self );
    }

    if (__isExternalAddress(aCursorId)) {
	Cursor curs = _CursorVal(aCursorId);

	if (curs) {
	    BEGIN_INTERRUPTSBLOCKED
	    XFreeCursor(myDpy, curs);
#ifdef COUNT_RESOURCES
	    __cnt_cursor--;
#endif
	    END_INTERRUPTSBLOCKED
	}
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

needDeviceFormsForCursor
    ^ true
!

shapeNumberFromSymbol:shape
    "given a shape-symbol, return the corresponding cursor-number,
     or nil if no such standard cursor exists."

    "/this is pure X-knowlegde - but you may easily add more
    "/ if you add something here, also add to #builtInCursorShapes ...


    (shape == #upLeftArrow)     ifTrue:[ ^ %{ __MKSMALLINT(XC_top_left_arrow)    %} "132" ].
    (shape == #upRightHand)     ifTrue:[ ^ %{ __MKSMALLINT(XC_hand1)             %} "58" ].
    (shape == #upDownArrow)     ifTrue:[ ^ %{ __MKSMALLINT(XC_sb_v_double_arrow) %} "116" ].
    (shape == #leftRightArrow)  ifTrue:[ ^ %{ __MKSMALLINT(XC_sb_h_double_arrow) %} "108" ].
    (shape == #upLimitArrow)    ifTrue:[ ^ %{ __MKSMALLINT(XC_top_side)          %} "138" ].
    (shape == #downLimitArrow)  ifTrue:[ ^ %{ __MKSMALLINT(XC_bottom_side)       %} "16" ].
    (shape == #leftLimitArrow)  ifTrue:[ ^ %{ __MKSMALLINT(XC_left_side)         %} "70" ].
    (shape == #rightLimitArrow) ifTrue:[ ^ %{ __MKSMALLINT(XC_right_side)        %} "96" ].
    (shape == #text)            ifTrue:[ ^ %{ __MKSMALLINT(XC_xterm)             %} "152" ].
    (shape == #upRightArrow)    ifTrue:[ ^ %{ __MKSMALLINT(XC_draft_large)       %} "44" ].
    (shape == #leftHand)        ifTrue:[ ^ %{ __MKSMALLINT(XC_hand2)             %} "60" ].
    (shape == #questionMark)    ifTrue:[ ^ %{ __MKSMALLINT(XC_question_arrow)    %} "92" ].
    (shape == #cross)           ifTrue:[ ^ %{ __MKSMALLINT(XC_X_cursor)          %} "0" ].
    (shape == #wait)            ifTrue:[ ^ %{ __MKSMALLINT(XC_watch)             %} "150" ].
    (shape == #crossHair)       ifTrue:[ ^ %{ __MKSMALLINT(XC_tcross)            %} "130" ].
    ((shape == #origin)
    or:[shape == #topLeft])     ifTrue:[ ^ %{ __MKSMALLINT(XC_ul_angle)          %} "144" ].
    ((shape == #corner)
    or:[shape == #bottomRight]) ifTrue:[ ^ %{ __MKSMALLINT(XC_lr_angle)          %} "78" ].
    (shape == #topRight)        ifTrue:[ ^ %{ __MKSMALLINT(XC_ur_angle)          %} "148" ].
    (shape == #bottomLeft)      ifTrue:[ ^ %{ __MKSMALLINT(XC_ll_angle)          %} "76" ].
    (shape == #square)          ifTrue:[ ^ %{ __MKSMALLINT(XC_dotbox)            %} "40" ].
    (shape == #fourWay)         ifTrue:[ ^ %{ __MKSMALLINT(XC_fleur)             %} "52" ].
    (shape == #crossCursor)     ifTrue:[ ^ %{ __MKSMALLINT(XC_X_cursor)          %} "0" ].

"/    ('XWorkstation [info]: invalid cursorShape:' , shape printString) infoPrintNL.
    ^  nil
! !

!XWorkstation methodsFor:'drag & drop'!

dndDrop:dropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
    "drop something in some alien view, using the DND protocol.
     Returns false, if the drop could not be performed."

    |msgType dropColl anyFile anyDir anyText anyOther
     dropType dropTypeCode strings sz idx val|

    (msgType := self atomIDOf:'DndProtocol') notNil ifTrue:[

	"/ DND can drop files, file, dir, links, dirLink and text
	"/ check for this.

	dropObjects isCollection ifFalse:[
	    dropColl := Array with:dropObjects
	] ifTrue:[
	    dropColl := dropObjects
	].
	anyFile := anyDir := anyText := anyOther := false.
	dropColl do:[:aDropObject |
	    aDropObject isFileObject ifTrue:[
		aDropObject theObject isDirectory ifTrue:[
		    anyDir := true
		] ifFalse:[
		    anyFile := true
		]
	    ] ifFalse:[
		aDropObject isTextObject ifTrue:[
		    anyText := true
		] ifFalse:[
		    anyOther := true
		]
	    ]
	].

	anyOther ifTrue:[
	    "/ DND does not support this ...
	    'XWorkstation [info]: DND can only drop files or text' infoPrintCR.
	    ^ false
	].
	anyText ifTrue:[
	    (anyFile or:[anyDir]) ifTrue:[
		"/ DND does not support mixed types
		'XWorkstation [info]: DND cannot drop both files and text' infoPrintCR.
		^ false
	    ]
	].

	anyFile ifTrue:[
	    dropType := #DndFiles.
	    dropColl size == 1 ifTrue:[
		dropType := #DndFile
	    ]
	] ifFalse:[
	    anyDir ifTrue:[
		dropType := #DndFiles.
		dropColl size == 1 ifTrue:[
		    dropType := #DndDir
		]
	    ] ifFalse:[
		anyText ifTrue:[
		    dropColl size == 1 ifTrue:[
			dropType := #DndText
		    ] ifFalse:[
			"/ can only drop a single text object
			'XWorkstation [info]: DND can only drop a single text' infoPrintCR.
			^ false
		    ]
		] ifFalse:[
		    "/ mhmh ...
		    'XWorkstation [info]: DND cannot drop this' infoPrintCR.
		    ^ false
		]
	    ]
	].

	dropTypeCode := self dndDropTypes indexOf:dropType.
	dropTypeCode == 0 ifTrue:[
	    'XWorkstation [info]: DND cannot drop this' infoPrintCR.
	    ^ false
	].
	dropTypeCode := dropTypeCode - 1.


	"/ place the selection inTo the DndSelection property
	"/ of the rootView ...
	"/ ... need a single string, with 0-terminated parts.

	strings := OrderedCollection new.
	sz := 0.
	dropColl do:[:anObject |
	    |s|

	    anObject isFileObject ifTrue:[
		s := anObject theObject pathName asString
	    ] ifFalse:[
		s := anObject theObject asString
	    ].
	    strings add:s.
	    sz := sz + (s size) + 1.
	].
	val := String new:sz.
	idx := 1.
	strings do:[:aString |
	    val replaceFrom:idx to:(idx + aString size - 1) with:aString startingAt:1.
	    idx := idx + aString size.
	    val at:idx put:(Character value:0).
	    idx := idx + 1
	].

	self
	    setProperty:(self atomIDOf:'DndSelection')
	    type:(stringAtom) 
	    value:val 
	    for:rootId.

	^ self
	    sendClientEvent:msgType 
	    format:32 
	    to:destinationId 
	    data1:dropTypeCode
	    data2:0
	    data3:(destinationId)
	    data4:nil
	    data5:nil.
    ].

    ^ false

    "Created: 6.4.1997 / 13:39:37 / cg"
    "Modified: 6.4.1997 / 14:30:43 / cg"
!

dndDropTypes
    "return the dropTypes as supported by DND"

    ^ #( 
	    DndUnknown      "/ 0
	    DndRawData      "/ 1
	    DndFile         "/ 2
	    DndFiles        "/ 3
	    DndText         "/ 4
	    DndDir          "/ 5
	    DndLink         "/ 6
	    DndExe          "/ 7
       )

    "Created: 6.4.1997 / 12:57:56 / cg"
    "Modified: 6.4.1997 / 13:38:52 / cg"
!

drop:aCollectionOfDropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
    "drop something in some alien view.
     Returns false, if the drop could not be performed."

    "/
    "/ see, if the display supports the DND protocol ...
    "/
    (self atomIDOf:'DndProtocol') notNil ifTrue:[
	^ self
	    dndDrop:aCollectionOfDropObjects 
	    inWindowID:destinationId 
	    position:destinationPoint 
	    rootPosition:rootPoint        
    ].

    "/ add more drag&drop protocols here.

    ^ false

    "Modified: 11.4.1997 / 12:44:50 / cg"
! !

!XWorkstation methodsFor:'drawing'!

copyFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
    "do a bit-blt; copy bits from the rectangle defined by
     srcX/srcY and w/h from the sourceId drawable to the rectangle
     below dstX/dstY in the destId drawable. Trigger an error if any
     argument is not integer."

%{  /* NOCONTEXT */

    GC gc;
    Drawable source, dest;

    if (ISCONNECTED
     && __isExternalAddress(dstGCId)
     && __isExternalAddress(sourceId)
     && __isExternalAddress(destId)
     && __bothSmallInteger(w, h)
     && __bothSmallInteger(srcX, srcY)
     && __bothSmallInteger(dstX, dstY)) {
	gc = _GCVal(dstGCId);
	source = (Drawable) _WindowVal(sourceId);
	dest = (Drawable) _WindowVal(destId);
	XCopyArea(myDpy, source, dest, gc,
				 __intVal(srcX), __intVal(srcY),
				__intVal(w), __intVal(h),
				__intVal(dstX), __intVal(dstY));
	RETURN ( self );
    }
%}.
    "badGC, bad sourceDrawableId or destDrawableID
     or any non integer coordinate"

    self primitiveFailed
!

copyFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
    "do a bit-blt from a pix- or bitmap; copy bits from the rectangle defined by
     srcX/srcY and w/h from the sourceId drawable to the rectangle
     below dstX/dstY in the destId drawable. Trigger an error if any
     argument is not integer.
     This is basically the same as copyFromId:..., but does not generate expose events."

%{  /* NOCONTEXT */

    GC gc;
    Drawable source, dest;

    if (ISCONNECTED
     && __isExternalAddress(dstGCId)
     && __isExternalAddress(sourceId)
     && __isExternalAddress(destId)
     && __bothSmallInteger(w, h)
     && __bothSmallInteger(srcX, srcY)
     && __bothSmallInteger(dstX, dstY)) {
	Display *dpy = myDpy;

	gc = _GCVal(dstGCId);
	source = (Drawable) _WindowVal(sourceId);
	dest = (Drawable) _WindowVal(destId);
	XSetGraphicsExposures(dpy, gc, 0);
	XCopyArea(dpy, source, dest, gc,
				__intVal(srcX), __intVal(srcY),
				__intVal(w), __intVal(h),
				__intVal(dstX), __intVal(dstY));
	XSetGraphicsExposures(dpy, gc, 1);
	RETURN ( self );
    }
%}.
    "badGC, bad sourceDrawableId or destDrawableID
     or any non integer coordinate"

    self primitiveFailed
!

copyPlaneFromId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
    "do a bit-blt, but only copy the low-bit plane; 
     copy bits from the rectangle defined by
     srcX/srcY and w/h from the sourceId drawable to the rectangle
     below dstX/dstY in the destId drawable. Trigger an error if any
     argument is not integer."

%{  /* NOCONTEXT */

    GC gc;
    Drawable source, dest;

    if (ISCONNECTED
     && __isExternalAddress(dstGCId)
     && __isExternalAddress(sourceId)
     && __isExternalAddress(destId)
     && __bothSmallInteger(w, h)
     && __bothSmallInteger(srcX, srcY)
     && __bothSmallInteger(dstX, dstY)) {
	gc = _GCVal(dstGCId);
	source = (Drawable) _WindowVal(sourceId);
	dest = (Drawable) _WindowVal(destId);
	XCopyPlane(myDpy, source, dest, gc,
				 __intVal(srcX), __intVal(srcY),
				 __intVal(w), __intVal(h),
				 __intVal(dstX), __intVal(dstY), 1);
	RETURN ( self );
    }
%}.
    "badGC, bad sourceDrawableId or destDrawableID
     or any non integer coordinate"

    self primitiveFailed
!

copyPlaneFromPixmapId:sourceId x:srcX y:srcY gc:srcGCId to:destId x:dstX y:dstY gc:dstGCId width:w height:h
    "do a bit-blt from a pix- or bitmap, but only copy the low-bit plane; 
     copy bits from the rectangle defined by
     srcX/srcY and w/h from the sourceId drawable to the rectangle
     below dstX/dstY in the destId drawable. Trigger an error if any
     argument is not integer.
     This is the same as copyPlaneFromId:..., but does not generate graphics exposes"

%{  /* NOCONTEXT */

    GC gc;
    Drawable source, dest;

    if (ISCONNECTED
     && __isExternalAddress(dstGCId)
     && __isExternalAddress(sourceId)
     && __isExternalAddress(destId)
     && __bothSmallInteger(w, h)
     && __bothSmallInteger(srcX, srcY)
     && __bothSmallInteger(dstX, dstY)) {
	Display *dpy = myDpy;

	gc = _GCVal(dstGCId);
	source = (Drawable) _WindowVal(sourceId);
	dest = (Drawable) _WindowVal(destId);
	XSetGraphicsExposures(dpy, gc, 0);
	XCopyPlane(dpy, source, dest, gc,
				 __intVal(srcX), __intVal(srcY),
				 __intVal(w), __intVal(h),
				 __intVal(dstX), __intVal(dstY), 1);
	XSetGraphicsExposures(dpy, gc, 1);
	RETURN ( self );
    }
%}.
    "badGC, bad sourceDrawableId or destDrawableID
     or any non integer coordinate"

    self primitiveFailed
!

displayArcX:x y:y width:width height:height from:startAngle angle:angle in:aDrawableId with:aGCId
    "draw an arc. If any of x,y, w or h is not an integer, an error is triggered.
     The angles may be floats or integer - they are given in degrees."

%{  /* NOCONTEXT */

    GC gc;
    Window win;
    int w, h, angle1, angle2;
    double f;

    if (__isSmallInteger(startAngle))
	angle1 = __intVal(startAngle) * 64;
    else if (__isFloat(startAngle)) {
	f = __floatVal(startAngle);
	angle1 = f * 64;
    }
    if (__isSmallInteger(angle))
	angle2 = __intVal(angle) * 64;
    else if (__isFloat(angle)) {
	f = __floatVal(angle);
	angle2 = f * 64;
    }
    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(x, y)
     && __bothSmallInteger(width, height)) {
	win = _WindowVal(aDrawableId);
	gc = _GCVal(aGCId);
	w = __intVal(width);
	h = __intVal(height);
	/*
	 * need this check here: some servers simply dump core with bad args
	 */
	if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
	    XDrawArc(myDpy, win, gc, __intVal(x), __intVal(y),
				   w, h, angle1, angle2);
	}
	RETURN ( self );
    }
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

displayLineFromX:x0 y:y0 toX:x1 y:y1 in:aDrawableId with:aGCId
    "draw a line. If the coordinates are not integers, an error is triggered." 

%{  /* NOCONTEXT */

    GC gc;
    Window win;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(x0, y0)
     && __bothSmallInteger(x1, y1)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);

	if ((x0 == x1) && (y0 == y1)) {
	    XDrawPoint(myDpy, win, gc, __intVal(x0), __intVal(y0));
	} else {
	    XDrawLine(myDpy, win, gc, __intVal(x0), __intVal(y0),
				      __intVal(x1), __intVal(y1));
	}
	RETURN ( self );
    }
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

displayPointX:x y:y in:aDrawableId with:aGCId
    "draw a point. If x/y are not integers, an error is triggered." 

%{  /* NOCONTEXT */

    GC gc;
    Window win;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(x, y)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	XDrawPoint(myDpy, win, gc, __intVal(x), __intVal(y));
	RETURN ( self );
    }
%}.
    "badGC, badDrawable or x/y not integer"
    self primitiveFailed
!

displayPolygon:aPolygon in:aDrawableId with:aGCId
    "draw a polygon, the argument aPolygon is a Collection of individual points, which
     define the polygon.
     If any coordinate is not integer, an error is triggered."

    |numberOfPoints newPoints|

    numberOfPoints := aPolygon size.
%{
    GC gc;
    Window win;
    OBJ point, x, y;
    int i, num;
    XPoint *points;
    XPoint qPoints[100];
    int mustFree = 0;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __isSmallInteger(numberOfPoints)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	num = __intVal(numberOfPoints);
	/*
	 * avoid a (slow) malloc, if the number of points is small
	 */
	if (num > 100) {
	    points = (XPoint *)malloc(sizeof(XPoint) * num);
	    if (! points) goto fail;
	    mustFree = 1;
	} else
	    points = qPoints;

	for (i=0; i<num; i++) {
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
	    if (! __isPoint(point)) goto fail;
	    x = _point_X(point);
	    y = _point_Y(point);
	    if (! __bothSmallInteger(x, y))
		goto fail;
	    points[i].x = __intVal(x);
	    points[i].y = __intVal(y);
	}
	XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
	if (mustFree)
	    free(points);
	RETURN ( self );
    }
fail: ;
    if (mustFree)
	free(points);
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

displayRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
    "draw a rectangle. If the coordinates are not integers, an error is triggered." 

%{  /* NOCONTEXT */

    GC gc;
    Window win;
    int w, h;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(x, y)
     && __bothSmallInteger(width, height)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	w = __intVal(width);
	h = __intVal(height);
	/*
	 * need this check here: some servers simply dump core with bad args
	 */
	if ((w >= 0) && (h >= 0)) {
	    XDrawRectangle(myDpy, win, gc, __intVal(x), __intVal(y), w, h);
	}
	RETURN ( self );
    }
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

displayString:aString from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId opaque:opaque 
    "draw a sub-string - if opaque is false, draw foreground only; otherwise, draw both
     foreground and background characters.
     If the coordinates are not integers, an error is triggered."

%{  /* NOCONTEXT */

    GC gc;
    Window win;
    unsigned char *cp;
    OBJ cls;
    int  i1, i2, l, n;
#   define NLOCALBUFFER 200
    XChar2b xlatebuffer[NLOCALBUFFER];
    int nInstBytes;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __isNonNilObject(aString)
     && __bothSmallInteger(index1, index2)
     && __bothSmallInteger(x, y)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	cls = __qClass(aString);

	i1 = __intVal(index1) - 1;
	if (i1 >= 0) {
	    i2 = __intVal(index2) - 1;
	    if (i2 < i1) {
		RETURN (self);
	    }

	    cp = _stringVal(aString);
	    l = i2 - i1 + 1;

	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
		n = _stringSize(aString);
		if (i2 < n) {
		    cp += i1;
		    if (l > 1000) l = 1000;
		    if (opaque == true)
			XDrawImageString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, l);
		    else
			XDrawString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, l);
		    RETURN ( self );
		}
	    }

	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    cp += nInstBytes;

	    if (__isBytes(aString)) {
		n = __byteArraySize(aString) - nInstBytes - 1;

		if (i2 < n) {
		    cp += i1;
		    if (l > 1000) l = 1000;
		    if (opaque == true)
			XDrawImageString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, l);
		    else
			XDrawString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, l);
		    RETURN ( self );
		}
	    }

	    /* TWOBYTESTRINGS */
	    if (__isWords(aString)) {
		n = (__byteArraySize(aString) - nInstBytes) / 2;

		if (i2 < n) {
		    union {
			char b[2];
			unsigned short s;
		    } u;
		    int i;
		    XChar2b *cp2 = (XChar2b *)0;
		    int mustFree = 0;

		    cp += (i1 * 2);
		    if (l > 1000) l = 1000;

		    /*
		     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
		     * X expects them MSB first
		     * convert as required
		     */

		    u.s = 0x1234;
		    if (u.b[0] != 0x12) {
			if (l <= NLOCALBUFFER) {
			    cp2 = xlatebuffer;
			} else {
			    cp2 = (XChar2b *)(malloc(l * 2));
			    mustFree = 1;
			}
			for (i=0; i<l; i++) {
			    cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
			    cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
			}
			cp = (char *) cp2;
		    }

		    if (opaque == true)
			XDrawImageString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
		    else
			XDrawString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);

		    if (mustFree) {
			free(cp2);
		    }

		    RETURN ( self );
		}
	    }
	}
    }
#undef NLOCALBUFFER
%}.
    "x/y not integer, badGC or drawable, or not a string"
    self primitiveFailed
!

displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque 
    "draw a string - if opaque is false, draw foreground only; otherwise, draw both
     foreground and background characters.
     If the coordinates are not integers, an error is triggered."

%{  /* NOCONTEXT */

    GC gc;
    Window win;
    unsigned char *cp;
    int n;
    OBJ cls;
#   define NLOCALBUFFER 200
    XChar2b xlatebuffer[NLOCALBUFFER];
    int nInstBytes;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __isNonNilObject(aString)
     && __bothSmallInteger(x, y)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	cls = __qClass(aString);

	cp = _stringVal(aString);

	if ((cls == @global(String)) || (cls == @global(Symbol))) {
	    n = _stringSize(aString);
	    if (n > 1000) n = 1000;
	    if (opaque == true)
		XDrawImageString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
	    else
		XDrawString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
	    RETURN ( self );
	}

	nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	cp += nInstBytes;

	if (__isBytes(aString)) {
	    n = __byteArraySize(aString) - nInstBytes - 1;

	    if (n > 1000) n = 1000;
	    if (opaque == true)
		XDrawImageString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
	    else
		XDrawString(myDpy, win, gc, __intVal(x), __intVal(y), (char *)cp, n);
	    RETURN ( self );
	}

	/* TWOBYTESTRINGS */
	if (__isWords(aString)) {
	    union {
		char b[2];
		unsigned short s;
	    } u;
	    int i;
	    XChar2b *cp2;
	    int mustFree = 0;

	    n = (__byteArraySize(aString) - nInstBytes) / 2;
	    if (n > 1000) n = 1000;

	    /*
	     * ST/X TwoByteStrings store the asciiValue in native byteOrder;
	     * X expects them MSB first
	     * convert as required
	     */

	    u.s = 0x1234;
	    if (u.b[0] != 0x12) {
		if (n <= NLOCALBUFFER) {
		    cp2 = xlatebuffer;
		} else {
		    cp2 = (XChar2b *)(malloc(n * 2));
		    mustFree = 1;
		}

		for (i=0; i<n; i++) {
		    cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
		    cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
		}
		cp = (char *) cp2;
	    }

	    if (opaque == true)
		XDrawImageString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
	    else
		XDrawString16(myDpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);


	    if (mustFree) {
		free(cp2);
	    }

	    RETURN ( self );
	}
    }
#undef NLOCALBUFFER
%}.
    "x/y not integer, badGC or drawable, or not a string"
    self primitiveFailed
!

drawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth 
			  width:imageWidth height:imageHeight 
			      x:srcx y:srcy
			   into:aDrawableId 
			      x:dstx y:dsty 
			  width:w height:h 
			   with:aGCId

    "draw a bitImage which has depth id, width iw and height ih into
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
     Individual source pixels have bitsPerPixel bits, allowing to draw
     depth and pixel-units to be different.
     It has to be checked elsewhere, that the server can do it with the given
     depth - otherwise, primitive failure will be signalled.
     Also it is assumed, that the colormap is setup correctly and the
     colors are allocated - otherwise the colors may be wrong."

    "
     sorry; I had to separate it into 2 methods, since XPutImage needs
     an unlimited stack, and thus cannot send primitiveFailed
    "
    (self primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth 
					width:imageWidth height:imageHeight 
					     x:srcx y:srcy
					  into:aDrawableId 
					     x:dstx y:dsty 
					 width:w height:h 
					  with:aGCId)
    ifFalse:[
	"
	 also happens, if a segmentation violation occurs in the 
	 XPutImage ...
	"
	self primitiveFailed
    ].
!

drawBits:imageBits depth:imageDepth 
		   width:imageWidth height:imageHeight 
		       x:srcx y:srcy
		    into:aDrawableId 
		       x:dstx y:dsty 
		   width:w height:h 
		    with:aGCId

    "draw a bitImage which has depth id, width iw and height ih into
     the drawable. draw a region of w/h pixels from srcx/srcy to dstx/dsty.
     Individual source pixels must have imageDepth bits.
     It has to be checked elsewhere, that the server can do it with the given
     depth - otherwise, primitive failure will be signalled.
     Also it is assumed, that the colormap is setup correctly and the
     colors are allocated - otherwise the colors may be wrong."

    ^ self drawBits:imageBits bitsPerPixel:imageDepth depth:imageDepth 
				     width:imageWidth height:imageHeight 
					 x:srcx y:srcy
				      into:aDrawableId 
					 x:dstx y:dsty 
				     width:w height:h 
				      with:aGCId

!

fillArcX:x y:y width:width height:height from:startAngle angle:angle
	       in:aDrawableId with:aGCId
    "fill an arc. If any coordinate is not integer, an error is triggered.
     The angles may be floats or integer - they are given in degrees."

%{  /* NOCONTEXT */

    GC gc;
    Window win;
    int w, h, angle1, angle2;
    double f;

    if (__isSmallInteger(startAngle))
	angle1 = __intVal(startAngle) * 64;
    else if (__isFloat(startAngle)) {
	f = __floatVal(startAngle);
	angle1 = f * 64;
    }
    if (__isSmallInteger(angle))
	angle2 = __intVal(angle) * 64;
    else if (__isFloat(angle)) {
	f = __floatVal(angle);
	angle2 = f * 64;
    }
    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(x, y)
     && __bothSmallInteger(width, height)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	w = __intVal(width);
	h = __intVal(height);
	/*
	 * need this check here: some servers simply dump core with bad args
	 */
	if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
	    XFillArc(myDpy, win, gc, __intVal(x), __intVal(y),
				   w, h, angle1, angle2);
	}
	RETURN ( self );
    }
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

fillPolygon:aPolygon in:aDrawableId with:aGCId
    "fill a polygon given by its points. 
     If any coordinate is not integer, an error is triggered."

    |numberOfPoints|

    numberOfPoints := aPolygon size.
%{
    GC gc;
    Window win;
    OBJ point, x, y;
    int i, num;
    XPoint *points;
    XPoint qPoints[100];
    int mustFree = 0;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __isSmallInteger(numberOfPoints)) {
	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	num = __intVal(numberOfPoints);
	if (num < 3) {
	    RETURN ( self );
	}
	/*
	 * avoid (slow) malloc, if not many points
	 */
	if (num > 100) {
	    points = (XPoint *) malloc(sizeof(XPoint) * num);
	    if (! points) goto fail;
	    mustFree = 1;
	} else
	    points = qPoints;
	for (i=0; i<num; i++) {
	    point = __AT_(aPolygon, __MKSMALLINT(i+1));
	    if (! __isPoint(point)) goto fail;
	    x = _point_X(point);
	    y = _point_Y(point);
	    if (! __bothSmallInteger(x, y))
		goto fail;
	    points[i].x = __intVal(x);
	    points[i].y = __intVal(y);
	}
	XFillPolygon(myDpy, win, gc, points, num, Complex, CoordModeOrigin);
	if (mustFree)
	    free(points);
	RETURN ( self );

fail: ;
	if (mustFree)
	    free(points);
    }
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

fillRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
    "fill a rectangle. If any coordinate is not integer, an error is triggered."

%{  /* NOCONTEXT */

    int w, h;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(x, y)
     && __bothSmallInteger(width, height)) {
	w = __intVal(width);
	h = __intVal(height);
	/*
	 * need this check here: some servers simply dump core with bad args
	 */
	if ((w >= 0) && (h >= 0)) {
	    XFillRectangle(myDpy,
			   (Drawable)_WindowVal(aDrawableId), _GCVal(aGCId),
			   __intVal(x), __intVal(y), w, h);
	}
	RETURN ( self );
    }
%}.
    "badGC, badDrawable or coordinates not integer"
    self primitiveFailed
!

primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth 
			      width:imageWidth height:imageHeight 
				  x:srcx y:srcy
			       into:aDrawableId 
				  x:dstx y:dsty 
			      width:w height:h 
			       with:aGCId

    "since XPutImage may allocate huge amount of stack space 
     (some implementations use alloca), this must run with unlimited stack."

%{  /* UNLIMITEDSTACK */

    /*
     * need unlimited stack, since some Xlibs do a huge alloca in
     * XPutImage
     */
    GC gc;
    Window win;
    XImage image;
    int imgWdth;

    if (ISCONNECTED
     && __isExternalAddress(aGCId)
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(srcx, srcy)
     && __bothSmallInteger(dstx, dsty)
     && __bothSmallInteger(w, h)
     && __bothSmallInteger(imageWidth, imageHeight)
     && __bothSmallInteger(imageDepth, bitsPerPixel)
     && __isByteArray(imageBits)) {
	Display *dpy = myDpy;

	gc = _GCVal(aGCId);
	win = _WindowVal(aDrawableId);
	if (! gc || !win) 
	    goto fail;
#ifdef ARGDEBUG
	printf("args ok\n");
#endif
	image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
	image.width = imgWdth = __intVal(imageWidth);
	image.height = __intVal(imageHeight);
	image.xoffset = 0;
	image.format = ZPixmap;
	image.byte_order = MSBFirst;
	image.bitmap_unit = 8;
	image.bitmap_bit_order = MSBFirst;
	image.bitmap_pad = 8;
	image.depth = __intVal(imageDepth);
	image.bits_per_pixel = __intVal(bitsPerPixel);
	switch (image.bits_per_pixel) {
	    case 1:
		image.bytes_per_line = (imgWdth + 7) / 8;
		break;
	    case 2:
		image.bytes_per_line = (imgWdth*2 + 7) / 8;
		break;
	    case 4:
		image.bytes_per_line = (imgWdth*4 + 7) / 8;
		break;
	    case 8:
		image.bytes_per_line = imgWdth;
		break;
	    case 16:
		image.bytes_per_line = imgWdth*2;
		break;
	    case 24:
		image.bytes_per_line = imgWdth*3;
		break;
	    case 32:
		image.bytes_per_line = imgWdth*4;
		break;
	    default:
#ifdef ARGDEBUG
		printf("bits_per_pixel=%d\n",image.bits_per_pixel);
#endif
		goto fail;
	}
	image.red_mask = 0xFFFF;
	image.green_mask = 0xFFFF;
	image.blue_mask = 0xFFFF;
	XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
					__intVal(dstx), __intVal(dsty),
					__intVal(w), __intVal(h));
	RETURN ( true );
    }
#ifdef ARGDEBUG
    if (!! __isExternalAddress(aGCId)) printf("GC\n");
    if (!! __isExternalAddress(aDrawableId)) printf("aDrawableId\n");
    if (!! __isSmallInteger(srcx)) printf("srcx\n");
    if (!! __isSmallInteger(srcy)) printf("srcy\n");
    if (!! __isSmallInteger(dstx)) printf("dstx\n");
    if (!! __isSmallInteger(dsty)) printf("dsty\n");
    if (!! __isSmallInteger(w)) printf("w\n");
    if (!! __isSmallInteger(h)) printf("h\n");
    if (!! __isSmallInteger(imageWidth)) printf("imageWidth\n");
    if (!! __isSmallInteger(imageHeight)) printf("imageHeight\n");
    if (!! __isSmallInteger(imageDepth)) printf("imageDepth\n");
    if (!! __isSmallInteger(bitsPerPixel)) printf("bitsPerPixel\n");
    if (!! __isByteArray(imageBits)) printf("imageBits\n");
#endif

fail: ;
%}
.
    ^ false
! !

!XWorkstation methodsFor:'event forwarding'!

circulateNotifyView:aView
    "sent, when the stacking order changes.
     ignored for now."

!

circulateRequestView:aView
    "sent, when the stacking order is about to change.
     ignored for now."
!

clientMessage:event dataOffset:offs view:targetView
    self halt.

    "Created: 4.4.1997 / 17:23:12 / cg"
!

clientMessage:event type:type format:format dataOffset:offs view:targetView
    |sensor data|

    data := event copyFrom:offs + 1.

    "/ DND drag&drop protocol
    type == (self atomIDOf:'DndProtocol') ifTrue:[
	format == 32 ifTrue:[
	    self dndMessage:event data:data view:targetView.
	    ^ self
	]
    ].

    (sensor := targetView sensor) notNil ifTrue:[
	sensor clientMessage:type format:format eventData:data view:targetView
    ] ifFalse:[
	"
	 not posted, if there is no sensor ...
	"
    ]

    "Created: 4.4.1997 / 17:49:26 / cg"
    "Modified: 4.4.1997 / 18:00:18 / cg"
!

colorMapChangeView:aView
    "sent, when another colormap is installed.
     This is a very X-specific mechanism."

    aView colorMapChange
!

configureRequestView:aView
    "ignored for now"

    "/ aView configureRequest
!

createdView:aView
    "ignored for now"

    "/ aView created
!

dndMessage:event data:data view:targetView
    "handle a DND drag&drop protocol message"

    |sensor dropType dropValue names i1 i2 t|

    dropType := data doubleWordAt:1.

    "/ see def's in DragAndDropTypes.h
    dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.

    self 
	getProperty:(self atomIDOf:'DndSelection')
	from:rootId
	into:[:type :value |
	    t := type.
	    dropValue := value
	].

    "/ preconvert into a collection
    "/ of fileNames, string or byteArray
    "/ Notice: we do not yet convert into dropObjects
    "/ here, to allow arbitrary data to be handled by
    "/ redefined dropMessage methods in applications.
    "/ Conversion is done for some well known types
    "/ in the default dropMessage handling of SimpleView.

    dropType == #DndFiles ifTrue:[
	"/ actually, a list of fileNames
	t ~~ stringAtom ifTrue:[
	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
	    ^ self
	].

	names := OrderedCollection new.
	i1 := 1.
	[i1 ~~ 0] whileTrue:[
	    i2 := dropValue indexOf:(Character value:0) startingAt:i1.
	    i2 ~~ 0 ifTrue:[
		names add:(dropValue copyFrom:i1 to:(i2-1)).
		i1 := i2 + 1.
	    ] ifFalse:[
		i1 := i2
	    ].
	].
	dropValue := names.
	dropValue := dropValue collect:[:nm | nm asFilename].
	dropType := #files.
    ] ifFalse:[ (dropType == #DndFile) ifTrue:[
	t ~~ stringAtom ifTrue:[
	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
	    ^ self
	].

	dropValue := dropValue asFilename.
	dropType := #file.
    ] ifFalse:[ (dropType == #DndDir) ifTrue:[
	t ~~ stringAtom ifTrue:[
	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
	    ^ self
	].

	dropValue := dropValue asFilename.
	dropType := #directory.
    ] ifFalse:[ (dropType == #DndText) ifTrue:[
	t ~~ stringAtom ifTrue:[
	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
	    ^ self
	].

	dropValue := dropValue.
	dropType := #text.
    ] ifFalse:[ (dropType == #DndExe) ifTrue:[
	t ~~ stringAtom ifTrue:[
	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
	    ^ self
	].

	dropValue := dropValue.
	dropType := #executable.
    ] ifFalse:[ (dropType == #DndLink) ifTrue:[
	t ~~ stringAtom ifTrue:[
	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
	    ^ self
	].

	dropValue := dropValue.
	dropType := #link.
    ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
	dropValue := dropValue.
	dropType := #rawData.
    ] ifFalse:[
	'XWorkstation [info]: unsupported dropType: ' infoPrint. dropType infoPrintCR.
	'XWorkstation [info]: data: ' infoPrint. dropValue infoPrintCR. 

	dropValue := dropValue.
	dropType := #unknown.
    ]]]]]]].

    (sensor := targetView sensor) notNil ifTrue:[
	sensor dropMessage:dropType data:dropValue view:targetView
    ] ifFalse:[
	"
	 not posted, if there is no sensor ...
	"
    ]

    "Created: 4.4.1997 / 17:59:37 / cg"
    "Modified: 6.4.1997 / 14:50:44 / cg"
!

gravityNotifyView:aView
    "ignored for now"

    "/ aView gravityNotify
!

mapRequestView:aView
    "ignored for now"

    "/ aView mapRequest
!

propertyChangeView:aView
    "sent when an X property changes.
     This is a very X-specific mechanism."

    aView propertyChange
!

reparentedView:aView
    "ignored for now"

    "/ aView reparented
!

resizeRequestView:aView
    "ignored for now"

    "/ aView resizeRequest
!

selectionClear:selectionID view:aView
    "sent when another X-client has created a selection.
     This is a very X-specific mechanism."

    "/
    "/ workaround a bug in olvwm: it clears selections
    "/ on window raise.
    "/ In this case, keep my last own selection.
    "/

    self setLastCopyBuffer:(self getCopyBuffer).
    self setCopyBuffer:nil

    "/ noone is interrested in that ...
    "/ aView selectionClear:selectionID
!

selectionNotify:propertyID target:targetID selection:selectionID from:requestorID view:aView
    "sent when the server returns an answer from a request for a selection.
     This is a very X-specific mechanism."

    |s sensor|

    propertyID == 0 ifTrue:[
	"invalid olvwm behavior"
	s := self getLastCopyBuffer
    ] ifFalse:[
	targetID == self atomIDOfSTRING ifTrue:[
	    "
	     a returned string
	    "
	    s := self getTextProperty:propertyID from:requestorID.
	    s notNil ifTrue:[
		(s endsWith:Character cr) ifTrue:[
		    s := s asStringCollection copyWith:''
		]
	    ]
	] ifFalse:[
	    "
	     a returned object
	    "
	    s := self getObjectProperty:propertyID from:requestorID.
	].
    ].

    s notNil ifTrue:[
	(sensor := aView sensor) notNil ifTrue:[
	    sensor pasteFromClipBoard:s view:aView
	] ifFalse:[
	    "
	     if there is no sensor ...
	    "
	    aView pasteFromClipBoard:s
	]
    ]
!

selectionRequest:propertyID target:targetID selection:selectionID from:windowID view:aView
    "sent by some other X-client to ask for the selection.
     This is a very X-specific mechanism."

    |o s stream|

    targetID == (self atomIDOfLENGTH) ifTrue:[
	"/
	"/ the other one wants to know the size of our selection ...
	"/

	s := self selectionAsString.
	self
	    setLengthProperty:propertyID 
	    value:s size 
	    for:windowID.
	self
	    sendSelectionNotifySelection:selectionID
	    property:propertyID
	    target:targetID
	    from:aView id
	    to:windowID.
	^ self
    ].

    (targetID == self atomIDOfSTRING or:[
     targetID == (self atomIDOf:'COMPOUND_TEXT')]) ifTrue:[
	"/
	"/ the other view wants the selection as string
	"/

	s := self selectionAsString.
	self
	    sendSelection:s 
	    property:propertyID 
	    target:targetID
	    from:aView id 
	    to:windowID.
	^ self
    ].

    "/
    "/ send the seletion in binaryStore format
    "/ (assuming, that the other view knows how to handle it)
    "/
    o := self getCopyBuffer.
    stream := WriteStream on:(ByteArray new:200).
    o storeBinaryOn:stream.

    self
	sendSelection:(stream contents) 
	property:propertyID 
	target:(self atomIDOf:'ST_OBJECT' create:true) 
	from:aView id 
	to:windowID
! !

!XWorkstation methodsFor:'event handling'!

dispatchEventFor:aViewIdOrNil withMask:eventMask
    "central event handling method:
     get next event and send appropriate message to the sensor or view.
     If the argument aViewIdOrNil is nil, events for any view are processed,
     otherwise only events for the view with given id are processed.
     If the argument aMask is nonNil, only events for this eventMask are
     handled."

    (self getEventFor:aViewIdOrNil withMask:eventMask) ifTrue:[
	AbortSignal handle:[:ex |
	    ex return
	] do:[
	    self dispatchLastEvent.
	]
    ].

    "Modified: 26.3.1997 / 19:00:41 / cg"
!

dispatchExposeEventFor:aViewIdOrNil
    "get next expose event and send appropriate message to the sensor or view.
     If the argument aViewIdOrNil is nil, events for any view are processed,
     otherwise only events for the view with given id are processed."

    self dispatchEventFor:aViewIdOrNil withMask:(self eventMaskFor:#expose)
!

dispatchLastEvent
    |theView symS arg butt sibling windowID siblingID propertyID selectionID targetID requestorID
     eventType|

%{  /* STACK: 8000 */
#   define ANYBUTTON   (Button1MotionMask | Button2MotionMask | Button3MotionMask)

    Display *dpy;
    OBJ eB;
    XEvent *ev;
    int ev_x, ev_y;

#   define ae ((XAnyEvent *)ev)
#   define ee ((XExposeEvent *)ev)
#   define ke ((XKeyPressedEvent *)ev)
#   define be ((XButtonPressedEvent *)ev)
#   define ce ((XConfigureEvent *)ev)
#   define me ((XMotionEvent *)ev)
#   define ewe ((XEnterWindowEvent *)ev)
#   define lwe ((XLeaveWindowEvent *)ev)
#   define de ((XDestroyWindowEvent *)ev)
#   define ve ((XVisibilityEvent *)ev)
#   define mape ((XMappingEvent *)ev)

    KeySym keySym;
    unsigned char buffer[10];
    int i, nchars;
    char *keySymString;
    char keySymStringBuffer[32];
    unsigned nextMultiClickTime;
    OBJ upDown, t;

    struct inlineCache *ipS;
    static struct inlineCache vid = _ILC1;

    static struct inlineCache expS = _ILC5;
    static struct inlineCache gexpS = _ILC6;
    static struct inlineCache nexpS = _ILC1;
    static struct inlineCache motS = _ILC4;
    static struct inlineCache bpS = _ILC4;
    static struct inlineCache bmpS = _ILC4;
    static struct inlineCache bspS = _ILC4;
    static struct inlineCache brS = _ILC4;
    static struct inlineCache focInS = _ILC1;
    static struct inlineCache focOutS = _ILC1;
    static struct inlineCache peS = _ILC4;
    static struct inlineCache plS = _ILC2;
    static struct inlineCache termS = _ILC1;
    static struct inlineCache savtermS = _ILC1;
    static struct inlineCache destrS = _ILC1;
    static struct inlineCache unmapS = _ILC1;
    static struct inlineCache mapS = _ILC1;
    static struct inlineCache confS = _ILC5;
    static struct inlineCache coveredS = _ILC2;
    static struct inlineCache clientMsg = _ILC5;

    static struct inlineCache keymap = _ILC0;
    static struct inlineCache created = _ILC1;
    static struct inlineCache mapReq = _ILC1;
    static struct inlineCache repar = _ILC1;
    static struct inlineCache confReq = _ILC1;
    static struct inlineCache resReq = _ILC1;
    static struct inlineCache circReq = _ILC1;
    static struct inlineCache circNotify = _ILC1;
    static struct inlineCache gravNotify = _ILC1;
    static struct inlineCache prop = _ILC1;
    static struct inlineCache selClear = _ILC2;
    static struct inlineCache selReq = _ILC5;
    static struct inlineCache selNotify = _ILC5;
    static struct inlineCache colormap = _ILC1;
    static struct inlineCache mapping = _ILC2;
    static struct inlineCache vis = _ILC1;

    static struct inlineCache skpS = _ILC4;
    static struct inlineCache skrS = _ILC4;

    if (! ISCONNECTED) {
	RETURN (false);
    }

    dpy = myDpy;

    eB = __INST(eventBuffer);

    if (__isByteArray(eB)) {
	ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);
    } else {
	printf("DISPLAY: no eventBuffer\n");
	RETURN (false);
    }

    /*
     * very often, its another event for the same view ...
     * avoid creation & lookup then.
     */
    if ((t = __INST(lastId)) != nil) {
	if (__isExternalAddress(t)) {
	    if (_WindowVal(t) == ae->window) {
		theView = __INST(lastView);
		if (__isNonNilObject(theView)) {
		    if (__qClass(theView) == nil) {
			theView = nil;
		    }
		}
	    }
	}
    }

    if (theView == nil) {
	windowID = __MKOBJ(ae->window);
	theView = (*vid.ilc_func)(self, @symbol(viewFromId:), nil, &vid, windowID);
	/*
	 * #viewFromId: could lead to a GC - refetch event ptr
	 */
	eB = __INST(eventBuffer);
	ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);
    }

    if ((theView == nil) && (ev->type != MappingNotify)) {
	RETURN (nil);
    }

    /*
     * key, button and pointer events are sent to the sensor,
     * or (if there is none) to the delegate.
     * or (if there is none) to the view.
     *
     * expose events are sent to the sensor,
     * or (if there is none) to the view
     *
     * sensor and delegate get view as additional argument
     * all of this has been taken out of here to corresponding methods
     * in DeviceWorkstation.
     */

#ifdef DEBUG
    eventType = __MKSMALLINT(ev->type);
#endif
    switch (ev->type) {
	case KeyRelease:
	    symS = @symbol(keyRelease:x:y:view:);
	    ipS = &skrS;
	    upDown = false;
	    goto keyPressAndRelease;

	case KeyPress:
	    symS = @symbol(keyPress:x:y:view:);
	    ipS = &skpS;
	    upDown = true;
	    /* FALL INTO */

	keyPressAndRelease:
	    __INST(eventRootX) = __MKSMALLINT(ke->x_root);
	    __INST(eventRootY) = __MKSMALLINT(ke->y_root);
#ifdef OLD
	    __INST(altDown) = (ke->state & Mod2Mask) ? true : false;
	    __INST(metaDown) = (ke->state & Mod1Mask) ? true : false;
#else
	    __INST(altDown) = (ke->state & __intVal(__INST(altModifierMask))) ? true : false;
	    __INST(metaDown) = (ke->state & __intVal(__INST(metaModifierMask))) ? true : false;
#endif
	    __INST(shiftDown) = (ke->state & ShiftMask) ? true : false;
	    __INST(ctrlDown) = (ke->state & ControlMask) ? true : false;

	    ev_x = ke->x;
	    ev_y = ke->y;

	    arg = nil;
	    nchars = XLookupString(ke, (char *)buffer, sizeof(buffer), &keySym, NULL);
	    if (nchars 
	     && (((buffer[0] >= ' ') && (buffer[0] <= '~'))
		 || (buffer[0] >= 0x80))) {
		arg = _MKCHARACTER(buffer[0])/* *_CharacterTable[buffer[0]] */;
		keySymString = NULL;
	    } else {
#ifdef OLD
		switch (keySym) {
		    case XK_Control_L:
		    case XK_Control_R:
			__INST(ctrlDown) = upDown;
			break;
		    case XK_Shift_L:
		    case XK_Shift_R:
			__INST(shiftDown) = upDown;
			break;
		    case XK_Meta_L:
		    case XK_Meta_R:
			__INST(metaDown) = upDown;
			break;
		    case XK_Alt_L:
		    case XK_Alt_R:
			__INST(altDown) = upDown;
			break;
		}
#endif

		keySymString = XKeysymToString(keySym);
		if (keySymString) {
#ifdef OLD
		    if (keySymString[0] == 'D') {
			/*
			 * remove underscore, dont want it in symbols
			 */
			if (strcmp(keySymString, "Delete_line") == 0) {
			    keySymString = "DeleteLine";
			} else if (strcmp(keySymString, "Delete_word") == 0) {
			    keySymString = "DeleteWord";
			}
		    }
		    /*
		     * make names compatible
		     */
		    if (strcmp(keySymString, "Down") == 0) {
			keySymString = "CursorDown";
		    } else if (strcmp(keySymString, "Up") == 0) {
			keySymString = "CursorUp";
		    } else if (strcmp(keySymString, "Left") == 0) {
			keySymString = "CursorLeft";
		    } else if (strcmp(keySymString, "Right") == 0) {
			keySymString = "CursorRight";
		    }
		    arg = __MKSYMBOL(keySymString, (OBJ *)0);
#else
		    arg = __MKSTRING(keySymString);
#endif
		}
	    }

	    if (arg == nil) {
		/* happens sometimes (alt-graph on sun has no keysym) */
		break;
	    }

	    (*(*ipS).ilc_func)(self, symS, nil, ipS,
			       arg, 
			       __MKSMALLINT(ev_x), 
			       __MKSMALLINT(ev_y),
			       theView);
	    break;

	case ButtonPress:
	    __INST(buttonsPressed) = __MKSMALLINT(__intVal(__INST(buttonsPressed)) | (1 << be->button));
	    __INST(eventRootX) = __MKSMALLINT(be->x_root);
	    __INST(eventRootY) = __MKSMALLINT(be->y_root);

	    if (__isSmallInteger(__INST(multiClickTimeDelta)))
		nextMultiClickTime = be->time + __intVal(__INST(multiClickTimeDelta));
	    else
		nextMultiClickTime = 0;


	    if ((t = __INST(multiClickTime)) != nil) {
		int _multiClickTime;

		_multiClickTime = __longIntVal(t);
		if (be->time < _multiClickTime) {
		    __INST(multiClickTime) = t = __MKUINT(nextMultiClickTime); __STORE(self, t);
		    /*
		     * MKUINT could lead to a GC - refetch event ptr
		     */
		    eB = __INST(eventBuffer);
		    ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);

		    ipS = &bmpS;
		    symS = @symbol(buttonMultiPress:x:y:view:);
		    goto sendButtonEvent;
		    break;
		}
	    }
	    __INST(multiClickTime) = t = __MKUINT(nextMultiClickTime); __STORE(self, t);
	    /*
	     * MKUINT could lead to a GC - refetch event ptr
	     */
	    eB = __INST(eventBuffer);
	    ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);

#ifdef NO_LONGER
	    if (be->state & ShiftMask) {
		ipS = &bspS;
		symS = @symbol(buttonShiftPress:x:y:view:);
		goto sendButtonEvent;
	    }
#endif
	    ipS = &bpS;
	    symS = @symbol(buttonPress:x:y:view:);
	    goto sendButtonEvent;

	    /* NOT REACHED */

	case ButtonRelease:
	    __INST(buttonsPressed) = __MKSMALLINT(__intVal(__INST(buttonsPressed)) & ~(1 << be->button));
	    __INST(eventRootX) = __MKSMALLINT(be->x_root);
	    __INST(eventRootY) = __MKSMALLINT(be->y_root);
	    ipS = &brS;
	    symS = @symbol(buttonRelease:x:y:view:);
	    /* fall into */

	sendButtonEvent:
	    butt = __MKSMALLINT(be->button);
#ifdef NOTDEF
	    /*
	     * this allows operation with single button mouses: meta-click is always Button 2
	     */
	    if (__INST(metaDown) == true)
		butt = __MKSMALLINT(2);
	    else 
#endif
		butt = __AT_(__INST(buttonTranslation), butt);
	    /*
	     * #at: could lead to a GC - refetch event ptr
	     */
	    eB = __INST(eventBuffer);
	    ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);


	    (*(*ipS).ilc_func)(self, 
			       symS, nil, ipS,
			       butt, 
			       __MKSMALLINT(ke->x), 
			       __MKSMALLINT(ke->y),
			       theView);
	    break;

	case MotionNotify:
	    if (__INST(motionEventCompression) != false) {
		while (XCheckWindowEvent(dpy, me->window, ANYBUTTON, ev)) ;;
	    }

	    __INST(eventRootX) = __MKSMALLINT(me->x_root);
	    __INST(eventRootY) = __MKSMALLINT(me->y_root);

#ifdef OLD
	    __INST(altDown) = (me->state & Mod2Mask) ? true : false;
	    __INST(metaDown) = (me->state & Mod1Mask) ? true : false;
#else
	    __INST(altDown) = (ke->state & __intVal(__INST(altModifierMask))) ? true : false;
	    __INST(metaDown) = (ke->state & __intVal(__INST(metaModifierMask))) ? true : false;
#endif
	    __INST(shiftDown) = (me->state & ShiftMask) ? true : false;
	    __INST(ctrlDown) = (me->state & ControlMask) ? true : false;

	    (*motS.ilc_func)(self, 
			     @symbol(buttonMotion:x:y:view:), nil, &motS,
			     __MKSMALLINT(me->state),
			     __MKSMALLINT(me->x),
			     __MKSMALLINT(me->y),
			     theView);
	    break;

	case FocusIn:
	    (*focInS.ilc_func)(self, 
			       @symbol(focusInView:), nil, &focInS, 
			       theView);
	    break;

	case FocusOut:
	    (*focOutS.ilc_func)(self, 
				@symbol(focusOutView:), nil, &focOutS, 
				theView);
	    break;

	case EnterNotify:
#ifdef OLD
	    __INST(altDown) = (ewe->state & Mod2Mask) ? true : false;
	    __INST(metaDown) = (ewe->state & Mod1Mask) ? true : false;
#else
	    __INST(altDown) = (ke->state & __intVal(__INST(altModifierMask))) ? true : false;
	    __INST(metaDown) = (ke->state & __intVal(__INST(metaModifierMask))) ? true : false;
#endif
	    __INST(shiftDown) = (ewe->state & ShiftMask) ? true : false;
	    __INST(ctrlDown) = (ewe->state & ControlMask) ? true : false;

	    (*peS.ilc_func)(self, 
			    @symbol(pointerEnter:x:y:view:), nil, &peS,
			    __MKSMALLINT(ewe->state),
			    __MKSMALLINT(ewe->x), 
			    __MKSMALLINT(ewe->y),
			    theView);
	    break;

	case LeaveNotify:
	    (*plS.ilc_func)(self, 
			    @symbol(pointerLeave:view:), nil, &plS,
			    __MKSMALLINT(lwe->state), 
			    theView);
	    break;

	case GraphicsExpose:
	    (*gexpS.ilc_func)(self, 
			      @symbol(graphicsExposeX:y:width:height:final:view:), nil, &gexpS,
			      __MKSMALLINT(ee->x),
			      __MKSMALLINT(ee->y),
			      __MKSMALLINT(ee->width),
			      __MKSMALLINT(ee->height),
			      ee->count == 0 ? true : false,
			      theView);

	    if (ee->count != 0) {
		break;
	    }
	    /* fall into */

	case NoExpose:
	    (*nexpS.ilc_func)(self, 
			      @symbol(noExposeView:), nil, &nexpS, 
			      theView);
	    break;

	case Expose:
	    (*expS.ilc_func)(self, 
			     @symbol(exposeX:y:width:height:view:), nil, &expS,
			     __MKSMALLINT(ee->x),
			     __MKSMALLINT(ee->y),
			     __MKSMALLINT(ee->width),
			     __MKSMALLINT(ee->height),
			     theView);
	    break;

	case ConfigureNotify:
	    if (ce->above != None) {
		siblingID = __MKOBJ(ce->above);
		sibling = (*vid.ilc_func)(self, @symbol(viewFromId:), nil, &vid, siblingID);
		/*
		 * MKOBJ or #viewFromId: could lead to a GC - refetch event ptr
		 */
		eB = __INST(eventBuffer);
		ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);
	    }

	    (*confS.ilc_func)(self, 
			     @symbol(configureX:y:width:height:view:), nil, &confS,
			     __MKSMALLINT(ce->x),
			     __MKSMALLINT(ce->y),
			     __MKSMALLINT(ce->width),
			     __MKSMALLINT(ce->height),
			     theView);
	    if (sibling != nil) {
		(*coveredS.ilc_func)(self,
				    @symbol(coveredBy:view:), nil, &coveredS,
				    theView,
				    sibling);
	    }
	    break;

	case ClientMessage:
	    if (ev->xclient.message_type == (int) _AtomVal(__INST(protocolsAtom))) {
		if ((ev->xclient.data.l[0] == (int) _AtomVal(__INST(quitAppAtom)))
		 || (ev->xclient.data.l[0] == (int) _AtomVal(__INST(deleteWindowAtom)))) {
		    (*termS.ilc_func)(self, 
				      @symbol(terminateView:), nil, &termS, theView);
		    break;
		}
		if (ev->xclient.data.l[0] == (int) _AtomVal(__INST(saveYourselfAtom))) {
		    (*savtermS.ilc_func)(self, 
					 @symbol(saveAndTerminateView:)
					 , nil, &savtermS, theView);
		    break;
		}
	    }
	    /*
	     * any other client message
	     */
	    i = (char *)(&(ev->xclient.data)) - (char *)ev;
	    (*clientMsg.ilc_func)(self, 
				 @symbol(clientMessage:type:format:dataOffset:view:)
				 , nil, &clientMsg 
				 , __INST(eventBuffer)
				 ,__MKSMALLINT(ev->xclient.message_type)
				 ,__MKSMALLINT(ev->xclient.format)
				 ,__MKSMALLINT(i), 
				 theView);
	    break;

	case DestroyNotify:
	    (*destrS.ilc_func)(self, @symbol(destroyedView:)
			       , nil, &destrS, theView);
	    break;

	case UnmapNotify:
	    (*unmapS.ilc_func)(self, @symbol(unmappedView:) 
			       , nil, &unmapS, theView);
	    break;

	case MapNotify:
	    (*mapS.ilc_func)(self, 
			     @symbol(mappedView:) 
			     , nil, &mapS, theView);
	    break;

	case KeymapNotify:
	    (*keymap.ilc_func)(theView, 
			       @symbol(keyMapChange) 
			       , nil, &keymap);
	    break;

	case VisibilityNotify:
	    switch (ve->state) {
		case VisibilityUnobscured:
		    arg = @symbol(unobscured);
		    break;
		case VisibilityPartiallyObscured:
		    arg = @symbol(partiallyObscured);
		    break;
		case VisibilityFullyObscured:
		    arg = @symbol(fullyObscured);
		    break;
	    }
	    (*vis.ilc_func)(theView, @symbol(visibilityChange:), nil, &vis, arg);
	    break;

	case CreateNotify:
	    (*created.ilc_func)(self, @symbol(createdView:), nil, &created, theView);
	    break;

	case MapRequest:
	    (*mapReq.ilc_func)(self, @symbol(mapRequestView:), nil, &mapReq, theView);
	    break;

	case ReparentNotify:
	    (*repar.ilc_func)(self, @symbol(reparentedView:), nil, &repar, theView);
	    break;

	case ConfigureRequest:
	    (*confReq.ilc_func)(self, @symbol(configureRequestView:), nil, &confReq, theView);
	    break;

	case GravityNotify:
	    (*gravNotify.ilc_func)(self, @symbol(gravityNotifyView:), nil, &resReq, theView);
	    break;

	case ResizeRequest:
	    (*resReq.ilc_func)(self, @symbol(resizeRequestView:), nil, &resReq, theView);
	    break;

	case CirculateNotify:
	    (*circNotify.ilc_func)(self, @symbol(circulateNotifyView:), nil, &circNotify, theView);
	    break;

	case CirculateRequest:
	    (*circReq.ilc_func)(self, @symbol(circulateRequestView:), nil, &circReq, theView);
	    break;

	case PropertyNotify:
	    (*prop.ilc_func)(self, 
			     @symbol(propertyChangeView) 
			     , nil, &prop,
			     theView);
	    break;

	case SelectionClear:
	    selectionID = __MKATOMOBJ(ev->xselectionclear.selection);
	    (*selClear.ilc_func)(self, 
				 @symbol(selectionClear:view:) 
				 , nil, &selClear,
				 selectionID,
				 theView);
	    break;

	case SelectionNotify:
	    /*
	     * returned selection value (answer from SelectionRequest)
	     */
	    DPRINTF(("SelectionNotify prop=%x target=%x selection= %x requestor=%x\n", 
			ev->xselection.property, ev->xselection.target,
			ev->xselection.selection, ev->xselection.requestor));

	    propertyID = __MKATOMOBJ(ev->xselection.property);
	    targetID = __MKATOMOBJ(ev->xselection.target);
	    selectionID = __MKATOMOBJ(ev->xselection.selection);
	    requestorID = __MKOBJ(ev->xselection.requestor);
	    (*selNotify.ilc_func)(self, 
				  @symbol(selectionNotify:target:selection:from:view:) 
				  , nil, &selNotify,
				  propertyID, targetID, selectionID, requestorID,
				  theView);
	    break;

	case SelectionRequest:
	    /*
	     * someone wants the selection
	     */
	    DPRINTF(("SelectionRequest prop=%x target=%x selection=%x requestor=%x\n", 
			ev->xselectionrequest.property,
			ev->xselectionrequest.target,
			ev->xselectionrequest.selection,
			ev->xselectionrequest.requestor));

	    propertyID = __MKATOMOBJ(ev->xselectionrequest.property);
	    targetID = __MKATOMOBJ(ev->xselectionrequest.target);
	    selectionID = __MKATOMOBJ(ev->xselectionrequest.selection);
	    requestorID = __MKOBJ(ev->xselectionrequest.requestor);
	    (*selReq.ilc_func)(self, 
			       @symbol(selectionRequest:target:selection:from:view:) 
			       , nil, &selReq,
			       propertyID, targetID, selectionID, requestorID,
			       theView);
	    break;

	case ColormapNotify:
	    (*colormap.ilc_func)(self, 
				 @symbol(colorMapChangeView:) 
				 , nil, &colormap,
				 theView);
	    break;

	case MappingNotify:
	    switch(mape->request) {
		case MappingModifier:
		    arg = @symbol(mappingModifier);
		    break;
		case MappingKeyboard:
		    arg = @symbol(mappingKeyboard);
		    break;
		case MappingPointer:
		    arg = @symbol(mappingPointer);
		    break;
		default:
		    arg = nil;
		    break;
	    }
	    (*mapping.ilc_func)(self, 
				@symbol(mappingChanged:event:) 
				, nil, &mapping, arg, eB);
	    break;
    }
#undef ae
#undef ee
#undef ke
#undef be
#undef ce
#undef me
#undef ewe
#undef lwe
#undef de
#undef mape
%}
.
    ^ true
!

dispatchPendingEvents
    "central event handling method for modal operation.
     (i.e. this is now only used in the modal debugger)
     This code is somewhat special, since X has a concept of graphic
     expose events (which are sent after a bitblt). After such a bitblt,
     we only handle exposes until the graphicsExpose arrives.
     Other systems may not need such a kludge"

    "interested in exposes only ?"
    dispatchingExpose notNil ifTrue:[
	[self exposeEventPendingFor:dispatchingExpose withSync:false] whileTrue:[
	    self dispatchExposeEventFor:dispatchingExpose
	].
	^ self
    ].

    [self eventPendingWithSync:false] whileTrue:[
	(self getEventFor:nil withMask:nil) ifTrue:[
	    AbortSignal handle:[:ex |
		ex return
	    ] do:[
		self dispatchLastEvent
	    ]
	].
    ]

    "Modified: 26.3.1997 / 19:04:17 / cg"
!

disposeEventsWithMask:aMask for:aWindowIdOrNil
    "dispose (throw away) specific events. If aWindowId is nil,
     events matching the mask are thrown away regardless of which
     view they are for. Otherwise, only matching events for that 
     view are flushed."

%{  /* NOCONTEXT */

    XEvent ev;
    Window win;

    if (ISCONNECTED
     && __isSmallInteger(aMask)) {
	Display *dpy = myDpy;

	if (__isExternalAddress(aWindowIdOrNil)) {
	    win = _WindowVal(aWindowIdOrNil);
	    while (XCheckWindowEvent(dpy, win, __intVal(aMask), &ev)) ;;
	} else {
	    while (XCheckMaskEvent(dpy, __intVal(aMask), &ev)) ;;
	}
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

eventMaskFor:anEventSymbol
    "return the eventMask bit-constant corresponding to an event symbol"

%{  /* NOCONTEXT */

    int m = 0;

    if (anEventSymbol == @symbol(keyPress)) m = KeyPressMask;
    else if (anEventSymbol == @symbol(keyRelease)) m = KeyReleaseMask;
    else if (anEventSymbol == @symbol(buttonPress)) m = ButtonPressMask;
    else if (anEventSymbol == @symbol(buttonRelease)) m = ButtonReleaseMask;
    else if (anEventSymbol == @symbol(buttonMotion)) m = ButtonMotionMask;
    else if (anEventSymbol == @symbol(pointerMotion)) m = PointerMotionMask;
    else if (anEventSymbol == @symbol(expose)) m = ExposureMask;
    else if (anEventSymbol == @symbol(focusChange)) m = FocusChangeMask;
    else if (anEventSymbol == @symbol(enter)) m = EnterWindowMask;
    else if (anEventSymbol == @symbol(leave)) m = LeaveWindowMask;
    else if (anEventSymbol == @symbol(keymapState)) m = KeymapStateMask;
    else if (anEventSymbol == @symbol(visibilityChange)) m = VisibilityChangeMask;
    else if (anEventSymbol == @symbol(structureNotify)) m = StructureNotifyMask;
    else if (anEventSymbol == @symbol(resizeRedirect)) m = ResizeRedirectMask;
    else if (anEventSymbol == @symbol(propertyChange)) m = PropertyChangeMask;
    else if (anEventSymbol == @symbol(colormapChange)) m = ColormapChangeMask;
    RETURN (__MKSMALLINT(m));
%}
!

eventPending
    "return true, if any event is pending. 
     This looks for both the internal queue and the display connection."

    ConservativeSyncing == true ifTrue:[self sync].

    dispatchingExpose notNil ifTrue:[
	^ self exposeEventPendingFor:dispatchingExpose withSync:false
    ].
    ^ self eventPendingWithSync:false
!

eventPending:anEventSymbol for:aWindowIdOrNil
    "return true, if a specific event is pending"

    ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil withSync:false
!

eventPendingWithSync:doSync
    "return true, if any event is pending. 
     If doSync is true, do a sync output buffer (i.e. send all to the display and wait until its processed)
     before checking."

%{  /* UNLIMITEDSTACK */

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (doSync == true) {
	    XSync(dpy, 0);      /* make certain everything is flushed */
	}
	if (XPending(dpy)) {
	    RETURN (true);
	}
    }
    RETURN ( false );
%}
!

eventQueued
    "return true, if any event is queued"

    dispatchingExpose notNil ifTrue:[
	^ self exposeEventPendingFor:dispatchingExpose withSync:false
    ].
    ^ self eventQueuedAlready

    "Created: 12.12.1995 / 21:43:00 / stefan"
!

eventQueuedAlready
    "return true, if any event is queued internally.
     (i.e. in X's internal event queue, which is both filled by explicit
      nextEvent calls AND whenever drawing is done and events are pending on
      the display connection)."

%{  /* UNLIMITEDSTACK */

    if (ISCONNECTED) {
	if (XEventsQueued(myDpy, QueuedAlready)) {
	    RETURN (true);
	}
    }
    RETURN ( false );
%}
!

eventsPending:anEventMask for:aWindowIdOrNil withSync:doSync
    "return true, if any of the masked events is pending"

%{  /* UNLIMITEDSTACK */

    XEvent ev;
    Window win;
    int thereIsOne;

    if (ISCONNECTED && __isSmallInteger(anEventMask)) {
	Display *dpy = myDpy;

	if (doSync == true) {
	    XSync(dpy, 0);      /* make certain everything is flushed */
	}
	if (__isExternalAddress(aWindowIdOrNil)) {
	    win = _WindowVal(aWindowIdOrNil);
	    thereIsOne = XCheckWindowEvent(dpy, win, __intVal(anEventMask), &ev);
	} else {
	    thereIsOne = XCheckMaskEvent(dpy, __intVal(anEventMask), &ev);
	}
	if (thereIsOne) {
	    XPutBackEvent(dpy, &ev);
	    RETURN ( true );
	}
    }
    RETURN ( false );
%}
!

exposeEventPendingFor:aWindowIdOrNil withSync:doSync
    "return true, if any expose event is pending for a specific view,
     or any view (if the arg is nil).
     This is an X specific, only required after a scroll operation."

%{  /* UNLIMITEDSTACK */

    XEvent ev;
    Window win;
    int thereIsOne;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (doSync == true) {
	    XSync(dpy, 0);      /* make certain everything is flushed */
	}
	if (__isExternalAddress(aWindowIdOrNil)) {
	    win = _WindowVal(aWindowIdOrNil);
	    thereIsOne = XCheckWindowEvent(dpy, win, ExposureMask, &ev);
	} else {
	    thereIsOne = XCheckMaskEvent(dpy, ExposureMask, &ev);
	}
	if (thereIsOne) {
	    XPutBackEvent(dpy, &ev);
	    RETURN ( true );
	}
    }
    RETURN ( false );
%}
!

getEventFor:aViewIdOrNil withMask:eventMask
    "read next event - put into local eventBuffer. 
     If aViewIdOrNil is nil, events for any view are fetched; 
     otherwise only events for that specific view will be fetched.
     Returns true, if there was an event, false otherwise.
     This method may block - so you better check for pending events
     before calling for it.

     Sorry I had to split dispatch into this fetch method and an extra
     handle method to allow unlimitedstack here.
     (some Xlibs do a big alloca there ...) which cannot be done in 
     dispatchLastEvent, since it dispatches out into ST-methods.
    "

%{  /* UNLIMITEDSTACK */

    Display *dpy;
    Window win, wWanted;
    int evMask;
    OBJ eB;
    XEvent *ev;

    if (! ISCONNECTED) {
	RETURN (false);
    }

    dpy = myDpy;

    eB = __INST(eventBuffer);
    if (__isByteArray(eB)) {
	ev = (XEvent *)(__ByteArrayInstPtr(eB)->ba_element);
    } else {
	printf("DISPLAY: no eventBuffer\n");
	RETURN (false);
    }
    ev->type = 0;

    if (__isSmallInteger(eventMask)) {
	evMask = __intVal(eventMask);
    } else {
	evMask = ~0;
    }

    if (__isExternalAddress(aViewIdOrNil)) {
	wWanted = _WindowVal(aViewIdOrNil);
	if (XCheckWindowEvent(dpy, wWanted, evMask, ev)) {
	    RETURN ( true );
	}
    } else {
	if (evMask == ~0) {
	    XNextEvent(dpy, ev);
	    RETURN (true);
	}
	if (XCheckMaskEvent(dpy, evMask, ev)) {
	   RETURN (true);
	}
    }
%}.
    ^ false
!

handleAllEvents
    "from now on, handle any kind of event"

    dispatchingExpose := nil
!

handleExposeOnlyFor:aView
    "from now on, handle expose events only"

    dispatchingExpose := aView id
!

mappingChanged:what event:eB
    "One of Keyboard-, Modifier- or PointerMap has change, probably by xmodmap.
     Tell xlib about the fact."

    (what == #mappingKeyboard or:[what == #mappingModifier]) ifTrue:[
	self refreshKeyboardMapping:eB.
	"Maybe some of our modifiers have been changed"
	self initializeModifierMappings.
    ].

    "Created: 1.12.1995 / 16:28:23 / stefan"
!

setEventMask:aMask in:aWindowId
    "tell X that we are only interested in events from aMask, which
     is the bitwise or of the eventMask bits (see 'eventMaskFor:')"

%{  /* NOCONTEXT */

    int mask;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isSmallInteger(aMask)) {
	mask = __intVal(aMask);

#ifdef OLD
	/* these may not be disabled */
	mask |= ExposureMask | StructureNotifyMask |
		KeyPressMask | KeyReleaseMask |
		EnterWindowMask | LeaveWindowMask |
		ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
#endif

	XSelectInput(myDpy, _WindowVal(aWindowId), mask);
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

startDispatch
    "redefined to clear dispatchingExpose, which is a special X feature"

    dispatching ifTrue:[^ self].
    dispatchingExpose := nil.
    super startDispatch
! !

!XWorkstation methodsFor:'event sending'!

sendClientEvent:msgType format:msgFormat to:targetWindowID data1:d1 data2:d2 data3:d3 data4:d4 data5:d5
    "send a ClientMessage to some other (possibly: non-ST/X) view.
     The client message gets message_type and msgFormat as specified by
     the arguments. The additional data arguments specify up to
     5 longWords of user data; each may be an integer or nil.
     It is passed transparently in the events data field.
     See XProtocol specification for more details."

    "/ Event.xclient.type              = ClientMessage;
    "/ Event.xclient.display           = dpy;
    "/ Event.xclient.message_type      = msgType;
    "/ Event.xclient.format            = msgFormat;
    "/ Event.xclient.window            = targetWindowID;
    "/ Event.xclient.data.l[0]         = d1
    "/ Event.xclient.data.l[1]         = d2
    "/ Event.xclient.data.l[2]         = d3
    "/ Event.xclient.data.l[3]         = d4
    "/ Event.xclient.data.l[4]         = d5
    "/
    "/ XSendEvent(dpy,DispatchWindow,True,NoEventMask,&Event);

%{  /* NOCONTEXT */
    int type;
    int state;

    if (ISCONNECTED
     && __isInteger(msgType)
     && __isInteger(msgFormat)
     && (__isExternalAddress(targetWindowID) || __isInteger(targetWindowID))) {
	Display *dpy = myDpy;
	XEvent ev;
	Status result;

	if (__isInteger(d1)) {
	    ev.xclient.data.l[0] = __longIntVal(d1);
	} else {
	    if (__isExternalAddress(d1)) {
		ev.xclient.data.l[0] = (int)__externalAddressVal(d1);
	    } else {
		ev.xclient.data.l[0] = 0;
	    }
	}
	if (__isInteger(d2)) {
	    ev.xclient.data.l[1] = __longIntVal(d2);
	} else {
	    if (__isExternalAddress(d2)) {
		ev.xclient.data.l[1] = (int)__externalAddressVal(d2);
	    } else {
		ev.xclient.data.l[1] = 0;
	    }
	}
	if (__isInteger(d3)) {
	    ev.xclient.data.l[2] = __longIntVal(d3);
	} else {
	    if (__isExternalAddress(d3)) {
		ev.xclient.data.l[2] = (int)__externalAddressVal(d3);
	    } else {
		ev.xclient.data.l[2] = 0;
	    }
	}
	if (__isInteger(d4)) {
	    ev.xclient.data.l[3] = __longIntVal(d4);
	} else {
	    if (__isExternalAddress(d4)) {
		ev.xclient.data.l[3] = (int)__externalAddressVal(d4);
	    } else {
		ev.xclient.data.l[3] = 0;
	    }
	}
	if (__isInteger(d5)) {
	    ev.xclient.data.l[4] = __longIntVal(d5);
	} else {
	    if (__isExternalAddress(d5)) {
		ev.xclient.data.l[4] = (int)__externalAddressVal(d5);
	    } else {
		ev.xclient.data.l[4] = 0;
	    }
	}

	if (__isExternalAddress(targetWindowID)) {
	    ev.xclient.window = _WindowVal(targetWindowID);
	} else {
	    ev.xclient.window = (Window)__longIntVal(targetWindowID);
	}

	ev.xclient.type              = ClientMessage;
	ev.xclient.display           = dpy;
	ev.xclient.message_type      = __longIntVal(msgType);
	ev.xclient.format            = __longIntVal(msgFormat);

	result = XSendEvent(dpy, ev.xclient.window, True, NoEventMask , &ev);

	if ((result == BadValue) || (result == BadWindow)) {
	    DPRINTF(("bad status in sendClientEvent\n"));
	    RETURN ( false )
	}
	RETURN (true)
    }
%}.
    self primitiveFailed.
    ^ false
!

sendKeyOrButtonEvent:typeSymbol x:xPos y:yPos keyOrButton:keySymCodeOrButtonNr state:stateMask toViewId:targetId
    "send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
     TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
     For buttonEvents, the keySymCodeOrButtonNr must be the buttons number (1, 2 ...);
     for key events, it can be either a symbol (as listen in X's keySyms)
     or a numeric keysym code. If state is nil, the modifier bits (shift & control)
     are computed from the keyboardMap - if non-nil, these are passed as modifierbits.
     The non-nil case is the lowlevel entry, where state must include any shift/ctrl information
     (not very user friendly)"

%{  /* NOCONTEXT */
    int type;
    int state;

    if (__isSmallInteger(stateMask)) {
	state = __intVal(stateMask);
    } else {
	state = 0;
    }

    if (ISCONNECTED
     && __isSmallInteger(xPos) && __isSmallInteger(yPos)
     && (__isSmallInteger(keySymCodeOrButtonNr) || __isSymbol(keySymCodeOrButtonNr) || __isString(keySymCodeOrButtonNr))
     && (__isExternalAddress(targetId) || __isInteger(targetId))) {
	Display *dpy = myDpy;

	XEvent ev;
	Window target;
	Status result;
	KeySym keySym, *syms;
	int screen = __intVal(__INST(screen));
	char s[2];
	int nSyms;

	if ((typeSymbol == @symbol(keyPress))
	 || (typeSymbol == @symbol(keyRelease))) {
	    if (__isSymbol(keySymCodeOrButtonNr) || __isString(keySymCodeOrButtonNr)) {
		keySym = XStringToKeysym(__stringVal(keySymCodeOrButtonNr));
	    } else {
		if (__isCharacter(keySymCodeOrButtonNr)) {
		    s[0] = __intVal(__characterVal(keySymCodeOrButtonNr));
		    s[1] = '\0';
		    keySym = XStringToKeysym(s);
		} else {
		    keySym = (KeySym) __intVal(keySymCodeOrButtonNr);
		}
	    }
	    ev.xkey.keycode = XKeysymToKeycode(dpy, keySym);

	    if (stateMask == nil) {
		/*
		 * get the modifier from the keySym
		 */
		nSyms = 0;
		syms = XGetKeyboardMapping(dpy, ev.xkey.keycode, 1, &nSyms);
		if (syms) {
		    int i;

		    for (i=0; i<nSyms; i++) {
			if (syms[i] == keySym) {
#ifdef MODIFIERDEBUG
			    printf("modifier-index is %d\n", i);
#endif
			    if (i) state = (1 << (i-1));
			    break;
			}
		    }
		    XFree(syms);
		}
	    }
	} else {
	    if ((typeSymbol == @symbol(buttonPress))
	     || (typeSymbol == @symbol(buttonRelease))) {
		if (__isSmallInteger(keySymCodeOrButtonNr)) {
		    ev.xbutton.button = __intVal(keySymCodeOrButtonNr);
		} else {
		    ev.xbutton.button = 1;
		}
	    } else {
		DPRINTF(("invalid sendEvent typeSymbol\n"));
		RETURN (false);
	    }
	}

	if (typeSymbol == @symbol(keyPress))
	    ev.xany.type = KeyPress;
	else if (typeSymbol == @symbol(keyRelease))
	    ev.xany.type = KeyRelease;
	else if (typeSymbol == @symbol(buttonPress))
	    ev.xany.type = ButtonPress;
	else if (typeSymbol == @symbol(buttonRelease))
	    ev.xany.type = ButtonRelease;

	if (__isExternalAddress(targetId)) {
	    target = _WindowVal(targetId);
	} else {
	    target = (Window) __longIntVal(targetId);
	}
	ev.xkey.window = target;
	ev.xkey.same_screen = 1;
	ev.xkey.subwindow = 0;
	ev.xkey.root = RootWindow(myDpy, screen);
	ev.xkey.x = __intVal(xPos);
	ev.xkey.y = __intVal(yPos);
	ev.xkey.state = state;
	ev.xkey.time = CurrentTime;

	result = XSendEvent(dpy, target, False, 0 , &ev);
	if ((result == BadValue) || (result == BadWindow)) {
	    DPRINTF(("bad status\n"));
	    RETURN ( false )
	}
	RETURN (true)
    }
%}.
    self primitiveFailed.
    ^ false
!

simulateKeyboardInput:aCharacterOrString inViewId:viewId
    "send input to some other view, by simulating keyPress/keyRelease
     events. 
     Only a few control characters are supported.
     Notice: not all alien views allow this kind of synthetic input;
	     some simply ignore it."

    |control code state|

    aCharacterOrString isString ifTrue:[
	aCharacterOrString do:[:char |
	    self simulateKeyboardInput:char inViewId:viewId
	].
	^ self
    ].

    control := false.
    code := aCharacterOrString asciiValue.

    (aCharacterOrString == Character cr) ifTrue:[
	code := #Return
    ] ifFalse:[
	(aCharacterOrString == Character tab) ifTrue:[
	    code := #Tab 
	] ifFalse:[
	    (aCharacterOrString == Character esc) ifTrue:[
		code := #Escape 
	    ]
	]
    ].

    control ifTrue:[
	state := self controlMask
    ].


    "/ the stuff below should not be needed 
    "/ (sendKeyOrButtonevent should be able to figure out things itself)
    "/ however, on some linux systems it seems to not work correctly.
    "/ Hopefully, this is correct ...

    code isNumber ifTrue:[
	code >= $A asciiValue ifTrue:[
	    code <= $Z asciiValue ifTrue:[
		state := self shiftMask
	    ]
	]
    ].

    self sendKeyOrButtonEvent:#keyPress x:0 y:0 keyOrButton:code state:state toViewId:viewId.
    self sendKeyOrButtonEvent:#keyRelease x:0 y:0 keyOrButton:code state:state toViewId:viewId

    "
      sending input to some (possibly alien) view:

      |point id|

      point :=  Display pointFromUser.
      id := Display viewIdFromPoint:point.
      Display simulateKeyboardInput:'Hello_world' inViewId:id
    "

    "Modified: 11.6.1996 / 10:59:42 / cg"
! !

!XWorkstation methodsFor:'font stuff'!

createFontFor:aFontName
    "a basic method for X-font allocation; this method allows
     any font to be aquired (even those not conforming to
     standard naming conventions, such as cursor, fixed or k14)"

%{  /* UNLIMITEDSTACK */
    /* UNLIMITEDSTACK STACK:100000 xxNOCONTEXT */

    XFontStruct *newFont;

    if (ISCONNECTED) {
	if (__isString(aFontName) || __isSymbol(aFontName)) {
	    BEGIN_INTERRUPTSBLOCKED
	    newFont = XLoadQueryFont(myDpy, (char *)__stringVal(aFontName));
#ifdef COUNT_RESOURCES
	    if (newFont)
		__cnt_font++;
#endif
	    END_INTERRUPTSBLOCKED
	    RETURN ( newFont ? __MKOBJ(newFont) : nil );
	}
    }
%}.
    ^ nil
!

decomposeXFontName:aString into:aBlock
    "extract family, face, style and size from an
     X-font name 
     (-brand-family-face-style-moreStyle--height-size-res-res-?-??-coding); 
     evaluate aBlock with these"

    |origin family face style moreStyle skip fheight size
     resX resY x1 x2 registry encoding coding start end |

    aString isNil ifTrue:[^ false].
    (aString startsWith:'-') ifFalse:[
	"
	 take care for ill-named fonts (i.e. pre Rel4 fonts)
	"
	('*-*-[0-9]*' match:aString) ifTrue:[
	    end := aString indexOf:$- startingAt:1.
	    family := aString copyFrom:1 to:(end - 1).
	    start := end + 1.
	    end := aString indexOf:$- startingAt:start.
	    style := aString copyFrom:start to:(end - 1).
	    start := end + 1.
	    size := aString copyFrom:start.
	    size := (Number readFromString:size onError:[^false]).
	    aBlock value:family value:nil value:style value:size value:nil.
	    ^ true.
	].
	('*-[0-9]*' match:aString) ifTrue:[
	    "
	     something like lucidasans-24
	    "
	    end := aString indexOf:$- startingAt:1.

	    family := aString copyFrom:1 to:(end - 1).
	    start := end + 1.
	    size := aString copyFrom:start.
	    size := (Number readFromString:size onError:[^false]).
	    aBlock value:family value:nil value:nil value:size value:nil.
	    ^ true.
	].
	aBlock value:aString value:nil value:nil value:nil value:nil.
	^ true.
    ].

    end := aString indexOf:$- startingAt:2.
    (end == 0) ifTrue:[^ false].
    origin := aString copyFrom:2 to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    family := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    face := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    style := aString copyFrom:start to:(end - 1).
    (style = 'o') ifTrue:[
	style := 'oblique'
    ] ifFalse:[
	(style = 'i') ifTrue:[
	    style := 'italic'
	] ifFalse:[
	    (style = 'r') ifTrue:[
		style := 'roman'
	    ]
	]
    ].

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    moreStyle := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    skip := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    fheight := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    size := aString copyFrom:start to:(end - 1).
    size := (Number readFromString:size) / 10.

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    resX := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    resY := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    x1 := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    x2 := aString copyFrom:start to:(end - 1).

    start := end + 1.
    end := aString indexOf:$- startingAt:start.
    (end == 0) ifTrue:[^ false].
    registry := aString copyFrom:start to:(end - 1).

    encoding := aString copyFrom:end + 1.

    coding := registry , '-' , encoding.

    (moreStyle ~= 'normal' and:[moreStyle ~= '']) ifTrue:[
	style := style, '-', moreStyle.
    ].

    aBlock value:family value:face value:style value:size value:coding.
    ^ true

    "Modified: 4.7.1996 / 11:12:25 / stefan"
    "Modified: 10.4.1997 / 09:45:36 / cg"
!

encodingOf:aFontId
    "the fonts encoding - if the font does not provide that info,
     return nil (and assume #ascii, which is a subset of #iso8859)."

    |enc fullName fontName registry encoding charSetCollections|

%{ 
    XFontStruct *f;
    XFontProp *prop;
    int n;
    char *cp;
    Atom fontAtom, registryAtom, encodingAtom, charSetCollAtom;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	registryAtom = XInternAtom(dpy, "CHARSET_REGISTRY", True);
	encodingAtom = XInternAtom(dpy, "CHARSET_ENCODING", True);
	charSetCollAtom = XInternAtom(dpy, "CHARSET_COLLECTIONS", True);
	fontAtom = XInternAtom(dpy, "FONT", True);

	if (__isExternalAddress(aFontId)) {
        
	    f = _FontVal(aFontId);
	    if (f) {
		n = f->n_properties;
		prop = f->properties;
		if (prop) {
		    while (n--) {
#ifdef SUPERDEBUG
			cp = XGetAtomName(dpy, prop->name);
			printf("%s (%d) -> %d\n", cp, prop->name, prop->card32);
			XFree(cp);
#endif
			if (prop->name == XA_FULL_NAME) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				fullName = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   FULL_NAME -> %s\n", cp);
#endif
				XFree(cp);
			    }
			} else if (prop->name == fontAtom) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				fontName = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   FONT -> %s\n", cp);
#endif
				XFree(cp);
			    }
			} else if (prop->name == encodingAtom) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				encoding = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   ENCODING -> %s\n", cp);
#endif
				XFree(cp);
			    }
			} else if (prop->name == registryAtom) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				registry = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   REGISTRY -> %s\n", cp);
#endif
				XFree(cp);
			    }
			} else if (prop->name == charSetCollAtom) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				charSetCollections = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   CHARSET_COLLECTIONS -> %s\n", cp);
#endif
				XFree(cp);
			    }
			}
			prop++;
		    }
		}
	    }
	}
    }
%}.
    ^ self
	extractEncodingFromRegistry:registry 
	encoding:encoding 
	charSetCollections:charSetCollections
!

extractEncodingFromRegistry:registry encoding:encoding charSetCollections:charSetCollections
    "this is pure magic ..."

    |enc charSets|

    (registry notNil and:[registry notEmpty]) ifTrue:[
	enc := registry asLowercase asSymbol.
    ] ifFalse:[
	(encoding notNil and:[encoding notEmpty]) ifTrue:[
	    enc := encoding asLowercase asSymbol
	] ifFalse:[
	    charSets := charSetCollections.    
	    (charSets notNil and:[charSets notEmpty]) ifTrue:[
		charSets := charSets asUppercase asCollectionOfWords.
		(charSets includes:'ISO8859-1') ifTrue:[
		    enc := #iso8859
		] ifFalse:[
		    (charSets includes:'ISO8859') ifTrue:[
			enc := #iso8859
		    ] ifFalse:[
			(charSets includes:'ASCII') ifTrue:[
			    enc := #ascii
			] ifFalse:[
			    (charSets includes:'ADOBE-STANDARD') ifTrue:[
				enc := #iso8859
			    ]
			]
		    ]
		]
	    ] 
	]
    ].
    ^  enc

    "Created: 17.4.1996 / 14:57:06 / cg"
    "Modified: 17.4.1996 / 17:22:35 / cg"
!

flushListOfAvailableFonts
    "flush the cached list of all available fonts on this display.
     Required if new fonts have been added on the display server."

    listOfXFonts := nil

    "
     Display flushListOfAvailableFonts.
     Display listOfAvailableFonts
    "

    "Modified: 27.9.1995 / 10:54:47 / stefan"
    "Created: 20.2.1996 / 22:55:52 / cg"
!

fontMetricsOf:fontId into:aBlock
    "evaluate aBlock, passing a fonts metrics as arguments"

    |encoding avgAscent avgDescent
     maxAscent maxDescent minWidth maxWidth avgWidth
     res resX resY|

%{
    XFontStruct *f;
    int len;

    if (ISCONNECTED) {
	if (__isExternalAddress(fontId)) {
	    f = _FontVal(fontId);
	    if (f) {
#ifdef NOTDEF
		char *cp;
		XFontProp *prop;

		n = f->n_properties;
		prop = f->properties;

		if (prop) {
		    while (n--) {
			if (prop->name == RESOLUTION_X) {
			    resX = __MKSMALLINT(prop->card32);
			} else if (prop->name == RESOLUTION_Y) {
			    resY = __MKSMALLINT(prop->card32);
			} else if (prop->name == RESOLUTION) {
			    res = __MKSMALLINT(prop->card32);
			}
			prop++;
		    }
		}
#endif

		avgAscent = __MKSMALLINT(f->ascent);
		avgDescent = __MKSMALLINT(f->descent);
		maxAscent = __MKSMALLINT(f->max_bounds.ascent);
		maxDescent = __MKSMALLINT(f->max_bounds.descent);
		minWidth = __MKSMALLINT(f->min_bounds.width);
		maxWidth = __MKSMALLINT(f->max_bounds.width);
		BEGIN_INTERRUPTSBLOCKED
		len = XTextWidth(f, " ", 1);
		END_INTERRUPTSBLOCKED
		avgWidth = __MKSMALLINT( len );
	    }
	}
    }
%}.
    encoding := self encodingOf:fontId.
    aBlock value:encoding
	   value:avgAscent
	   value:avgDescent
	   value:maxAscent
	   value:maxDescent
	   value:minWidth
	   value:maxWidth
	   value:avgWidth
!

fontResolutionOf:fontId
    "return the resolution (as dpiX @ dpiY) of the font - this is usually the displays resolution,
     but due to errors in some XServer installations, some use 75dpi fonts on higher
     resolution displays and vice/versa."

    |res resX resY|

%{
    XFontStruct *f;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (__isExternalAddress(fontId)) {
	    f = _FontVal(fontId);
	    if (f) {
		char *cp;
		XFontProp *prop;
		Atom resolutionXAtom, resolutionYAtom;
		int n;

		n = f->n_properties;
		prop = f->properties;

		if (prop) {
		    resolutionXAtom = XInternAtom(dpy, "RESOLUTION_X", True);
		    resolutionYAtom = XInternAtom(dpy, "RESOLUTION_Y", True);

		    while (n--) {
			if (prop->name == resolutionXAtom) {
			    resX = __MKSMALLINT(prop->card32);
			} else if (prop->name == resolutionYAtom) {
			    resY = __MKSMALLINT(prop->card32);
			} else if (prop->name == XA_RESOLUTION) {
			    res = __MKSMALLINT(prop->card32);
			}
			prop++;
		    }
		}
	    }
	}
    }
%}.
    (resX notNil and:[resY notNil]) ifTrue:[
	^ resX @ resY
    ].
    res notNil ifTrue:[
	^ res @ res
    ].
    ^ self resolution
!

fullNameOf:aFontId
    "the fonts fullName - this is very device specific and should only be
     used for user feed-back (for example: in the fontPanel).
     If the display/font do not provide that info, return nil."

    |fullName fontName|

%{ 
    XFontStruct *f;
    XFontProp *prop;
    int n;
    char *cp;
    Atom fontAtom;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	fontAtom = XInternAtom(dpy, "FONT", True);

	if (__isExternalAddress(aFontId)) {
        
	    f = _FontVal(aFontId);
	    if (f) {
		n = f->n_properties;
		prop = f->properties;
		if (prop) {
		    while (n--) {
#ifdef SUPERDEBUG
			cp = XGetAtomName(dpy, prop->name);
			printf("%s (%d) -> %d\n", cp, prop->name, prop->card32);
			XFree(cp);
#endif
			if (prop->name == XA_FULL_NAME) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				fullName = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   FULL_NAME -> %s\n", cp);
#endif
				XFree(cp);
			    }
			}
			if (prop->name == fontAtom) {
			    cp = XGetAtomName(dpy, prop->card32);
			    if (cp) {
				fontName = __MKSTRING(cp);
#ifdef SUPERDEBUG
				printf("   FONT -> %s\n", cp);
#endif
				XFree(cp);
			    }
			}
			prop++;
		    }
		}
	    }
	}
    }
%}.
    (fullName notNil and:[fullName notEmpty]) ifTrue:[
	^ fullName
    ].
    ^ fontName
!

getAvailableFontsMatching:pattern
    "return an Array filled with font names matching aPattern"

%{  /* UNLIMITEDSTACK */

    int nnames = 1500;
    int available = nnames + 1;
    char **fonts;
    OBJ arr, str;
    int i;

    if (ISCONNECTED) {
	if (__isString(pattern)) {
	    for (;;) {
		fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
		if ((fonts == NULL) || (available < nnames)) break;
		XFreeFontNames(fonts);
		nnames = available * 2;
	    }
	    if (fonts == NULL) {
		RETURN ( nil );
	    }
	    /*
	     * now, that we know the number of font names,
	     * create the array ...
	     */
	    arr = __ARRAY_NEW_INT(available);
	    if (! arr) {
		RETURN (nil);
	    }
	    /*
	     * ... and fill it
	     */
	    for (i=0; i<available; i++) {
		__PROTECT__(arr);
		str = __MKSTRING(fonts[i]);
		__UNPROTECT__(arr);
		__ArrayInstPtr(arr)->a_element[i] = str; __STORE(arr, str);
	    }
	    RETURN (arr);
	}
    }
%}.
    ^ nil
!

getDefaultFont
    "return a default font id - used when class Font cannot
     find anything usable"

     ^ self createFontFor:'fixed'
!

getFontWithFamily:familyString face:faceString
	    style:styleArgString size:sizeArg encoding:encoding

    "try to get the specified font, if not available, try next smaller
     font. Access to X-fonts by name is possible, by passing the X font name
     as family and the other parameters as nil. For example, the cursor font
     can be aquired that way."

    |styleString theName theId xlatedStyle 
     id spacing encodingMatch registryMatch idx|

    styleString := styleArgString.

    "special: if face is nil, allow access to X-fonts"
    faceString isNil ifTrue:[
	sizeArg notNil ifTrue:[
	    theName := familyString , '-' , sizeArg printString
	] ifFalse:[
	    theName := familyString
	].
	theName isNil ifTrue:[
	    "
	     mhmh - fall back to the default font
	    "
	    theName := 'fixed'
	].
	theId := self createFontFor:theName.
	theId isNil ifTrue:[
	    theId := self getDefaultFont
	].
	^ theId
    ].

    "/ spacing other than 'normal' is contained as last component
    "/ in style

    (styleString notNil
     and:[(styleString endsWith:'-narrow') 
	  or:[styleString endsWith:'-semicondensed']]) ifTrue:[
	|i|
	i := styleString lastIndexOf:$-.
	spacing := styleString copyFrom:(i+1).
	styleString := styleString copyTo:(i-1).
    ] ifFalse:[
	spacing := 'normal'.
    ].

    xlatedStyle := styleString.
    xlatedStyle notNil ifTrue:[
	xlatedStyle := xlatedStyle first asString
    ].

    encodingMatch := encoding.
    registryMatch := '*'.
    encoding isNil ifTrue:[
	encodingMatch := '*'.
    ] ifFalse:[
	idx := encoding indexOf:$-.
	idx ~~ 0 ifTrue:[
	    encodingMatch := encoding copyTo:idx - 1.
	    registryMatch := encoding copyFrom:idx + 1
	].
    ].

    id := self 
	    getFontWithFoundry:'*'
	    family:familyString asLowercase
	    weight:faceString
	    slant:xlatedStyle
	    spacing:spacing
	    pixelSize:nil
	    size:sizeArg 
	    registry:encodingMatch
	    encoding:registryMatch.

    id isNil ifTrue:[
	(encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[
	    "/ too stupid: encodings come in both cases
	    "/ and X does not ignore case
	    "/
	    id := self 
		    getFontWithFoundry:'*'
		    family:familyString asLowercase
		    weight:faceString
		    slant:xlatedStyle
		    spacing:spacing
		    pixelSize:nil
		    size:sizeArg 
		    registry:encodingMatch asUppercase
		    encoding:registryMatch.
	    id isNil ifTrue:[
		id := self 
			getFontWithFoundry:'*'
			family:familyString asLowercase
			weight:faceString
			slant:xlatedStyle
			spacing:spacing
			pixelSize:nil
			size:sizeArg 
			registry:encodingMatch asLowercase
			encoding:registryMatch.
	    ]
	]
    ].
    ^ id

    "Modified: 4.7.1996 / 11:38:47 / stefan"
    "Modified: 10.4.1997 / 19:20:06 / cg"
!

getFontWithFoundry:foundry family:family weight:weight
	      slant:slant spacing:spc pixelSize:pSize size:size 
	      registry:registry encoding:encoding

    "get the specified font, if not available, return nil.
     This is the new font creation method - all others will be changed to
     use this entry.
     Individual attributes can be left empty (i.e. '') or nil to match any.

     foundry: 'adobe', 'misc', 'dec', 'schumacher' ... usually '*'
     family:  'helvetica' 'courier' 'times' ...
     weight:  'bold' 'medium' 'demi' ...
     slant:   'r(oman)' 'i(talic)' 'o(blique)'
     spacing: 'narrow' 'normal' semicondensed' ... usually '*'
     pixelSize: 16,18 ... usually left empty
     size:      size in point (1/72th of an inch)
     registry:  iso8859, sgi ... '*'
     encoding:  registry specific encoding (usually '*')
    "

    |theName sizeMatch 
     foundryMatch familyMatch weightMatch slantMatch spcMatch
     pSizeMatch registryMatch encodingMatch|

    "this works only on 'Release >= 3' - X-servers"
    "name is:
	-foundry-family    -weight -slant-
	 sony    helvetica bold     r
	 adobe   courier   medium   i
	 msic    fixed              o
	 ...     ...
    "

    size isNil ifTrue:[
	sizeMatch := '*'
    ] ifFalse:[
	sizeMatch := size printString , '0'
    ].
    foundry isNil ifTrue:[
	foundryMatch := '*'
    ] ifFalse:[
	foundryMatch := foundry
    ].
    family isNil ifTrue:[
	familyMatch := '*'
    ] ifFalse:[
	familyMatch := family
    ].
    weight isNil ifTrue:[
	weightMatch := '*'
    ] ifFalse:[
	weightMatch := weight
    ].
    slant isNil ifTrue:[
	slantMatch := '*'
    ] ifFalse:[
	slantMatch := slant
    ].
    spc isNil ifTrue:[
	spcMatch := '*'
    ] ifFalse:[
	spcMatch := spc
    ].
    pSize isNil ifTrue:[
	pSizeMatch := '*'
    ] ifFalse:[
	pSizeMatch := pSize printString
    ].
    registry isNil ifTrue:[
	registryMatch := '*'
    ] ifFalse:[
	registryMatch := registry
    ].
    encoding isNil ifTrue:[
	encodingMatch := '*'
    ] ifFalse:[
	encodingMatch := encoding
    ].

    theName := ('-' , foundryMatch,
		'-' , familyMatch,
		'-' , weightMatch ,
		'-' , slantMatch , 
		'-' , spcMatch ,
		'-*' ,
		'-' , pSizeMatch ,
		'-' , sizeMatch ,
		'-*-*-*-*' ,
		'-' , registryMatch ,
		'-' , encodingMatch).

"/  Transcript showCR:theName; endEntry.

    ^ self createFontFor:theName.
        

    "
     Display getFontWithFoundry:'*'
			 family:'courier'
			 weight:'medium'
			  slant:'r'
			spacing:nil
		      pixelSize:nil
			   size:13
		       registry:'iso8859'
		       encoding:'*'
    "

    "Modified: 10.4.1997 / 19:15:44 / cg"
!

listOfAvailableFonts
    "return a list with all available fonts on this display.
     Since this takes a long time, keep the result of the query for the
     next time. The elements of the returned collection are instances of
     FontDescription."

    |"stream aName fntDescr" names|

    listOfXFonts isNil ifTrue:[
"/
"/ old code; using a pipe to xlsfonts
"/
"/      stream := PipeStream readingFrom:'xlsfonts ''*'''.
"/      stream isNil ifTrue:[^ nil].
"/      listOfXFonts := OrderedCollection new.
"/      [stream atEnd] whileFalse:[
"/          aName := stream nextLine.
"/          aName notNil ifTrue:[
"/          self decomposeXFontName:aName into:
"/                  [:family :face :style :size :coding |
"/                      family notNil ifTrue:[
"/                          fntDescr := FontDescription
"/                                          family:family
"/                                          face:face
"/                                          style:style
"/                                          size:size
"/                                          encoding:coding.
"/                          listOfXFonts add:fntDescr
"/                      ]
"/                  ]
"/          ]
"/      ].
"/      stream close.
"/      "if xlsfont is broken ... (hey sco)"
"/      (listOfXFonts size == 0) ifTrue:[
"/          listOfXFonts := nil
"/      ] ifFalse:[
"/          listOfXFonts sort:[:a :b | a family < b family].
"/      ].

	"/
	"/ new code:
	"/ use new primitive to get font names;
	"/ this is much faster, and also works on systems where
	"/      a) xlsfonts is broken (sco)
	"/      b) xlsfonts is not available (aix)
	"/
	names := self getAvailableFontsMatching:'*'.
	names isNil ifTrue:[
	    "no names returned ..."
	    ^ nil
	].
	listOfXFonts := names collect:[:aName |
				    |fntDescr|

				    (self decomposeXFontName:aName into:
					[:family :face :style :size :coding |
					   family notNil ifTrue:[
					       fntDescr := FontDescription
							       family:family
							       face:face
							       style:style
							       size:size
							       encoding:coding.
					   ] ifFalse:[
					       fntDescr := FontDescription
							       name:aName
					   ]
					]
				    ) ifFalse:[
					fntDescr := FontDescription name:aName.
				    ].  
				    fntDescr
			    ].

    ].
    ^ listOfXFonts

    "
     Display listOfAvailableFonts.

     Display getAvailableFontsMatching:'*'.
    "

    "Modified: 27.9.1995 / 10:54:47 / stefan"
    "Modified: 17.4.1996 / 15:27:57 / cg"
!

releaseFont:aFontId

%{  /* NOCONTEXT */

    XFontStruct *f;

    if (! ISCONNECTED) {
	RETURN ( self );
    }

    if (__isExternalAddress(aFontId)) {
	f = _FontVal(aFontId);
	if (f) {
	    BEGIN_INTERRUPTSBLOCKED
	    XFreeFont(myDpy, f);
#ifdef COUNT_RESOURCES
	    __cnt_font--;
#endif
	    END_INTERRUPTSBLOCKED
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
    "return a set of all available font sizes in aFamily/aFace/aStyle
     on this display.
     Redefined to handle X's special case of 0-size (which stands for any)"

    |sizes|

    sizes := super sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
    (sizes notNil and:[sizes includes:0]) ifTrue:[
	"special: in X11R5 and above, size 0 means:
	 there are scaled versions in all sizes available"

	^ #(4 5 6 7 8 9 10 11 12 14 16 18 20 22 24 28 32 48 64)
    ].
    ^ sizes

    "
     Display sizesInFamily:'courier' face:'bold' style:'roman'
    "

    "Created: 27.2.1996 / 01:38:15 / cg"
!

widthOf:aString from:index1 to:index2 inFont:aFontId

%{  /* NOCONTEXT */

    XFontStruct *f;
    char *cp;
    int len, n, i1, i2, l;
    OBJ cls;
#   define NLOCALBUFFER 200
    XChar2b xlatebuffer[NLOCALBUFFER];
    int nInstBytes;

    if (ISCONNECTED) {
	if (__bothSmallInteger(index1, index2)
	 && __isExternalAddress(aFontId)
	 && __isNonNilObject(aString)) {
	    f = _FontVal(aFontId);
	    if (! f) goto fail;

	    i1 = __intVal(index1) - 1;
	    cls = __qClass(aString);

	    if (i1 >= 0) {
		i2 = __intVal(index2) - 1;
		if (i2 < i1) {
		    RETURN ( __MKSMALLINT(0) );
		}

		cp = (char *) _stringVal(aString);
		l = i2 - i1 + 1;

		if ((cls == @global(String)) || (cls == @global(Symbol))) {
		    n = _stringSize(aString);
		    if (i2 < n) {
			cp += i1;
			BEGIN_INTERRUPTSBLOCKED
			len = XTextWidth(f, cp, l);
			END_INTERRUPTSBLOCKED
			RETURN ( __MKSMALLINT(len) );
		    }
		}

		nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
		cp += nInstBytes;

		if (__isBytes(aString)) {
		    n = __byteArraySize(aString) - nInstBytes;
		    if (i2 < n) {
			cp += i1;
			BEGIN_INTERRUPTSBLOCKED
			len = XTextWidth(f, cp, l);
			END_INTERRUPTSBLOCKED
			RETURN ( __MKSMALLINT(len) );
		    }
		}

		/* TWOBYTESTRINGS */
		if (__isWords(aString)) {
		    n = (__byteArraySize(aString) - nInstBytes) / 2;

		    if (i2 < n) {
			union {
			    char b[2];
			    unsigned short s;
			} u;
			int i;
			XChar2b *cp2 = (XChar2b *)0;
			int mustFree = 0;

			cp += (i1 * 2);
			if (l > 1000) l = 1000;

			/*
			 * ST/X TwoByteStrings store the asciiValue in native byteOrder;
			 * X expects them MSB first
			 * convert as required
			 */

			u.s = 0x1234;
			if (u.b[0] != 0x12) {
			    if (l <= NLOCALBUFFER) {
				cp2 = xlatebuffer;
			    } else {
				cp2 = (XChar2b *)(malloc(l * 2));
				mustFree = 1;
			    }
			    for (i=0; i<l; i++) {
				cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
				cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
			    }
			    cp = (char *) cp2;
			}
			BEGIN_INTERRUPTSBLOCKED
			len = XTextWidth16(f, (XChar2b *)cp, l);
			END_INTERRUPTSBLOCKED

			if (mustFree) {
			    free(cp2);
			}

			RETURN ( __MKSMALLINT(len) );
		    }
		}
	    }
	}
    }
#undef NLOCALBUFFER
fail: ;
%}.
    self primitiveFailed.
    ^ 0
!

widthOf:aString inFont:aFontId

%{  /* NOCONTEXT */

    XFontStruct *f;
    char *cp;
    int len, n;
    OBJ cls;
#   define NLOCALBUFFER 200
    XChar2b xlatebuffer[NLOCALBUFFER];
    int nInstBytes;

    if (ISCONNECTED) {
	if (__isExternalAddress(aFontId)
	 && __isNonNilObject(aString)) {
	    f = _FontVal(aFontId);
	    if (! f) goto fail;

	    cls = __qClass(aString);

	    cp = (char *)_stringVal(aString);

	    if ((cls == @global(String)) || (cls == @global(Symbol))) {
		n = _stringSize(aString);
		BEGIN_INTERRUPTSBLOCKED
		len = XTextWidth(f, cp, n);
		END_INTERRUPTSBLOCKED
		RETURN ( __MKSMALLINT(len) );
	    }

	    nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
	    cp += nInstBytes;

	    if (__isBytes(aString)) {
		n = __byteArraySize(aString) - nInstBytes;

		BEGIN_INTERRUPTSBLOCKED
		len = XTextWidth(f, cp, n);
		END_INTERRUPTSBLOCKED
		RETURN ( __MKSMALLINT(len) );
	    }

	    /* TWOBYTESTRINGS */
	    if (__isWords(aString)) {
		union {
		    char b[2];
		    unsigned short s;
		} u;
		int i;
		XChar2b *cp2;
		int mustFree = 0;

		n = (__byteArraySize(aString) - nInstBytes) / 2;
		if (n > 1000) n = 1000;

		/*
		 * ST/X TwoByteStrings store the asciiValue in native byteOrder;
		 * X expects them MSB first
		 * convert as required
		 */

		u.s = 0x1234;
		if (u.b[0] != 0x12) {
		    if (n <= NLOCALBUFFER) {
			cp2 = xlatebuffer;
		    } else {
			cp2 = (XChar2b *)(malloc(n * 2));
			mustFree = 1;
		    }

		    for (i=0; i<n; i++) {
			cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
			cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
		    }
		    cp = (char *) cp2;
		}

		BEGIN_INTERRUPTSBLOCKED
		len = XTextWidth16(f, (XChar2b *)cp, n);
		END_INTERRUPTSBLOCKED

		if (mustFree) {
		    free(cp2);
		}

		RETURN ( __MKSMALLINT(len) );
	    }
	}
    }
#undef NLOCALBUFFER
  fail: ;
%}.
    self primitiveFailed.
    ^ 0
! !

!XWorkstation methodsFor:'grabbing '!

allowEvents:mode
%{  /* NOCONTEXT */

    int _mode, ok = 1;

    if (mode == @symbol(asyncPointer))
	_mode = AsyncPointer;
    else if (mode == @symbol(syncPointer))
	_mode = SyncPointer;
    else if (mode == @symbol(asyncKeyboard))
	_mode = AsyncKeyboard;
    else if (mode == @symbol(syncKeyboard))
	_mode = SyncKeyboard;
    else if (mode == @symbol(syncBoth))
	_mode = SyncBoth;
    else if (mode == @symbol(asyncBoth))
	_mode = AsyncBoth;
    else if (mode == @symbol(replayPointer))
	_mode = ReplayPointer;
    else if (mode == @symbol(replayKeyboard))
	_mode = ReplayKeyboard;
    else
	ok = 0;

    if (ok) {
	if (ISCONNECTED) {
	    BEGIN_INTERRUPTSBLOCKED
	    XAllowEvents(myDpy, _mode, CurrentTime);
	    END_INTERRUPTSBLOCKED
	    RETURN (self);
	}
    }
%}.
    self primitiveFailed
!

grabKeyboardIn:aWindowId
    "grab the keyboard"

%{  /* NOCONTEXT */
    int result, ok;

    if (ISCONNECTED) {
	if (__isExternalAddress(aWindowId)) {
	    BEGIN_INTERRUPTSBLOCKED
	    result = XGrabKeyboard(myDpy,
				   _WindowVal(aWindowId),
				   True /* False */,
				   GrabModeAsync,
				   GrabModeAsync,
				   CurrentTime);
	    END_INTERRUPTSBLOCKED
	    ok = 0;
	    switch(result) {
		case AlreadyGrabbed: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab keyboard: AlreadyGrabbed\n");
		    }
		    break;
		case GrabNotViewable: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab keyboard: GrabNotViewable\n");
		    }
		    break;
		case GrabInvalidTime: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab keyboard: InvalidTime\n");
		    }
		    break;
		case GrabFrozen: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab keyboard: Frozen\n");
		    }
		    break;
		default:
		    ok = 1;
		    break;
	    }
	    if (! ok) {
		XUngrabKeyboard(myDpy, CurrentTime);
		RETURN (false);
	    }

	    RETURN ( true );
	}
    }
%}.
    self primitiveFailed
!

grabPointerIn:aWindowId withCursor:aCursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
    "grap the pointer - return true if ok"

%{  /* NOCONTEXT */

    int result, ok;
    Window confineWin;
    Cursor curs;
    int pointer_mode, keyboard_mode;

    if (ISCONNECTED) {
	if (__isExternalAddress(aWindowId)) {
	    if (__isExternalAddress(confineId)) 
		confineWin = _WindowVal(confineId);
	    else
		confineWin = (Window) None;

	    if (__isExternalAddress(aCursorId)) 
		curs = _CursorVal(aCursorId);
	    else
		curs = (Cursor) None;

	    if (pMode == @symbol(sync))
		pointer_mode = GrabModeSync;
	    else
		pointer_mode = GrabModeAsync;

	    if (kMode == @symbol(sync))
		keyboard_mode = GrabModeSync;
	    else
		keyboard_mode = GrabModeAsync;

	    BEGIN_INTERRUPTSBLOCKED
	    result = XGrabPointer(myDpy,
				  _WindowVal(aWindowId), 
				  False, 
				  ButtonPressMask | ButtonMotionMask | ButtonReleaseMask,
				  pointer_mode, keyboard_mode,
				  confineWin,
				  curs,
				  CurrentTime);
	    END_INTERRUPTSBLOCKED

	    ok = 0;
	    switch (result) {
		case AlreadyGrabbed: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab pointer: AlreadyGrabbed\n");
		    }
		    break;
		case GrabNotViewable: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab pointer: GrabNotViewable\n");
		    }
		    break;
		case GrabInvalidTime: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab pointer: InvalidTime\n");
		    }
		    break;
		case GrabFrozen: 
		    if (@global(ErrorPrinting) == true) {
			fprintf(stderr, "XWorkstation [warning]: grab pointer: Frozen\n");
		    }
		    break;
		default:
		    ok = 1;
		    break;
	    }

	    if (! ok) {
		XUngrabPointer(myDpy, CurrentTime);
		RETURN (false);
	    }
	    RETURN ( true );
	}
    }
%}.
    self primitiveFailed
!

ungrabKeyboard
    "release the keyboard"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	XUngrabKeyboard(myDpy, CurrentTime);
	XSync(myDpy, 0);
	END_INTERRUPTSBLOCKED
    }
%}.
    activeKeyboardGrab := nil
!

ungrabPointer
    "release the pointer"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	XUngrabPointer(myDpy, CurrentTime);
	XSync(myDpy, 0);
	END_INTERRUPTSBLOCKED
    }
%}.
    activePointerGrab := nil
! !

!XWorkstation methodsFor:'graphic context stuff'!

noClipIn:aDrawableId gc:aGCId
    "disable clipping rectangle"

%{  /* NOCONTEXT */

    XGCValues gcv;
    GC gc;

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)) {
	    gc = _GCVal(aGCId);
	    gcv.clip_mask = None;
	    XChangeGC(myDpy, gc, GCClipMask, &gcv);
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setBackground:bgColorIndex in:aGCId
    "set background color to be drawn with"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)
	 && __isSmallInteger(bgColorIndex)) {
	    XSetBackground(myDpy, _GCVal(aGCId), __intVal(bgColorIndex));
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setBitmapMask:aBitmapId in:aGCId
    "set or clear the drawing mask - a bitmap mask using current fg/bg"

%{  /* NOCONTEXT */

    GC gc;
    Pixmap bitmap;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (__isExternalAddress(aGCId)) {
	    gc = _GCVal(aGCId);
	    if (__isExternalAddress(aBitmapId)) {
		bitmap = _PixmapVal(aBitmapId);
		XSetStipple(dpy, gc, bitmap);
		XSetFillStyle(dpy, gc, FillOpaqueStippled);
		RETURN ( self );
	    }
	    if (aBitmapId == nil) {
		XSetFillStyle(dpy, gc, FillSolid);
		RETURN ( self );
	    }
	}
    }
%}.
    self primitiveFailed
!

setClipByChildren:aBool in:aDrawableId gc:aGCId
    "enable/disable drawing into child views"

%{  /* NOCONTEXT */

    XGCValues gcv;
    GC gc;

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)) {
	    gc = _GCVal(aGCId);
	    if (aBool == true)
		gcv.subwindow_mode = ClipByChildren;
	    else
		gcv.subwindow_mode = IncludeInferiors;

	    XChangeGC(myDpy, gc, GCSubwindowMode, &gcv);
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setClipX:clipX y:clipY width:clipWidth height:clipHeight in:drawableId gc:aGCId
    "clip to a rectangle"

%{  /* NOCONTEXT */

    XRectangle r;

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)
	 && __bothSmallInteger(clipX, clipY)
	 && __bothSmallInteger(clipWidth, clipHeight)) {
	    r.x = __intVal(clipX);
	    r.y = __intVal(clipY);
	    r.width = __intVal(clipWidth);
	    r.height = __intVal(clipHeight);
	    XSetClipRectangles(myDpy, _GCVal(aGCId), 0, 0, &r, 1, Unsorted);
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setDashes:dashList dashOffset:offset in:aGCId
    "set line attributes"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)
	 && __isSmallInteger(offset)
	 && __isByteArray(dashList)) {
	    XSetDashes(myDpy, _GCVal(aGCId), 
		       __intVal(offset),
		       __ByteArrayInstPtr(dashList)->ba_element,
		       __byteArraySize(dashList));
	    RETURN ( self );
	}
    }
bad: ;
%}.
    "
     either aGCId is invalid,
     and/or dashList is not a byteArray
     and/or offset is not a smallInteger
    "
    self primitiveFailed
!

setFont:aFontId in:aGCId
    "set font to be drawn in"

%{  /* NOCONTEXT */

    XFontStruct *f;

    if (ISCONNECTED) {
	if (__isExternalAddress(aFontId)
	 && __isExternalAddress(aGCId)) {
	    f = (XFontStruct *) _FontVal(aFontId);
	    XSetFont(myDpy, _GCVal(aGCId), f->fid);
	    RETURN ( self );
	}
    }
%}.
    "
     aGCId and/or aFontId are invalid
    "
    self primitiveFailed
!

setForeground:fgColorIndex background:bgColorIndex in:aGCId
    "set foreground and background colors to be drawn with"

%{  /* NOCONTEXT */

    GC gc;

    if (ISCONNECTED) {
	Display *dpy = myDpy;
	if (__bothSmallInteger(fgColorIndex, bgColorIndex)
	 && __isExternalAddress(aGCId)) {
	    gc = _GCVal(aGCId);

	    XSetForeground(dpy, gc, __intVal(fgColorIndex));
	    XSetBackground(dpy, gc, __intVal(bgColorIndex));
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setForeground:fgColorIndex in:aGCId
    "set foreground color to be drawn with"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)
	 && __isSmallInteger(fgColorIndex)) {
	    XSetForeground(myDpy, _GCVal(aGCId), __intVal(fgColorIndex));
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setFunction:aFunctionSymbol in:aGCId
    "set alu function to be drawn with"

%{  /* NOCONTEXT */

    GC gc;
    int fun = -1;

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)) {
	    gc = _GCVal(aGCId);
	    if (aFunctionSymbol == @symbol(copy)) fun = GXcopy;
	    else if (aFunctionSymbol == @symbol(copyInverted)) fun = GXcopyInverted;
	    else if (aFunctionSymbol == @symbol(xor)) fun = GXxor;
	    else if (aFunctionSymbol == @symbol(and)) fun = GXand;
	    else if (aFunctionSymbol == @symbol(andReverse)) fun = GXandReverse;
	    else if (aFunctionSymbol == @symbol(andInverted)) fun = GXandInverted;
	    else if (aFunctionSymbol == @symbol(or)) fun = GXor;
	    else if (aFunctionSymbol == @symbol(orReverse)) fun = GXorReverse;
	    else if (aFunctionSymbol == @symbol(orInverted)) fun = GXorInverted;
	    if (fun != -1) {
		XSetFunction(myDpy, gc, fun);
		RETURN ( self );
	    }
	}
    }
%}.
    "
     either aGCId is not an integer, or an invalid symbol
     was passed ... valid functions are #copy, #copyInverted, #xor, #and, #andReverse,
     #andInverted, #or, #orReverse, #orInverted. See Xlib documentation for more details.
    "
    self primitiveFailed
!

setGraphicsExposures:aBoolean in:aGCId
    "set or clear the graphics exposures flag"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)) {
	    XSetGraphicsExposures(myDpy, _GCVal(aGCId), (aBoolean==true)?1:0);
	    RETURN ( self );
	}
    }
%}
.
    self primitiveFailed
!

setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
    "set line attributes; 
     lineStyle must be one of #solid, #dashed or #doubleDashed;
     capStyle one of: #notLast, #butt, #round or #projecting;
     joinStyle one of: #miter, #bevel or #round."

%{  /* NOCONTEXT */

    int x_style, x_cap, x_join;

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)
	 && __isSmallInteger(aNumber)) {
	    if (lineStyle == @symbol(solid)) x_style = LineSolid;
	    else if (lineStyle == @symbol(dashed)) x_style = LineOnOffDash;
	    else if (lineStyle == @symbol(doubleDashed)) x_style = LineDoubleDash;
	    else goto bad;

	    if (capStyle == @symbol(notLast)) x_cap = CapNotLast;
	    else if (capStyle == @symbol(butt)) x_cap = CapButt;
	    else if (capStyle == @symbol(round)) x_cap  = CapRound;
	    else if (capStyle == @symbol(projecting)) x_cap  = CapProjecting;
	    else goto bad;

	    if (joinStyle == @symbol(miter)) x_join = JoinMiter;
	    else if (joinStyle == @symbol(bevel)) x_join = JoinBevel;
	    else if (joinStyle == @symbol(round)) x_join  = JoinRound;
	    else goto bad;

	    XSetLineAttributes(myDpy,
			       _GCVal(aGCId), __intVal(aNumber),
			       x_style, x_cap, x_join);
	    RETURN ( self );
	}
    }
bad: ;
%}.
    "
     either aGCId is invalid,
     and/or lineWidth is not a smallInteger,
     and/or lineStyle is none of #solid, #dashed, #doubleDashed
     and/or capStyle is none of #notLast, #butt, #round, #projecting
     and/or joinStyle is none of #miter, #bevel, #round
    "
    self primitiveFailed
!

setMaskOriginX:orgX y:orgY in:aGCid
    "set the mask origin"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	if (__bothSmallInteger(orgX, orgY) && __isExternalAddress(aGCid)) {
	    XSetTSOrigin(myDpy, _GCVal(aGCid), __intVal(orgX), __intVal(orgY));
	    RETURN ( self );
	}
    }
%}.
    self primitiveFailed
!

setPixmapMask:aPixmapId in:aGCId
    "set or clear the drawing mask - a pixmap mask providing full color"

%{  /* NOCONTEXT */

    Display *dpy = myDpy;
    GC gc;
    Pixmap pixmap;

    if (ISCONNECTED) {
	if (__isExternalAddress(aGCId)) {
	    gc = _GCVal(aGCId);
	    if (__isExternalAddress(aPixmapId)) {
		pixmap = _PixmapVal(aPixmapId);
		XSetTile(dpy, gc, pixmap);
		XSetFillStyle(dpy, gc, FillTiled);
		RETURN ( self );
	    }
	    if (aPixmapId == nil) {
		XSetFillStyle(dpy, gc, FillSolid);
		RETURN ( self );
	    }
	}
    }
%}.
    self primitiveFailed
! !

!XWorkstation methodsFor:'initialize / release'!

brokenConnection
    "the connection to the X-server was lost"

    displayId := nil.

    "/ tell all of my views about this.
    "/ first, all topViews get a notification ...

    self allViewsDo:[:aView |
	aView isTopView ifTrue:[
	    aView destroyed
	]
    ].

    self releaseDeviceResources.

    "Modified: 11.4.1997 / 10:44:33 / cg"
!

closeConnection
    "close down the connection to the X-server"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	BEGIN_INTERRUPTSBLOCKED
	__INST(displayId) = nil;
	XCloseDisplay(dpy);
	END_INTERRUPTSBLOCKED
    }
%}
!

initializeDefaultValues
    buttonTranslation := ButtonTranslation.
    multiClickTimeDelta := MultiClickTimeDelta.

    self initializeModifierMappings
!

initializeEventBuffer
    |sz|

%{
    sz = __MKSMALLINT(sizeof(XEvent) + 100);
%}.
    eventBuffer isNil ifTrue:[
	eventBuffer := ByteArray new:sz.
    ].
!

initializeFor:aDisplayName
    "initialize the receiver for a connection to an X-Server;
     the argument, aDisplayName may be nil (for the default server from
     DISPLAY-variable or command line argument) or the name of the server 
     as hostname:number"

    |dpyName index arguments|

    dpyName := aDisplayName.
    dpyName isNil ifTrue:[
	"look for a '-display xxx' argument"
	(arguments := Smalltalk commandLineArguments) notNil ifTrue:[
	    index := arguments indexOf:'-display'.
	    (index between:1 and:(arguments size - 1)) ifTrue:[
		dpyName := arguments at:index+1
	    ]
	]
    ].
%{
    int scr;
    Display *dpy;
    Visual *visual;
    XVisualInfo viproto;
    XVisualInfo *vip;                   /* retured info */
    int maxRGBDepth;
    int rgbRedMask, rgbGreenMask, rgbBlueMask;
    int rgbVisualID;
    int nvi, i;
    char *type, *nm;
    int dummy;
    OBJ dpyID;

    if (__INST(displayId) != nil) {
	/*
	 * already connected - you bad guy try to
	 * trick me manually ?
	 */
	RETURN ( self );
    }

    BEGIN_INTERRUPTSBLOCKED

    if (__isString(dpyName))
	nm = (char *)_stringVal(dpyName);
    else {
	dpyName = __MKSTRING((char *)getenv("DISPLAY"));
	nm = NULL;
    }
    dpy = XOpenDisplay(nm);

    if (dpy) {
	static int firstCall = 1;

	__INST(displayId) = dpyID = __MKOBJ(dpy); __STORE(self, dpyID);

#ifdef SUPERDEBUG
	XSynchronize(dpy, 1);
#endif

	if (firstCall) {
	    firstCall = 0;
	    XSetErrorHandler(__XErrorHandler__);
	    XSetIOErrorHandler(__XIOErrorHandler__);
	}
    }

    END_INTERRUPTSBLOCKED
%}.
    displayId isNil ifTrue:[
	'XWorkstation [warning]: cannot connect to Display.' errorPrintCR.
	^ nil
    ].

    dispatching := false.
    dispatchingExpose := false.
    isSlow := false.
    shiftDown := false.
    ctrlDown := false.
    metaDown := false.
    altDown := false.
    motionEventCompression := true.
    buttonsPressed := 0.
    displayName := dpyName.

    protocolsAtom := nil.
    deleteWindowAtom := nil.
    saveYourselfAtom := nil.
    quitAppAtom := nil.

    self initializeScreenProperties.
    self initializeDeviceResourceTables.

    self initializeDefaultValues.
    self initializeEventBuffer.
    self initializeSpecialFlags.
    self initializeKeyboardMap.

    deviceErrorSignal := DeviceErrorSignal newSignalMayProceed:false.
    deviceErrorSignal nameClass:self class message:#deviceErrorSignal.
    deviceIOErrorSignal := DeviceIOErrorSignal newSignalMayProceed:false.
    deviceIOErrorSignal nameClass:self class message:#deviceIOErrorSignal.

    ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayError.
    ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOError.
!

initializeModifierMappings
    |map mod|

"/    altModifiers := #(Alt_L Alt_R).
"/    metaModifiers := #(Meta_L Meta_R).
"/    ctrlModifiers := #(Control_L Control_R).
"/    shiftModifiers := #(Shift_L Shift_R).

    shiftModifiers := ctrlModifiers := altModifiers := metaModifiers := nil.
    altModifierMask := metaModifierMask := nil.

    map := self modifierMapping.
    map isNil ifTrue:[
	"/
	"/ mhmh - a crippled Xlib which does not provide modifier mappings
	"/ setup some reasonable default. If that is not sufficient,
	"/ you have to change things from your display.rc file.
	"/
	altModifierMask := self modifier1Mask.
	metaModifierMask := self modifier2Mask.

	shiftModifiers := #(Shift_L Shift_R Shift).
	ctrlModifiers := #(Control_L Control_R Control).
	metaModifiers := #(Alt_L Meta_L Meta_R Meta).
	altModifiers := #(Alt_R Alt).
    ] ifFalse:[
	altModifierMask := 0.
	metaModifierMask := 0.

	mod := map at:1.
	mod notNil ifTrue:[
	    shiftModifiers := mod collect:[ :key | self stringFromKeycode:key ].
	].
	mod := map at:3.
	mod notNil ifTrue:[
	    ctrlModifiers  := mod collect:[ :key | self stringFromKeycode:key ].
	].
	mod := map at:4.
	mod notNil ifTrue:[
	    metaModifiers  := mod collect:[ :key | self stringFromKeycode:key ].    
	    metaModifierMask := 1 bitShift:(4-1).
	].
	mod := map at:5.
	mod notNil ifTrue:[
	    altModifiers   := mod collect:[ :key | self stringFromKeycode:key ].    
	    altModifierMask := 1 bitShift:(5-1).
	]
    ].

    "Modified: 1.12.1995 / 23:44:40 / stefan"
!

initializeScreenProperties
    super initializeScreenProperties.

%{

    Display *dpy;
    int scr;
    Visual *visual;
    XVisualInfo viproto;
    XVisualInfo *vip;                   /* retured info */
    int maxRGBDepth;
    int rgbRedMask, rgbGreenMask, rgbBlueMask;
    int rgbVisualID;
    int nvi, i;
    int shapeEventBase, shapeErrorBase;
    int shmEventBase, shmErrorBase;
    char *type, *nm;
    int dummy;
    int mask, shift, nBits;

    if (ISCONNECTED) {
	dpy = myDpy;

	__INST(altModifierMask) = __MKSMALLINT(Mod2Mask);
	__INST(metaModifierMask) = __MKSMALLINT(Mod1Mask);

	BEGIN_INTERRUPTSBLOCKED

	__INST(screen) = __MKSMALLINT(scr = DefaultScreen(dpy));
	__INST(depth) = __MKSMALLINT(DisplayPlanes(dpy, scr));
	__INST(ncells) = __MKSMALLINT(DisplayCells(dpy, scr));
	__INST(width) = __MKSMALLINT(DisplayWidth(dpy, scr));
	__INST(height) = __MKSMALLINT(DisplayHeight(dpy, scr));
	__INST(widthMM) = __MKSMALLINT(DisplayWidthMM(dpy, scr));
	__INST(heightMM) = __MKSMALLINT(DisplayHeightMM(dpy, scr));
	__INST(blackpixel) = __MKSMALLINT(BlackPixel(dpy, scr));
	__INST(whitepixel) = __MKSMALLINT(WhitePixel(dpy, scr));

#ifdef SHAPE
	if (XShapeQueryExtension(dpy, &dummy, &dummy))
	    __INST(hasShapeExtension) = true;
	else
#endif
	  __INST(hasShapeExtension) = false;

#ifdef SHM
	if (XQueryExtension(dpy, "MIT_SHM", &dummy, &dummy, &dummy))
	    __INST(hasShmExtension) = true;
	else
#endif
	  __INST(hasShmExtension) = false;

#ifdef DPS
	if (XQueryExtension(dpy, "DPSExtension", &dummy, &dummy, &dummy))
	    __INST(hasDPSExtension) = true;
	else
#endif
	  __INST(hasDPSExtension) = false;

#ifdef XVIDEO
	if (XQueryExtension(dpy, "XVideo", &dummy, &dummy, &dummy))
	    __INST(hasXVideoExtension) = true;
	else
#endif
	  __INST(hasXVideoExtension) = false;

#ifdef MBUF
	if (XQueryExtension(dpy, "Multi-Buffering", &dummy, &dummy, &dummy))
	    __INST(hasMbufExtension) = true;
	else
#endif
	  __INST(hasMbufExtension) = false;

#ifdef PEX5
	if (XQueryExtension(dpy, PEX_NAME_STRING, &dummy, &dummy, &dummy))
	    __INST(hasPEXExtension) = true;
	else
#endif
	  __INST(hasPEXExtension) = false;

#ifdef XIE
	if (XQueryExtension(dpy, xieExtName, &dummy, &dummy, &dummy))
	    __INST(hasImageExtension) = true;
	else
#endif
	  __INST(hasImageExtension) = false;

#ifdef XI
	if (XQueryExtension(dpy, "XInputExtension", &dummy, &dummy, &dummy))
	    __INST(hasInputExtension) = true;
	else
#endif
	  __INST(hasInputExtension) = false;

	/*
	 * look for RGB visual
	 */
	nvi = 0;
	viproto.screen = scr;
	vip = XGetVisualInfo (dpy, VisualScreenMask, &viproto, &nvi);
	maxRGBDepth = 0;
	for (i = 0; i < nvi; i++) {
	    switch (vip[i].class) {
		case TrueColor:
		    if (vip[i].depth > maxRGBDepth) {
			maxRGBDepth = vip[i].depth;
			rgbRedMask = vip[i].red_mask;
			rgbGreenMask = vip[i].green_mask;
			rgbBlueMask = vip[i].blue_mask;
			rgbVisualID = vip[i].visualid;
		    }
		    break;
	    }
	}
	if (vip) XFree ((char *) vip);

	if (maxRGBDepth) {
	    __INST(rgbVisual) = __MKOBJ(rgbVisualID); __STORESELF(rgbVisual);
	}

	visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
	__INST(monitorType) = @symbol(unknown);
	__INST(hasColors) = true;
	__INST(hasGreyscales) = true;
	switch (visual->class) {
	    case StaticGray:
		__INST(visualType) = @symbol(StaticGray);
		__INST(hasColors) = false;
		__INST(monitorType) = @symbol(monochrome);
		break;
	    case GrayScale:
		__INST(visualType) = @symbol(GrayScale);
		__INST(hasColors) = false;
		__INST(monitorType) = @symbol(monochrome);
		break;
	    case StaticColor:
		__INST(visualType) = @symbol(StaticColor);
		break;
	    case PseudoColor:
		__INST(visualType) = @symbol(PseudoColor);
		break;
	    case TrueColor:
		__INST(visualType) = @symbol(TrueColor);
		break;
	    case DirectColor:
		__INST(visualType) = @symbol(DirectColor);
		break;
	}
	if (DisplayCells(dpy, scr) == 2) {
	    __INST(hasColors) = false;
	    __INST(hasGreyscales) = false;
	    __INST(monitorType) = @symbol(monochrome);
	}
	__INST(bitsPerRGB) = __MKSMALLINT(visual->bits_per_rgb);
	__INST(redMask)   = __MKSMALLINT(visual->red_mask);
	__INST(greenMask) = __MKSMALLINT(visual->green_mask);
	__INST(blueMask)  = __MKSMALLINT(visual->blue_mask);
	switch (visual->class) {
	    case TrueColor:
		/* extract number of bits and shift counts */
		mask = visual->red_mask;
		shift = 0;
		while (mask && ((mask & 1) == 0)) {
		    mask >>= 1;
		    shift++;
		}
		__INST(redShift) = __MKSMALLINT(shift);
		nBits = 0;
		while (mask) {
		    mask >>= 1;
		    nBits++;
		}
		__INST(bitsRed) = __MKSMALLINT(nBits);

		mask = visual->green_mask;
		shift = 0;
		while (mask && ((mask & 1) == 0)) {
		    mask >>= 1;
		    shift++;
		}
		__INST(greenShift) = __MKSMALLINT(shift);
		nBits = 0;
		while (mask) {
		    mask >>= 1;
		    nBits++;
		}
		__INST(bitsGreen) = __MKSMALLINT(nBits);

		mask = visual->blue_mask;
		shift = 0;
		while (mask && ((mask & 1) == 0)) {
		    mask >>= 1;
		    shift++;
		}
		__INST(blueShift) = __MKSMALLINT(shift);
		nBits = 0;
		while (mask) {
		    mask >>= 1;
		    nBits++;
		}
		__INST(bitsBlue) = __MKSMALLINT(nBits);
		break;
	}

#ifndef XA_PRIMARY
	__INST(primaryAtom) = __MKATOMOBJ( XInternAtom(dpy, "PRIMARY", True) );
#else
	__INST(primaryAtom) = __MKATOMOBJ( XA_PRIMARY );
#endif
#ifndef XA_SECONDARY
	__INST(secondaryAtom) = __MKATOMOBJ( XInternAtom(dpy, "SECONDARY", True) );
#else
	__INST(secondaryAtom) = __MKATOMOBJ( XA_SECONDARY );
#endif
#ifndef XA_CUT_BUFFER0
	__INST(cutBuffer0Atom) = __MKATOMOBJ( XInternAtom(dpy, "CUT_BUFFER0", True) );
#else
	__INST(cutBuffer0Atom) = __MKATOMOBJ( XA_CUT_BUFFER0 );
#endif
#ifndef XA_STRING
	__INST(stringAtom) = __MKATOMOBJ( XInternAtom(dpy, "STRING", True) );
#else
	__INST(stringAtom) = __MKATOMOBJ( XA_STRING );
#endif
#ifndef XA_LENGTH
	__INST(lengthAtom) = __MKATOMOBJ( XInternAtom(dpy, "LENGTH", True) );
#else
	__INST(lengthAtom) = __MKATOMOBJ( XA_LENGTH );
#endif
#ifndef WM_STATE
	__INST(wmStateAtom) = __MKATOMOBJ( XInternAtom(dpy, "WM_STATE", True) );
#else
	__INST(wmStateAtom) = __MKATOMOBJ( WM_STATE );
#endif

	END_INTERRUPTSBLOCKED
    }
%}.
!

initializeSpecialFlags
    "perform additional special server implementation flags"

    "/
    "/ assume we have it ... (should check)
    "/
    hasSaveUnder := true.
    ignoreBackingStore := false.

    (self serverVendor = 'X11/NeWS') ifTrue:[
	"/
	"/ this is a kludge around a bug in the X11/NeWS server,
	"/ which does not correctly handle saveUnder
	"/
	hasSaveUnder := false.
    ].
!

reinitialize
    virtualRootId := rootId := nil.
    super reinitialize.
    dispatchingExpose := nil
! !

!XWorkstation methodsFor:'keyboard mapping'!

altModifierMask
    "return the mask (in motionEvents) for the alt-key modifier.
     Notice: ST/X may use the left ALT key as CMD/Meta key,
     therefore return a variable here, which can be changed during startup."

    ^ altModifierMask

    "Created: 23.3.1996 / 12:43:22 / cg"
    "Modified: 23.3.1996 / 12:44:56 / cg"
!

altModifierMask:aSmallInteger
    "define which key takes the role of an alt-key.
     By default, this is X's modifier1, which is the ALT key on
     most keyboards. However, there may be exceptions to this,
     and the setting can be changed with:
	Display altModifierMask:(Display modifier2Mask)
     Setting the mask to 0 disables the ALT key (in ST/X) altogether.
    "

    altModifierMask := aSmallInteger
!

metaModifierMask
    "return the mask (in motionEvents) for the meta-key modifier.
     Notice: ST/X may use the left ALT key as CMD/Meta key,
     therefore return a variable here, which can be changed during startup."

    ^ metaModifierMask

    "Created: 23.3.1996 / 12:43:39 / cg"
    "Modified: 23.3.1996 / 12:45:09 / cg"
!

metaModifierMask:aSmallInteger
    "define which key takes the role of a meta key.
     By default, this is X's modifier2, which is the 2nd ALT key on
     most keyboards (if present at all).
     However, there may be exceptions to this, and the setting can
     be changed with:
	Display metaModifierMask:(Display modifier1Mask)
     Setting the mask to 0 disables the META key (in ST/X) altogether.
     As reported, some Xservers place the Meta-key onto NumLock,
     and having NumLock enabled makes ST/X think, that meta is pressed
     all the time. On those, you should disable the meta key by setting
     the mask to 0.
    "

    metaModifierMask := aSmallInteger
!

modifier1Mask
    "return the Xlib mask bit for the 1st modifier key.
     See comment in altModifierMask: / metaModifierMask: for what
     this could be used."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(Mod1Mask));
%}
!

modifier2Mask
    "return the Xlib mask bit for the 2nd modifier key.
     See comment in altModifierMask: / metaModifierMask: for what
     this could be used."

%{  /* NOCONTEXT */
    RETURN (__MKSMALLINT(Mod2Mask));
%}
!

modifierMapping
    "Get the Modifier Mapping.
     We return an array of arrays of keycodes"

    |modifierKeyMap maxKeyPerMod ret nextKey|

%{
    XModifierKeymap *modmap;
    OBJ __BYTEARRAY_UNINITIALIZED_NEW_INT();

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if ((modmap = XGetModifierMapping(myDpy)) != 0) {
	   maxKeyPerMod = __MKSMALLINT(modmap->max_keypermod);
	   modifierKeyMap = __BYTEARRAY_UNINITIALIZED_NEW_INT(modmap->max_keypermod * 8);
	   if (modifierKeyMap != nil) {
		maxKeyPerMod = __MKSMALLINT(modmap->max_keypermod);
		memcpy((char *)__ByteArrayInstPtr(modifierKeyMap)->ba_element, 
		       (char *)modmap->modifiermap, modmap->max_keypermod * 8);
	   }
	   XFreeModifiermap(modmap);
	}
    }
%}.

    modifierKeyMap isNil ifTrue:[^ nil].

    ret := Array new:8.
    nextKey := 1.
    1 to:8 do:[ :i |
	(modifierKeyMap at:nextKey) ~= 0 ifTrue:[
	    |mod|

	    mod := OrderedCollection new:maxKeyPerMod.
	    modifierKeyMap from:nextKey to:(nextKey+maxKeyPerMod-1) do:[ :key |
		key ~= 0 ifTrue:[
		    mod add:key
		].
	    ].
	    ret at:i put:mod.
	].
	nextKey := nextKey+maxKeyPerMod.
    ].

    ^ ret

    "
	Display modifierMapping
    "
!

stringFromKeycode:code
    "Get a KeySymbol (a smalltalk symbol) from the keycode."

    |str|

%{
    KeySym keysym;
    char *keystring;

    if (ISCONNECTED && __isSmallInteger(code)) {
	Display *dpy = myDpy;

	if ((keysym = XKeycodeToKeysym(myDpy, __intVal(code), 0)) != NoSymbol &&
	    (keystring = XKeysymToString(keysym)) != 0) 
	    str = __MKSTRING(keystring);
    }
%}.
    ^ str

    "
	Display stringFromKeycode:28
    "
!

translateKey:untranslatedKey
    "Return the key translated via the translation table.
     Here, we preTranslate the key into a common ST/X symbolic name, 
     which gets further processed in the superclasses translation method."

    |key|

    (key := untranslatedKey) isString ifTrue:[
	key := RawKeysymTranslation at:key ifAbsent:key.
	key := key asSymbol.
    ].
    ^ super translateKey:key 
! !

!XWorkstation methodsFor:'misc'!

beep
    "output an audible beep or bell"

    self beep:50
!

beep:volumeInPercent
    "output an audible beep"
%{
    int volume;

    if (__isSmallInteger(volumeInPercent) && ISCONNECTED) {
	/* stupid: X wants -100 .. 100 and calls this percent */
	volume = __intVal(volumeInPercent) * 2 - 100;
	if (volume < -100) volume = -100;
	else if (volume > 100) volume = 100;
	BEGIN_INTERRUPTSBLOCKED
	XBell(myDpy, volume);
	END_INTERRUPTSBLOCKED
    }
%}
!

buffered
    "buffer drawing - do not send it immediately to the display.
     This is the default anyway.
     See #unBuffered for additional info."

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	XSynchronize(myDpy, 0);
	END_INTERRUPTSBLOCKED
    }
%}
    "
     Display buffered
    "
!

flush
    "send all buffered drawing to the display.
     This may be required to make certain, that all previous operations
     are really sent to the display before continuing. For example,
     after a cursor-change with a followup long computation.
     (otherwise, the cursor change request may still be in the output buffer)
     See also #sync, which even waits until the request has been processed."

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	XFlush(myDpy);
	END_INTERRUPTSBLOCKED
    }
%}
!

flushDpsContext:aDPSContext

%{  /* NOCONTEXT */
#ifdef DPS
    if (__isExternalAddress(aDPSContext)) {
	BEGIN_INTERRUPTSBLOCKED
	DPSFlushContext(MKDPSCONTEXT(aDPSContext));
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
#endif
%}.
    self primitiveFailed
!

refreshKeyboardMapping:eB
%{
    XMappingEvent *ev;

    if (__isByteArray(eB)) {
	ev = (XMappingEvent *)(__ByteArrayInstPtr(eB)->ba_element);
	XRefreshKeyboardMapping(ev);
    }
%}
!

setInputFocusTo:aWindowId
"/    self setInputFocusTo:aWindowId revertTo:#parent
    self setInputFocusTo:aWindowId revertTo:#root
!

setInputFocusTo:aWindowId revertTo:revertSymbol
    "set the focus to the view as defined by aWindowId.
     Passing nil set the focus to no window and lets the display discard all
     input until a new focus is set.
     RevertSymbol specifies what should happen if the view becomes invisible;
     passing one of #parent, #root or nil specifies that the focus should be
     given to the parent view, the root view or no view."

%{  /* NOCONTEXT */
    int arg;
    Window focusWindow;

    if (ISCONNECTED) {
	if (__isExternalAddress(aWindowId)) {
	    focusWindow = _WindowVal(aWindowId);
	} else {
	    focusWindow = None;
	}
	if (revertSymbol == @symbol(parent))
	    arg = RevertToParent;
	else if (revertSymbol == @symbol(root))
	    arg = RevertToPointerRoot;
	else 
	    arg = RevertToNone;

	BEGIN_INTERRUPTSBLOCKED
	XSetInputFocus(myDpy, focusWindow, arg, CurrentTime);
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

sync
    "send all buffered drawing to the display AND wait until the display
     has finished drawing it.
     This is almost never needed, except if you are about to read previously
     drawn pixels back from the display screen, or you want to wait for a beep
     to be finished. See also #flush."

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	XSync(myDpy, 0);
	END_INTERRUPTSBLOCKED
    }
%}
!

unBuffered
    "make all drawing be sent immediately to the display.
     This makes all graphics synchronous and turns off any buffering
     (i.e. each individual draw-request is sent immediately without 
      packing multiple requests into a larger message buffer).
     Be prepared, that this slows down graphics considerably.
     However, it allows display errors to be handled immediately and
     may be useful if you get Xdisplay errors and want to find the request
     which was responsiblefor it. See also #buffered."

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	XSynchronize(myDpy, 1);
	END_INTERRUPTSBLOCKED
    }
%}
    "Display unbuffered"
! !

!XWorkstation methodsFor:'pointer queries '!

anyButtonStateMask
    "return an integer for masking out any button from a
     buttonStates value."

    "/ should use ``Display buttonXMotionMask bitOr:....''

    ^ 256 + 512 + 1024

    "Modified: 23.3.1996 / 12:41:33 / cg"
    "Created: 23.3.1996 / 12:46:35 / cg"
!

buttonStates
    "return an integer representing the state of the pointer buttons;
     a one-bit in positions 0.. represent a pressed button.
     See the button1Mask/button2Mask/button3Mask,
     shiftMask/controlMask and modifierMask methods for the meaning of the bits."

%{  /* NOCONTEXT*/
    Window w;
    int screen = __intVal(__INST(screen));
    Window rootRet, childRet;
    int rootX, rootY, winX, winY;
    unsigned int mask;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	BEGIN_INTERRUPTSBLOCKED
#ifdef VIRTUAL_ROOT
	w = getRootWindow(myDpy, screen);
#else
	w = RootWindow(dpy, screen);
#endif
	XQueryPointer(dpy, w, &rootRet, &childRet,
			      &rootX, &rootY,
			      &winX, &winY,
			      &mask);
	END_INTERRUPTSBLOCKED
	RETURN (__MKSMALLINT(mask));
    }
%}.
    self primitiveFailed

    "
     Display buttonStates     
    "

    "is the control-key pressed ?

     Display buttonStates bitTest:(Display controlMask)    
    "

    "is the alt/meta-key pressed ?

     Display buttonStates bitTest:(Display altModifierMask)    
     Display buttonStates bitTest:(Display metaModifierMask)    
    "
!

leftButtonStateMask
    "return an integer for masking out the left button from a
     buttonStates value"

    "/ should use ``Display button1MotionMask''

    ^ 256

    "Modified: 23.3.1996 / 12:41:33 / cg"
!

middleButtonStateMask
    "return an integer for masking out the middle button from a
     buttonStates value"

    "/ should use ``Display button2MotionMask''

    ^ 512

    "Modified: 23.3.1996 / 12:41:43 / cg"
!

pointerPosition
    "return the current pointer position in root-window coordinates"

    |xpos ypos|

%{
    Window w;
    int screen = __intVal(__INST(screen));
    Window rootRet, childRet;
    int rootX, rootY, winX, winY;
    unsigned int mask;

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	BEGIN_INTERRUPTSBLOCKED
#ifdef VIRTUAL_ROOT
	w = getRootWindow(myDpy, screen);
#else
	w = RootWindow(dpy, screen);
#endif
	XQueryPointer(dpy, w, &rootRet, &childRet,
			      &rootX, &rootY,
			      &winX, &winY,
			      &mask);
	xpos = __MKSMALLINT(rootX);
	ypos = __MKSMALLINT(rootY);
	END_INTERRUPTSBLOCKED
    }
%}
.
    ^ xpos @ ypos
!

rightButtonStateMask
    "return an integer for masking out the right button from a
     buttonStates value"

    "/ should use ``Display button3MotionMask''

    ^ 1024

    "Modified: 23.3.1996 / 12:41:52 / cg"
!

rootPositionOfLastEvent
    "return the position in root-window coordinates
     of the last button, key or pointer event"

    ^ eventRootX @ eventRootY
! !

!XWorkstation methodsFor:'properties'!

getObjectProperty:propertyID from:aWindowID
    "get an object property from the server; return object or nil"

    self getProperty:propertyID from:aWindowID into:[:type :value |
	type == stringAtom ifTrue:[
	    ^ value
	].
	(value isMemberOf:ByteArray) ifTrue:[
	    ^ (Object readBinaryFrom:(ReadStream on:value) onError:[nil])
	]
    ].
    ^ nil

    "Modified: 6.4.1997 / 13:27:07 / cg"
!

getProperty:propertyID from:aWindowID into:aTwoArgBlock
    "get a property, evaluate aTwoArgBlock with typeID and value"

    |val typeID cls|

    cls := ByteArray.
%{
    Window window;
    Atom property;
    char *cp, *cp2;
    Atom actual_type;
    int actual_format,i;
    unsigned long nitems, bytes_after, nread;
    unsigned char *data;
    int ok = 1;
#   define PROP_SIZE    2048

    if (ISCONNECTED) {
	Display *dpy = myDpy;

	if (__isAtomID(propertyID)) {
	    property = _AtomVal(propertyID);
	    if (__isExternalAddress(aWindowID)) {
		window = _WindowVal(aWindowID);
	    } else {
		window = DefaultRootWindow(dpy);
	    }

	    nread = 0;
	    cp = 0;
/*
	    fprintf(stderr, "getProperty: ");
 */
	    do {
		if (XGetWindowProperty(dpy,window,property,nread/4,PROP_SIZE,False,
				       AnyPropertyType,&actual_type,&actual_format,
				       &nitems,&bytes_after,(unsigned char **)&data)
		    != Success) {
			ok = 0;
			break;
		}
		typeID = __MKATOMOBJ(actual_type);
		if (! cp) {
		    cp = cp2 = (char *)malloc(nitems+1);
		} else {
		    cp = (char *)realloc(cp, nread + nitems + 1);
		    cp2 = cp + nread;
		}
		if (! cp) {
		    XFree(data);
		    goto fail;
		}
    
		nread += nitems;
		bcopy(data, cp2, nitems);
		XFree(data);
    /*
		fprintf(stderr, "<nitems:%d bytes_after:%d>", nitems, bytes_after);
     */
	    } while (bytes_after > 0);
    /*
	    fprintf(stderr, "\n");
     */
    
	    if (ok) {
		if (actual_type == XA_STRING) {
		    cp[nread] = '\0';
		    val = __MKSTRING_L(cp, nread);
		} else {
		    val = __new(nread + OHDR_SIZE);
		    val->o_class = cls;
		    bcopy(cp, __ByteArrayInstPtr(val)->ba_element, nread);
		}
	    }
	    if (cp)
		free(cp);
	}
    }
fail: ;
%}.
    typeID isNil ifTrue:[
	^ false
    ].
    aTwoArgBlock value:typeID value:val.
    ^ true
!

getTextProperty:propertyID from:aWindowID
    "get a text property; return string or nil"

    self getProperty:propertyID from:aWindowID into:[:type :value |
	type == stringAtom ifTrue:[
	    ^ value
	]
    ].
    ^ nil
!

setLengthProperty:propertyID value:aNumber for:aWindowID
    "set a size property"

    ^ self 
	setProperty:propertyID 
	type:(self atomIDOfLENGTH)
	value:aNumber 
	for:aWindowID

    "Modified: 6.4.1997 / 13:27:26 / cg"
!

setObjectProperty:propertyID value:anObject for:aWindowID
    "set a property to a smalltalk object in the XServer.
     Can only be retrieved by another ST/X smalltalk"

    |s|

    (anObject isMemberOf:String) ifTrue:[
	^ self setTextProperty:propertyID value:anObject for:aWindowID
    ].
    s := WriteStream on:(ByteArray new:200).
    anObject storeBinaryOn:s.
    ^ self 
	setProperty:propertyID 
	type:(self atomIDOf:'ST_OBJECT' create:true) 
	value:(s contents) 
	for:aWindowID

    "Modified: 6.4.1997 / 13:27:57 / cg"
!

setProperty:propertyID type:typeID value:anObject for:aWindowID
    "set a property in the XServer"

%{  /* UNLIMITEDSTACK */

    Atom prop, type;
    Window window;
    unsigned int value;

    if (__isAtomID(propertyID)
     && __isAtomID(typeID) 
     && ISCONNECTED
     && (__isString(anObject) 
	 || __isSmallInteger(anObject) 
	 || __isSymbol(anObject) 
	 || __isByteArray(anObject)
	 || __isWords(anObject))) { 

	Display *dpy = myDpy;

	prop = _AtomVal(propertyID);
	type = _AtomVal(typeID);

	if (__isExternalAddress(aWindowID)) {
	    window = _WindowVal(aWindowID);
	} else {
	    window = DefaultRootWindow(dpy);
	}
	if (__isSmallInteger(anObject)) {
	    value = __intVal(anObject);
	    XChangeProperty(dpy, window, prop, type, 32,
			    PropModeReplace,
			    (unsigned char *)(&value), sizeof(unsigned int));
	} else {
	    if (__isByteArray(anObject)) {
		XChangeProperty(dpy, window, prop, type, 8,
				PropModeReplace,
				__ByteArrayInstPtr(anObject)->ba_element,
				__byteArraySize(anObject));
	    } else {
		/* string or symbol or wordArray-like (16bit-string) object */
		type = _AtomVal(typeID);
		if (__isWords(__qClass(anObject))) {
		    XChangeProperty(dpy, window, prop, type, 16,
				    PropModeReplace,
				    __stringVal(anObject),
				    __wordArraySize(anObject));
		} else {
		    XChangeProperty(dpy, window, prop, type, 8,
				    PropModeReplace,
				    __stringVal(anObject),
				    __stringSize(anObject));
		}
	    }
	}
	RETURN (true);
    }
%}.
    ^ false
!

setTextProperty:propertyID value:aString for:aWindowID
    "set a property to a stringValue in the XServer"

    ^ self 
	setProperty:propertyID 
	type:(self atomIDOfSTRING) 
	value:aString 
	for:aWindowID

    "Modified: 6.4.1997 / 13:26:32 / cg"
! !

!XWorkstation methodsFor:'resources'!

atomIDOf:aStringOrSymbol
    "return an Atoms ID; dont create if not already present.
     This is highly X specific and only for local use (with selections)."

    ^ self atomIDOf:aStringOrSymbol create:false

    "
     Display atomIDOf:'FACE_NAME'      
     Display atomIDOf:'FULL_NAME' 
     Display atomIDOf:'DndProtocol' 
     Display atomIDOf:'DndSelection' 
    "

    "Modified: 4.4.1997 / 13:38:48 / cg"
!

atomIDOf:aStringOrSymbol create:create
    "return an Atoms ID; if create is true, create it if not already present.
     This is highly X specific and only for local use (with selections)."

%{  /* NOCONTEXT */
    Atom prop;

    if (ISCONNECTED) {
	if (__isString(aStringOrSymbol)
	 || __isSymbol(aStringOrSymbol)) {
	    prop = XInternAtom(myDpy, _stringVal(aStringOrSymbol), 
				      (create == true) ? False : True);
	    if (prop == None) {
		RETURN (nil);
	    }
	    RETURN ( __MKATOMOBJ(prop) );
	}
    }
%}.
    self primitiveFailed.
    ^ nil

    "
     Display atomIDOf:'VT_SELECTION' create:false
     Display atomIDOf:'CUT_BUFFER0' create:false
     Display atomIDOf:'STRING' create:false
     Display atomIDOf:'PRIMARY' create:false
     Display atomIDOfPRIMARY
    "
!

atomIDOfCUTBUFFER0
    "return the CUTBUFFER0 AtomID.
     This is highly X specific and only for local use (with selections)."

    ^ cutBuffer0Atom

    "Modified: 2.3.1996 / 15:10:36 / cg"
!

atomIDOfLENGTH
    "return the LENGTH AtomID.
     This is highly X specific and only for local use (with selections)."

    ^ lengthAtom

    "Modified: 2.3.1996 / 15:10:41 / cg"
!

atomIDOfPRIMARY
    "return the PRIMARY AtomID.
     This is highly X specific and only for local use (with selections)."

    ^ primaryAtom

    "Modified: 2.3.1996 / 15:10:49 / cg"
!

atomIDOfSECONDARY
    "return the SECONDARY AtomID.
     This is highly X specific and only for local use (with selections)."

    ^ secondaryAtom

    "Modified: 2.3.1996 / 15:10:59 / cg"
!

atomIDOfSTRING
    "return the STRING AtomID.
     This is highly X specific and only for local use (with selections)."

    ^ stringAtom

    "Modified: 2.3.1996 / 15:11:08 / cg"
!

atomName:anAtomID
    "given an AtomID, return its name.
     This is highly X specific and only for local use (with selections)."

%{  /* NOCONTEXT */ 
    OBJ str;
    char *name;

    if (ISCONNECTED) {
	if (__isAtomID(anAtomID)) {
	    name = XGetAtomName(myDpy, _AtomVal(anAtomID));
	    if (name == 0) {
		RETURN (nil);
	    }
	    str = __MKSTRING(name);
	    XFree(name);
	    RETURN ( str );
	}
    }
%}.
    self primitiveFailed.
    ^ nil

    "
     Display atomName:1 
     Display atomName:130  '_DEC_DEVICE_FONTNAMES'
     Display atomName:132  'FONTNAME_REGISTRY'
     Display atomName:135 'FOUNDRY' 
     Display atomName:150  'CHARSET_REGISTRY'
     Display atomName:151  'ISO8859'
     Display atomName:152 'CHARSET_ENCODING'
     Display atomName:154 
    "
!

getResource:name class:cls
    "access the displays resource database for a default value
     of name in a resource class.
     This is highly X specific and  currently not used.

     Notice: 
	we do not plan to use X's resources for ST/X's defaults,
	styles or resources. This would make porting of applications
	to different platforms much more difficult (Windows has no resource
	database). If you stay within ST/X's resource files, these can be
	easily transported to other platforms.

     This method is provided for special applications which want to access
     existing X resources and are not planned to be ever ported to other
     platforms."

%{
    char *rslt;

    if ((__isString(name) || __isSymbol(name))
     && (__isString(cls) || __isSymbol(cls))
     && ISCONNECTED) {
	BEGIN_INTERRUPTSBLOCKED
	rslt = XGetDefault(myDpy, (char *)_stringVal(cls),
				  (char *)_stringVal(name));
	END_INTERRUPTSBLOCKED
	RETURN (rslt ? __MKSTRING(rslt) : nil );
    }
%}.
    self primitiveFailed.
    ^ nil

    "if your ~/.Xdefaults contains an entry such as:
	OpenWindows.Beep:       notices
     the following returns 'notices'.

	 Display getResource:'Beep' class:'OpenWindows'   

     if your ~/.Xdefaults contains an entry such as:
	*.beNiceToColormap:       false
     the following return 'false'.

	 Display getResource:'beNiceToColormap' class:'any'  
	 Display getResource:'beNiceToColormap' class:''  
    "
! !

!XWorkstation methodsFor:'retrieving pixels'!

getBitsFromId:aDrawableId x:srcx y:srcy width:w height:h into:imageBits
    "get bits from a drawable into the imageBits. The storage for the bits
     must be big enough for the data to fit. If ok, returns an array with some
     info and the bits in imageBits. The info contains the depth, bitOrder and
     number of bytes per scanline. The number of bytes per scanline is not known
     in advance, since the X-server is free to return whatever it thinks is a good padding."

    |rawInfo info|

    ((w <= 0) or:[h <= 0]) ifTrue:[
	self primitiveFailed.
	^ nil
    ].

    rawInfo := Array new:8.
		  "1 -> bit order"
		  "2 -> depth"
		  "3 -> bytes_per_line"
		  "4 -> byte_order"
		  "5 -> format"
		  "6 -> bitmap_unit"
		  "7 -> bitmap_pad"
		  "8 -> bits_per_pixel"

    "/ had to extract the getPixel call into a separate method, to specify
    "/ unlimitedStack (some implementations use alloca and require huge amounts
    "/ of temporary stack space

    (self primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:rawInfo) ifTrue:[
	info := IdentityDictionary new.
	info at:#bitOrder put:(rawInfo at:1).
	info at:#depth put:(rawInfo at:2).
	info at:#bytesPerLine put:(rawInfo at:3).
	info at:#byteOrder put:(rawInfo at:4).
	info at:#format put:(rawInfo at:5).
	info at:#bitmapUnit put:(rawInfo at:6).
	info at:#bitmapPad put:(rawInfo at:7).
	info at:#bitsPerPixel put:(rawInfo at:8).
	^ info
    ].
    "
     some error occured - either args are not smallintegers, imageBits is not a ByteArray
     or is too small to hold the bits
    "
    ^ self primitiveFailed
!

getPixelX:x y:y from:aDrawableId
    "return the pixel value at x/y; coordinates start at 0/0 for the upper left.
     Nil is returned for invalid coordinates or if any other problem arises."

%{  /* UNLIMITEDSTACK NOCONTEXT */

    Window win;
    XImage *img;
    int ret;
    int xpos, ypos;

    if (ISCONNECTED
     && __isExternalAddress(aDrawableId) && __bothSmallInteger(x, y)) {
	win = _WindowVal(aDrawableId);
	xpos = __intVal(x);
	ypos = __intVal(y);
	if ((xpos < 0) || (ypos < 0)) {
	    RETURN ( __MKSMALLINT(0) );
	}
	img = XGetImage(myDpy, win, xpos, ypos, 1, 1, (unsigned)~0, ZPixmap);
	if (img != 0) {
	    ret = XGetPixel(img, 0, 0);
	    XDestroyImage(img);
	    RETURN (  __MKSMALLINT(ret) );
	}
    }
%}.
    ^ nil
!

primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:info
    "since XGetImage may allocate huge amount of stack space 
     (some implementations use alloca), this must run with unlimited stack."

%{  /* UNLIMITEDSTACK */

    Window win;
    XImage *image = (XImage *)0;
    int pad, bytes_per_line, numBytes;

    if (ISCONNECTED
     && __isExternalAddress(aDrawableId)
     && __bothSmallInteger(srcx, srcy)
     && __bothSmallInteger(w, h)
     && __isArray(info)
     && __isByteArray(imageBits)) {
	Display *dpy = myDpy;

	win = _WindowVal(aDrawableId);
	image = XGetImage(dpy, win, __intVal(srcx), __intVal(srcy),
				    __intVal(w), __intVal(h),
				    (unsigned)AllPlanes, ZPixmap);

	if (! image) {
	    RETURN ( false );
	}

	pad = image->bitmap_pad;
#ifdef SUPERDEBUG
	printf("pad:%d depth:%d\n", image->bitmap_pad, image->depth);
#endif
	switch (image->depth) {
	    case 1:
	    case 2:
	    case 4:
	    case 8:
	    case 16:
	    case 24:
	    case 32:
		numBytes = image->bytes_per_line * image->height;
		break;
	    default:
		/* unsupported depth ? */
		printf("possibly unsupported depth:%d in primGetBits\n", image->depth);
		numBytes = image->bytes_per_line * image->height;
		break;
	}

#ifdef SUPERDEBUG
	printf("bytes need:%d bytes given:%d\n", numBytes, __byteArraySize(imageBits));
#endif

	if (numBytes > __byteArraySize(imageBits)) {
	    /* imageBits too small */
	    printf("provided byteArray too small\n");
	    goto fail;
	}
	if (image->bitmap_bit_order == MSBFirst)
	    __ArrayInstPtr(info)->a_element[0] = @symbol(msbFirst);
	else
	    __ArrayInstPtr(info)->a_element[0] = @symbol(lsbFirst);
	__ArrayInstPtr(info)->a_element[1] = __MKSMALLINT(image->depth);
	__ArrayInstPtr(info)->a_element[2] = __MKSMALLINT(image->bytes_per_line);
	if (image->byte_order == MSBFirst)
	    __ArrayInstPtr(info)->a_element[3] = @symbol(msbFirst);
	else
	    __ArrayInstPtr(info)->a_element[3] = @symbol(lsbFirst);
	if (image->format == XYBitmap)
	    __ArrayInstPtr(info)->a_element[4] = @symbol(XYBitmap);
	else if (image->format == XYPixmap)
	    __ArrayInstPtr(info)->a_element[4] = @symbol(XYPixmap);
	else if (image->format == ZPixmap)
	    __ArrayInstPtr(info)->a_element[4] = @symbol(ZPixmap);
        
	__ArrayInstPtr(info)->a_element[5] = __MKSMALLINT(image->bitmap_unit);
	__ArrayInstPtr(info)->a_element[6] = __MKSMALLINT(image->bitmap_pad);
	__ArrayInstPtr(info)->a_element[7] = __MKSMALLINT(image->bits_per_pixel);
	bcopy(image->data, __ByteArrayInstPtr(imageBits)->ba_element, numBytes);
	XDestroyImage(image);
	RETURN ( true );
    }
fail: 
    if (image) {
	XDestroyImage(image);
    }
%}.
    ^ false
! !

!XWorkstation methodsFor:'selections'!

getSelectionFor:drawableId
    "get the object selection -  either immediate, or asynchronous.
     Returns nil, if async request is on its way"

    |selProp sel|

    (self getSelectionOwnerOf:primaryAtom) isNil ifTrue:[
	"no primary selection - use cut buffer"
	sel := self getObjectProperty:cutBuffer0Atom from:nil.
	^ sel
    ].
    selProp := self atomIDOf:'ST_SELECTION' create:true.
    self requestObjectSelection:primaryAtom property:selProp for:drawableId.
    ^ nil
!

getSelectionOwnerOf:selectionAtomID
    "get the owner of a selection"

%{  /* NOCONTEXT */
    Atom selection;
    Window window;

    if (__isAtomID(selectionAtomID) && ISCONNECTED) {
	Display *dpy = myDpy;

	window = XGetSelectionOwner(dpy, _AtomVal(selectionAtomID));
	RETURN ((window == None) ? nil : __MKOBJ(window));
    }
%}.
     self primitiveFailed.
    ^ nil
!

getTextSelectionFor:drawableId
    "get the text selection -  either immediate, or asynchronous.
     Returns nil, if async request is on its way"

    |selProp sel|

    (self getSelectionOwnerOf:primaryAtom) isNil ifTrue:[
	"no primary selection - use cut buffer"
	sel := self getTextProperty:cutBuffer0Atom from:nil.
	^ sel
    ].
    selProp := self atomIDOf:'VT_SELECTION' create:true.
    self requestTextSelection:primaryAtom property:selProp for:drawableId.
    ^ nil
!

requestObjectSelection:selectionID property:propertyID for:aWindowId
    "ask the server to send us the selection - the view with ID aWindowID
     will later receive a SelectionNotify event for it."

    ^ self requestSelection:selectionID 
		   property:propertyID 
		   type:(self atomIDOf:'ST_OBJECT' create:true) 
		   for:aWindowId
!

requestSelection:selectionID property:propertyID type:typeID for:aWindowId
    "ask the server to send us the selection - the view with id aWindowID
     will later receive a SelectionNotify event for it (once the Xserver replies
     with the selections value)."

%{  /* NOCONTEXT */
    Atom sel_prop;
    char *cp;

    if (__isExternalAddress(aWindowId)
     && ISCONNECTED
     && __isSmallInteger(typeID)
     && __isAtomID(selectionID)) {
	Display *dpy = myDpy;

	if (XGetSelectionOwner(dpy, _AtomVal(selectionID)) == None) {
	    /*
	     * no owner of primary selection
	     */
	    RETURN (false);
	}
	/*
	 * PRIMARY selection
	 */
	XConvertSelection(dpy, _AtomVal(selectionID), _AtomVal(typeID), 
			       _AtomVal(propertyID), _WindowVal(aWindowId), CurrentTime);
	RETURN (true);
    }
%}.
    self primitiveFailed.
    ^ false

    "
     Display requestSelection:(Display atomIDOf:'PRIMARY')
		     property:(Display atomIDOf:'VT_SELECTION')
			  for:0
    "
!

requestTextSelection:selectionID property:propertyID for:aWindowId
    "ask the server to send us the selection - the view with ID aWindowID
     will later receive a SelectionNotify event for it."

    ^ self requestSelection:selectionID 
		   property:propertyID 
		       type:stringAtom 
			for:aWindowId
!

sendSelection:something property:propertyID target:targetID from:windowID to:requestorID
    "send aString back from a SelectionRequest"

    self 
	sendSelection:something 
	selection:primaryAtom
	property:propertyID 
	target:targetID 
	from:windowID 
	to:requestorID
!

sendSelection:something selection:selectionID property:propertyID target:targetID from:windowID to:requestorID
    "send aString back from a SelectionRequest"

    self 
	setProperty:propertyID 
	type:targetID 
	value:something 
	for:requestorID.
    self 
	sendSelectionNotifySelection:selectionID 
	property:propertyID 
	target:targetID 
	from:requestorID 
	to:requestorID.
!

sendSelectionNotifySelection:selectionID property:propertyID target:targetID from:windowID to:requestorID
    "send a selectionNotify back from a SelectionRequest"

%{  /* NOCONTEXT */

    if (__isAtomID(propertyID)
     && __isExternalAddress(requestorID)
     && ISCONNECTED
     && __isAtomID(targetID)
     && __isAtomID(selectionID)) {
	Display *dpy = myDpy;
	XEvent ev;
	Window requestor = _WindowVal(requestorID);
	Atom property = _AtomVal(propertyID);
	Atom target = _AtomVal(targetID);
	Atom selection = _AtomVal(selectionID);
	Status result;

	ev.xselection.type = SelectionNotify;
	ev.xselection.selection = selection;
	ev.xselection.target = target;
	if (__isExternalAddress(windowID))
	    ev.xselection.requestor = _WindowVal(windowID);
	else
	    ev.xselection.requestor = DefaultRootWindow(dpy);
	ev.xselection.time = CurrentTime;
	if (property == None)
	    ev.xselection.property = target;
	else
	    ev.xselection.property = property;

	DPRINTF(("sending SelectionNotify sel=%x prop=%x target=%x requestor=%x to %x\n",
		ev.xselection.selection,
		ev.xselection.property,
		ev.xselection.target,
		ev.xselection.requestor,
		requestor));

	result = XSendEvent(dpy, requestor, False, 0 , &ev);
	if ((result == BadValue) || (result == BadWindow)) {
	    DPRINTF(("bad status\n"));
	    RETURN (false);
	}
	RETURN (true)
    }
%}.
    self primitiveFailed.
    ^ false
!

setSelection:anObject owner:aWindowId
    "set the object selection, and make aWindowId be the owner.
     This can be used by other Smalltalk(X) applications only."

    (self setSelectionOwner:aWindowId of:primaryAtom) ifFalse:[
	^ false
    ].
"/    ^ self setObjectProperty:cutBuffer0Atom value:anObject for:nil
    ^ true
!

setSelectionOwner:aWindowId of:selectionID
    "set the owner of a selection; return false if failed"

%{  /* NOCONTEXT */
    Window win;

    if (__isExternalAddress(aWindowId)
     && __isAtomID(selectionID)
     && ISCONNECTED) {
	Display *dpy = myDpy;

	win = _WindowVal(aWindowId);
	XSetSelectionOwner(dpy, _AtomVal(selectionID), win, CurrentTime);
	if (XGetSelectionOwner(dpy, _AtomVal(selectionID)) != win) {
	    RETURN (false);
	}
	RETURN (true);
    }
%}
.
    self primitiveFailed.
    ^ nil
!

setTextSelection:aString owner:aWindowId
    "set the text selection, and make aWindowId be the owner.
     This can be used by any other X application."

    (self setSelectionOwner:aWindowId of:primaryAtom) ifFalse:[
	'XWorkstation [warning]: selection ownerchange failed' errorPrintCR.
    ].
    ^ self setTextProperty:cutBuffer0Atom value:aString for:nil

    "Modified: 10.1.1997 / 18:18:00 / cg"
! !

!XWorkstation methodsFor:'window stuff'!

clearRectangleX:x y:y width:width height:height in:aWindowId
    "clear a rectangular area to viewbackground"

%{  /* NOCONTEXT */

    int w, h;

    if (ISCONNECTED) {
	if (__isExternalAddress(aWindowId)
	 && __bothSmallInteger(x, y)
	 && __bothSmallInteger(width, height)) {
	    w = __intVal(width);
	    h = __intVal(height);
	    /*
	     * need this check here: some servers simply dump core with bad args
	     */
	    if ((w >= 0) && (h >= 0)) {
		XClearArea(myDpy, _WindowVal(aWindowId), __intVal(x), __intVal(y), w, h, 0);
	    }
	    RETURN ( self );
	}
    }
%}
.
    self primitiveFailed
!

clearWindow:aWindowId
    "clear a window to viewbackground"

%{  /* NOCONTEXT */

    if (ISCONNECTED) {
	if (__isExternalAddress(aWindowId)) {
	    XClearWindow(myDpy, _WindowVal(aWindowId));
	    RETURN ( self );
	}
    }
%}
.
    self primitiveFailed
!

configureWindow:aWindowId sibling:siblingId stackMode:modeSymbol
    "configure stacking operation of aWindowId w.r.t siblingId"

%{  /* NOCONTEXT */

    XWindowChanges chg;
    int mask = CWSibling | CWStackMode;

    if (ISCONNECTED) {
	if (__isExternalAddress(aWindowId)
	 && __isExternalAddress(siblingId)) {
	    if (modeSymbol == @symbol(above)) {
		chg.stack_mode = Above;
	    } else if (modeSymbol == @symbol(below)) {
		chg.stack_mode = Below;
	    } else if (modeSymbol == @symbol(topIf)) {
		chg.stack_mode = TopIf;
	    } else if (modeSymbol == @symbol(bottomIf)) {
		chg.stack_mode = BottomIf;
	    } else if (modeSymbol == @symbol(opposite)) {
		chg.stack_mode = Opposite;
	    } else {
		mask = CWSibling;
	    }

	    chg.sibling = _WindowVal(siblingId);
	    XConfigureWindow(myDpy, _WindowVal(aWindowId),
				    mask, &chg);
	    RETURN ( self );
	}
    }
bad: ;
%}
.
    self primitiveFailed
!

lowerWindow:aWindowId
    "bring a window to back"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	XLowerWindow(myDpy, _WindowVal(aWindowId));
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos width:w height:h
    "make a window visible - either as icon or as a real view - needed for restart"

    |wicon wiconId wiconView wiconViewId wlabel|

    aBoolean ifTrue:[
	wicon := aView icon.
	wicon notNil ifTrue:[
	    wiconId := wicon id
	].
	wiconView := aView iconView.
	wiconView notNil ifTrue:[
	    wiconViewId := wiconView id
	].
	wlabel := aView label.
    ].
%{  

    XWMHints wmhints;
    XSizeHints szhints;
    Window win;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	Display *dpy = myDpy;

	win = _WindowVal(aWindowId);

	szhints.flags = 0;
	if (__bothSmallInteger(xPos, yPos)) {
	    szhints.x = __intVal(xPos);
	    szhints.y = __intVal(yPos);
	    szhints.flags |= USPosition;
	}
	if (__bothSmallInteger(w, h)) {
	    szhints.width = __intVal(w);
	    szhints.height = __intVal(h);
	    szhints.flags |= USSize;
	}

	if (aBoolean == true) {
	    char *windowName;
	    Pixmap iconBitmap = (Pixmap)0;
	    Window iconWindow;

	    if (__isExternalAddress(wiconId))
		iconBitmap = _PixmapVal(wiconId);
	    else
		iconBitmap = (Pixmap)0;

	    if (__isExternalAddress(wiconViewId))
		iconWindow = _WindowVal(wiconViewId);
	    else
		iconWindow = (Window)0;

	    if (__isString(wlabel) || __isSymbol(wlabel))
		windowName = (char *)_stringVal(wlabel);
	    else
		windowName = "";

	    if (iconBitmap || windowName) {
		XSetStandardProperties(dpy, win,
					windowName, windowName,
					iconBitmap,
					0, 0, &szhints);
	    }

	    wmhints.flags = 0;
	    if (iconBitmap) {
		wmhints.flags |= IconPixmapHint;
		wmhints.icon_pixmap = iconBitmap;
	    }
	    if (iconWindow) {
		wmhints.flags |= IconWindowHint;
		wmhints.icon_window = iconWindow;
	    }

	    wmhints.initial_state = IconicState;
	    wmhints.flags |= StateHint;
	    XSetWMHints(dpy, win, &wmhints);
	}

	if (szhints.flags) {
	    XSetNormalHints(dpy, win, &szhints);
	}

	XMapWindow(dpy, win);
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

mapWindow:aWindowId
    "make a window visible"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	XMapWindow(myDpy, _WindowVal(aWindowId));
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

moveResizeWindow:aWindowId x:x y:y width:w height:h
    "move and resize a window"

%{  /* NOCONTEXT */

    int newWidth, newHeight;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __bothSmallInteger(w, h)
     && __bothSmallInteger(x, y)) {
	newWidth = __intVal(w);
	newHeight = __intVal(h);
	if (newWidth < 1) newWidth = 1;
	if (newHeight < 1) newHeight = 1;
	XMoveResizeWindow(myDpy, _WindowVal(aWindowId),
			      __intVal(x), __intVal(y),
			      newWidth, newHeight);
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

moveWindow:aWindowId x:x y:y
    "move a window"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId) && __bothSmallInteger(x, y)) {
	XMoveWindow(myDpy, _WindowVal(aWindowId), __intVal(x), __intVal(y));
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

raiseWindow:aWindowId
    "bring a window to front"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	XRaiseWindow(myDpy, _WindowVal(aWindowId));
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

resizeWindow:aWindowId width:w height:h
    "resize a window"

%{  /* NOCONTEXT */

    int newWidth, newHeight;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId) && __bothSmallInteger(w, h)) {
	newWidth = __intVal(w);
	newHeight = __intVal(h);
	if (newWidth < 1) newWidth = 1;
	if (newHeight < 1) newHeight = 1;
	XResizeWindow(myDpy, _WindowVal(aWindowId), newWidth, newHeight);
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

setBackingStore:how in:aWindowId
    "turn on/off backing-store for a window"

%{  /* NOCONTEXT */

    XSetWindowAttributes wa;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	if (__INST(ignoreBackingStore) != true) {
	    if (how == @symbol(always)) wa.backing_store = Always;
	    else if (how == @symbol(whenMapped)) wa.backing_store = WhenMapped;
	    else if (how == true) wa.backing_store = Always;
	    else wa.backing_store = 0;
	    BEGIN_INTERRUPTSBLOCKED
	    XChangeWindowAttributes(myDpy, _WindowVal(aWindowId), CWBackingStore, &wa);
	    END_INTERRUPTSBLOCKED
	}
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setBitGravity:how in:aWindowId
    "set bit gravity for a window"

%{  /* NOCONTEXT */

    XSetWindowAttributes wa;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	if (how == @symbol(NorthWest)) {
	    wa.bit_gravity = NorthWestGravity;
	} else if (how == @symbol(NorthEast)) {
	    wa.bit_gravity = NorthEastGravity;
	} else if (how == @symbol(SouthWest)) {
	    wa.bit_gravity = SouthWestGravity;
	} else if (how == @symbol(SouthEast)) {
	    wa.bit_gravity = SouthEastGravity;
	} else if (how == @symbol(Center)) {
	    wa.bit_gravity = CenterGravity;
	} else if (how == @symbol(North)) {
	    wa.bit_gravity = NorthGravity;
	} else if (how == @symbol(South)) {
	    wa.bit_gravity = SouthGravity;
	} else if (how == @symbol(West)) {
	    wa.bit_gravity = WestGravity;
	} else if (how == @symbol(East)) {
	    wa.bit_gravity = EastGravity;
	} else {
	    wa.bit_gravity = NorthWestGravity;
	}

	BEGIN_INTERRUPTSBLOCKED
	XChangeWindowAttributes(myDpy, _WindowVal(aWindowId), CWBitGravity, &wa);
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setCursor:aCursorId in:aWindowId
    "define a windows cursor"

%{  /* NOCONTEXT */

    Display *dpy = myDpy;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isExternalAddress(aCursorId)) {
	XDefineCursor(dpy, _WindowVal(aWindowId), _CursorVal(aCursorId));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setIconName:aString in:aWindowId
    "define a windows iconname"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && (__isString(aString) || __isSymbol(aString))) {
	XSetIconName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setSaveUnder:yesOrNo in:aWindowId
    "turn on/off save-under for a window"

%{  /* NOCONTEXT */

    XSetWindowAttributes wa;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	if (__INST(hasSaveUnder) == true) {
	    wa.save_under = (yesOrNo == true) ? 1 : 0;
	    XChangeWindowAttributes(myDpy, _WindowVal(aWindowId), CWSaveUnder, &wa);
	}
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setTransient:aWindowId for:aMainWindowId
    "set aWindowId to be a transient of aMainWindow"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	Window w;

	if ((aMainWindowId == nil) || (aMainWindowId == __MKSMALLINT(0))) {
	    w = (Window) 0;
	} else {
	    if (__isExternalAddress(aMainWindowId)) {
		w = _WindowVal(aMainWindowId);
	    } else {
		goto getOutOfHere;
	    }
	}
	XSetTransientForHint(myDpy, _WindowVal(aWindowId), w);
	RETURN ( self );
    }
 getOutOfHere: ;
%}.
    self primitiveFailed
!

setWindowBackground:aColorIndex in:aWindowId
    "set the windows background color. This is the color with which
     the view is filled whenever exposed. Do not confuse this with
     the background drawing color, which is used with opaque drawing."

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isSmallInteger(aColorIndex)) {
	XSetWindowBackground(myDpy, _WindowVal(aWindowId), __intVal(aColorIndex));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowBackgroundPixmap:aPixmapId in:aWindowId
    "set the windows background pattern to be a form.
     This is the pattern with which the view is filled whenever exposed. 
     Do not confuse this with the background drawing color, which is used 
     with opaque drawing."

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isExternalAddress(aPixmapId)) {
	XSetWindowBackgroundPixmap(myDpy, _WindowVal(aWindowId), _PixmapVal(aPixmapId));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowBorderColor:aColorIndex in:aWindowId
    "set the windows border color"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isSmallInteger(aColorIndex)) {
	XSetWindowBorder(myDpy, _WindowVal(aWindowId), __intVal(aColorIndex));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowBorderPixmap:aPixmapId in:aWindowId
    "set the windows border pattern"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isExternalAddress(aPixmapId)) {
	XSetWindowBorderPixmap(myDpy, _WindowVal(aWindowId), _PixmapVal(aPixmapId));
	RETURN ( self );
    }
%}
.
    self primitiveFailed
!

setWindowBorderShape:aPixmapId in:aWindowId
    "set the windows border shape"

    hasShapeExtension ifFalse:[^ self].

%{  /* NOCONTEXT */

#ifdef SHAPE
    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isExternalAddress(aPixmapId)) {
	XShapeCombineMask(myDpy, _WindowVal(aWindowId), ShapeBounding,
			  0, 0, _PixmapVal(aPixmapId), ShapeSet);
	RETURN ( self );
    }
#endif
%}.
    self primitiveFailed
!

setWindowBorderWidth:aNumber in:aWindowId
    "set the windows border width"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isSmallInteger(aNumber)) {
	XSetWindowBorderWidth(myDpy, _WindowVal(aWindowId), __intVal(aNumber));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowClass:wClass name:wName in:aWindowId
    "define class and name of a window.
     This may be used by the window manager to
     select client specific resources."

%{
    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	XClassHint classhint;

	classhint.res_class = classhint.res_name = 0;

	if (__isString(wClass) || __isSymbol(wClass)) {
	    classhint.res_class = (char *)_stringVal(wClass);
	} else if (wClass != nil)
	    goto error;

	if (__isString(wName) || __isSymbol(wName)) {
	    classhint.res_name = (char *)_stringVal(wName);
	} else if (wName != nil)
	    goto error;

	XSetClassHint(myDpy, _WindowVal(aWindowId), &classhint);
	RETURN ( self );
error:;
    }
%}.
    self primitiveFailed
!

setWindowGravity:how in:aWindowId
    "set window gravity for a window"

%{  /* NOCONTEXT */

    XSetWindowAttributes wa;

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	if (how == @symbol(NorthWest)) {
	    wa.win_gravity = NorthWestGravity;
	} else if (how == @symbol(NorthEast)) {
	    wa.win_gravity = NorthEastGravity;
	} else if (how == @symbol(SouthWest)) {
	    wa.win_gravity = SouthWestGravity;
	} else if (how == @symbol(SouthEast)) {
	    wa.win_gravity = SouthEastGravity;
	} else if (how == @symbol(Center)) {
	    wa.win_gravity = CenterGravity;
	} else if (how == @symbol(North)) {
	    wa.win_gravity = NorthGravity;
	} else if (how == @symbol(South)) {
	    wa.win_gravity = SouthGravity;
	} else if (how == @symbol(West)) {
	    wa.win_gravity = WestGravity;
	} else if (how == @symbol(East)) {
	    wa.win_gravity = EastGravity;
	} else {
	    wa.win_gravity = NorthWestGravity;
	}

	BEGIN_INTERRUPTSBLOCKED
	XChangeWindowAttributes(myDpy, _WindowVal(aWindowId), CWWinGravity, &wa);
	END_INTERRUPTSBLOCKED
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowIcon:aForm in:aWindowId
    "define a bitmap to be used as icon"

    |iconId|

    aForm notNil ifTrue:[
	iconId := aForm id
    ].
%{
    if (ISCONNECTED
     && __isExternalAddress(iconId)
     && __isExternalAddress(aWindowId)) {
	XWMHints hints;

	hints.icon_pixmap = _PixmapVal(iconId);
	hints.flags = IconPixmapHint;
	XSetWMHints(myDpy, _WindowVal(aWindowId), &hints);
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowIcon:aForm mask:aMaskForm in:aWindowId
    "define a windows icon and (optional) iconMask."

    |iconId maskId|

    aForm notNil ifTrue:[
	iconId := aForm id
    ].
    aMaskForm notNil ifTrue:[
	maskId := aMaskForm id.
    ].
%{
    if (ISCONNECTED
     && __isExternalAddress(iconId)
     && __isExternalAddress(aWindowId)) {
	XWMHints hints;

	hints.icon_pixmap = _PixmapVal(iconId);
	hints.flags = IconPixmapHint;
	if ((maskId != nil)
	 && __isExternalAddress(maskId)) {
	    hints.icon_mask = _PixmapVal(maskId);
	    hints.flags |= IconMaskHint;
	}
	XSetWMHints(myDpy, _WindowVal(aWindowId), &hints);
	RETURN ( self );
    }
%}.
    self primitiveFailed

!

setWindowIconWindow:aView in:aWindowId
    "define a window to be used as icon"

    |iconWindowId|

    aView notNil ifTrue:[
	iconWindowId := aView id
    ].
%{
    if (ISCONNECTED
     && __isExternalAddress(iconWindowId)
     && __isExternalAddress(aWindowId)) {
	XWMHints wmhints;

	wmhints.icon_window = _WindowVal(iconWindowId);
	wmhints.flags = IconWindowHint;
	XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowName:aString in:aWindowId
    "define a windows name"

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && (__isString(aString) || __isSymbol(aString))) {
	XStoreName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

setWindowShape:aPixmapId in:aWindowId
    "set the windows shape"

    hasShapeExtension ifFalse:[^ self].

%{  /* NOCONTEXT */

#ifdef SHAPE
    if (ISCONNECTED
     && __isExternalAddress(aWindowId)
     && __isExternalAddress(aPixmapId)) {
	XShapeCombineMask(myDpy, _WindowVal(aWindowId), ShapeClip,
			  0, 0,
			  _PixmapVal(aPixmapId), ShapeSet);
	RETURN ( self );
    }
#endif
%}.
    self primitiveFailed
!

unmapWindow:aWindowId
    "make a window invisible"

%{  /* NOCONTEXT */

    if (!ISCONNECTED) {
	RETURN ( self );
    }

    if (__isExternalAddress(aWindowId)) {
	XUnmapWindow(myDpy, _WindowVal(aWindowId));
	RETURN ( self );
    }
%}.
    self primitiveFailed
!

windowIsIconified:aWindowId
    "return true, if some window is iconified.
     The passed windowID may be an alien windows id."

%{  /* NOCONTEXT */

    if (ISCONNECTED
     && __isExternalAddress(aWindowId)) {
	Atom JunkAtom;
	int JunkInt;
	unsigned long WinState,JunkLong;
	unsigned char *Property;
	Atom WM_STATE_Atom;

	if (__INST(wmStateAtom) != nil) {
	    WM_STATE_Atom = _AtomVal(__INST(wmStateAtom));

	    XGetWindowProperty(myDpy, _WindowVal(aWindowId),
			       WM_STATE_Atom,
			       0L, 2L, False, AnyPropertyType,
			       &JunkAtom,&JunkInt,&WinState,&JunkLong,
			       &Property);
	    WinState=(unsigned long)(*((long*)Property));
	    if (WinState==3) {
		RETURN (true);
	    }
	}
	RETURN (false);
    }
%}.
    self primitiveFailed



! !

!XWorkstation class methodsFor:'documentation'!

version
    ^ '$Header: /cvs/stx/stx/libview/Attic/XWorkstat.st,v 1.244 1997-05-06 12:47:24 cg Exp $'
! !
XWorkstation initialize!