--- a/XWorkstation.st Sun Dec 10 01:17:06 1995 +0100
+++ b/XWorkstation.st Sun Dec 10 01:21:44 1995 +0100
@@ -11,65 +11,21 @@
"
DeviceWorkstation subclass:#XWorkstation
- instanceVariableNames:'screen
- hasShapeExtension hasFaxExtension hasShmExtension
- hasDPSExtension hasMbufExtension hasXVideoExtension
- hasSaveUnder hasPEXExtension hasImageExtension
- hasInputExtension ignoreBackingStore
- blackpixel whitepixel
- protocolsAtom deleteWindowAtom saveYourselfAtom
- quitAppAtom
- primaryAtom secondaryAtom cutBuffer0Atom
- stringAtom lengthAtom
- listOfXFonts buttonsPressed
- eventRootX eventRootY
- displayName eventTrace
- dispatchingExpose
- rgbVisual virtualRootId rootId
- eventBuffer
- altModifierMask metaModifierMask'
- classVariableNames: 'RawKeysymTranslation'
- poolDictionaries:''
- category:'Interface-Graphics'
-!
-
-!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.
-"
-!
-
-version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.87 1995-12-07 22:06:45 cg Exp $'
-!
-
-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.
-"
-! !
+ instanceVariableNames:'screen hasShapeExtension hasFaxExtension hasShmExtension
+ hasDPSExtension hasMbufExtension hasXVideoExtension hasSaveUnder
+ hasPEXExtension hasImageExtension hasInputExtension
+ ignoreBackingStore blackpixel whitepixel protocolsAtom
+ deleteWindowAtom saveYourselfAtom quitAppAtom primaryAtom
+ secondaryAtom cutBuffer0Atom stringAtom lengthAtom listOfXFonts
+ buttonsPressed eventRootX eventRootY displayName eventTrace
+ dispatchingExpose rgbVisual virtualRootId rootId eventBuffer
+ altModifierMask metaModifierMask'
+ classVariableNames:'RawKeysymTranslation'
+ poolDictionaries:''
+ category:'Interface-Graphics'
+!
!XWorkstation primitiveDefinitions!
-
%{
/*
* x does a typedef Time - I need Object Time ...
@@ -222,7 +178,6 @@
! !
!XWorkstation primitiveVariables!
-
%{
/*
* remembered info from private error handler
@@ -238,7 +193,6 @@
! !
!XWorkstation primitiveFunctions!
-
%{
/*
* catch X-errors and forward as errorInterrupt:#DisplayError,
@@ -326,6 +280,37 @@
%}
! !
+!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.
+"
+! !
+
!XWorkstation class methodsFor:'initialization'!
initialize
@@ -355,27 +340,6 @@
%}
!
-requestCodeOfLastError
-%{ /* NOCONTEXT */
-
- RETURN ( _MKSMALLINT(lastRequestCode) );
-%}
-!
-
-minorCodeOfLastError
-%{ /* NOCONTEXT */
-
- RETURN ( _MKSMALLINT(lastMinorCode) );
-%}
-!
-
-resourceIdOfLastError
-%{ /* NOCONTEXT */
-
- RETURN ( __MKOBJ(lastResource) );
-%}
-!
-
errorStringOfLastError
%{
RETURN ( __MKSTRING(lastErrorMsg COMMA_CON) );
@@ -405,580 +369,27 @@
s close.
].
^ string
-! !
-
-!XWorkstation methodsFor:'initialize / release'!
-
-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|
-
- dpyName := aDisplayName.
- dpyName isNil ifTrue:[
- "look for a '-display xxx' argument"
- Arguments 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;
- int shapeEventBase, shapeErrorBase;
- int shmEventBase, shmErrorBase;
- int faxEventBase, faxErrorBase;
- 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") COMMA_CON);
- nm = NULL;
- }
- dpy = XOpenDisplay(nm);
-
- if (dpy) {
- _INST(displayId) = dpyID = __MKOBJ(dpy); __STORE(self, dpyID);
-
-#ifdef SUPERDEBUG
- XSynchronize(dpy, 1);
-#endif
-
- XSetErrorHandler(__XErrorHandler__);
- }
-
- END_INTERRUPTSBLOCKED
-%}.
- displayId isNil ifTrue:[
- 'XWORKSTATION: cannot connect to Display.' errorPrintNL.
- ^ 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 initializeDefaultValues.
- self initializeEventBuffer.
- self initializeSpecialFlags.
- self initializeKeyboardMap.
-
- ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayError.
-!
-
-initializeDefaultValues
- buttonTranslation := ButtonTranslation.
- multiClickTimeDelta := MultiClickTimeDelta.
-
- self initializeModifierMappings
-!
-
-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.
-
- 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"
-!
-
-initializeEventBuffer
- |sz|
-
-%{
- sz = _MKSMALLINT(sizeof(XEvent) + 100);
-%}.
- eventBuffer isNil ifTrue:[
- eventBuffer := ByteArray new:sz.
- ].
-!
-
-initializeScreenProperties
+!
+
+minorCodeOfLastError
+%{ /* NOCONTEXT */
+
+ RETURN ( _MKSMALLINT(lastMinorCode) );
+%}
+!
+
+requestCodeOfLastError
%{ /* NOCONTEXT */
- Display *dpy = myDpy;
- 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;
- int faxEventBase, faxErrorBase;
- char *type, *nm;
- int dummy;
- int mask, shift, nBits;
-
- if (ISCONNECTED) {
- _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, &shapeEventBase, &shapeErrorBase))
- _INST(hasShapeExtension) = true;
- else
-#endif
- _INST(hasShapeExtension) = false;
-
-#ifdef SHM
- if (XShmQueryExtension(dpy, &shmEventBase, &shmErrorBase))
- _INST(hasShmExtension) = true;
- else
-#endif
- _INST(hasShmExtension) = false;
-
-#ifdef FAX
- if (XFAXImageQueryExtension(dpy, &faxEventBase, &faxErrorBase))
- _INST(hasFaxExtension) = true;
- else
-#endif
- _INST(hasFaxExtension) = 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
-
- END_INTERRUPTSBLOCKED
- }
+ RETURN ( _MKSMALLINT(lastRequestCode) );
%}
!
-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.
- ].
-!
-
-close
- "close down the connection to the X-server"
-
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- BEGIN_INTERRUPTSBLOCKED
- XCloseDisplay(myDpy);
- _INST(displayId) = nil;
- END_INTERRUPTSBLOCKED
- }
-%}
-!
-
-reinitialize
- virtualRootId := rootId := nil.
- super reinitialize.
- dispatchingExpose := nil
-! !
-
-!XWorkstation methodsFor:'misc'!
-
-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."
-
+resourceIdOfLastError
%{ /* 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
-!
-
-unBuffered
- "make all drawing be sent immediately to the display"
-
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- BEGIN_INTERRUPTSBLOCKED
- XSynchronize(myDpy, 1);
- END_INTERRUPTSBLOCKED
- }
-%}
- "Display unbuffered"
-!
-
-buffered
- "buffer drawing - do not send it immediately to the display.
- This is the default anyway."
-
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- BEGIN_INTERRUPTSBLOCKED
- XSynchronize(myDpy, 0);
- END_INTERRUPTSBLOCKED
- }
+
+ RETURN ( __MKOBJ(lastResource) );
%}
- "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)"
-
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- BEGIN_INTERRUPTSBLOCKED
- XSync(myDpy, 0);
- END_INTERRUPTSBLOCKED
- }
-%}
-!
-
-flushDpsContext:aDPSContext
-
-%{ /* NOCONTEXT */
-#ifdef DPS
- if (__isExternalAddress(aDPSContext)) {
- BEGIN_INTERRUPTSBLOCKED
- DPSFlushContext(MKDPSCONTEXT(aDPSContext));
- END_INTERRUPTSBLOCKED
- RETURN ( self );
- }
-#endif
-%}
-.
- self primitiveFailed
-!
-
-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
- }
-%}
-!
-
-beep
- "output an audible beep or bell"
-
- self beep:50
-!
-
-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
! !
!XWorkstation class methodsFor:'queries'!
@@ -990,24 +401,82 @@
^ 'X' "I don't know what ST-80 returns for X ..."
! !
-!XWorkstation methodsFor:'keyboard mapping'!
-
-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:'accessing & queries'!
+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
+!
+
+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));
+%}
+!
+
+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
+!
+
+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"
@@ -1029,91 +498,6 @@
^ displayName
!
-serverVendor
- "return the X-server vendor string - this should normally not be of
- any interrest, but can be for special cases
- (to avoid bugs in certain implementations)"
-%{
- if (ISCONNECTED) {
- RETURN ( __MKSTRING(XServerVendor(myDpy) COMMA_CON) );
- }
- RETURN (nil);
-%}
-
- "
- Display serverVendor
- "
-!
-
-vendorRelease
- "return the X-servers vendor release - should normally not be of
- any interrest, but can be for special cases.
- (to avoid bugs in certain implementations)"
-
-%{ /* NOCONTEXT */
- if (ISCONNECTED) {
- RETURN ( _MKSMALLINT(XVendorRelease(myDpy)) );
- }
- RETURN (nil);
-%}
-
- "
- Display vendorRelease
- "
-!
-
-protocolVersion
- "return the X-servers protocol version - should normally not be of
- any interrest"
-
-%{ /* NOCONTEXT */
- if (ISCONNECTED) {
- RETURN ( _MKSMALLINT(XProtocolVersion(myDpy)) );
- }
- RETURN (nil);
-%}
-
- "
- Display protocolVersion
- "
-!
-
-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
- "
-!
-
-hasFax
- "return true, if this workstation supports decompression of fax images.
- Both the server must support it, and the feature must have been
- enabled in the smalltalk system, for true to be returned."
-
- ^ hasFaxExtension
-
- "
- Display hasFaxExtension
- "
-!
-
hasDPS
"return true, if this workstation supports display postscript.
Both the server must support it, and the feature must have been
@@ -1126,66 +510,6 @@
"
!
-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
- "
-!
-
-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
- "
-!
-
-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
- "
-!
-
-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
- "
-!
-
-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
- "
-!
-
hasExtension:extensionString
"query for an X extension. The argument, extensionString
should be the name of the extension (i.e. 'SHAPE', 'XInputExtension' etc).
@@ -1215,6 +539,307 @@
"
!
+hasFax
+ "return true, if this workstation supports decompression of fax images.
+ Both the server must support it, and the feature must have been
+ enabled in the smalltalk system, for true to be returned."
+
+ ^ hasFaxExtension
+
+ "
+ Display hasFaxExtension
+ "
+!
+
+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 preferrer icon sizes. These are set by the window manager.
+ We return nil (if not set) or an OrderedCollection of Intervals."
+
+ |xIconSizes count ret|
+
+%{
+ Display *dpy = myDpy;
+ int screen = _intVal(_INST(screen));
+ XIconSize *sizeList;
+ int cnt;
+
+ if (ISCONNECTED) {
+ 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 |
+ | startX startY stopX stopY stepX stepY|
+
+%{
+ XIconSize *slp;
+
+ slp = &((XIconSize *)__externalBytesAddress(xIconSizes))[__intVal(i)-1];
+ startX = __MKSMALLINT(slp->min_width);
+ startY = __MKSMALLINT(slp->min_height);
+ stopX = __MKSMALLINT(slp->max_width);
+ stopY = __MKSMALLINT(slp->max_height);
+ stepX = __MKSMALLINT(slp->width_inc);
+ stepY = __MKSMALLINT(slp->height_inc);
+%}.
+ ret add:(Interval from:startX@startY to:stopX@stopY by:stepX@stepY)
+ ].
+
+ xIconSizes free.
+ ^ ret
+
+ "
+ Display iconSizes
+ "
+!
+
+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|
+
+%{
+ Display *dpy = myDpy;
+ XModifierKeymap *modmap;
+ OBJ __BYTEARRAY_UNINITIALIZED_NEW_INT();
+
+ if (ISCONNECTED) {
+ 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
+ "
+!
+
+protocolVersion
+ "return the X-servers protocol version - should normally not be of
+ any interrest"
+
+%{ /* NOCONTEXT */
+ if (ISCONNECTED) {
+ RETURN ( _MKSMALLINT(XProtocolVersion(myDpy)) );
+ }
+ RETURN (nil);
+%}
+
+ "
+ Display protocolVersion
+ "
+!
+
+rootView
+ rootView isNil ifTrue:[
+ rootView := DisplayRootView on:self
+ ].
+ ^ rootView
+
+ "
+ |v|
+ v := Display rootView.
+ v paint:Color red.
+ v noClipByChildren.
+ v fillRectangleX:10 y:10 width:100 height:100.
+ "
+!
+
+serverVendor
+ "return the X-server vendor string - this should normally not be of
+ any interrest, but can be for special cases
+ (to avoid bugs in certain implementations)"
+%{
+ if (ISCONNECTED) {
+ RETURN ( __MKSTRING(XServerVendor(myDpy) COMMA_CON) );
+ }
+ RETURN (nil);
+%}
+
+ "
+ Display serverVendor
+ "
+!
+
+stringFromKeycode:code
+ "Get a KeySymbol (a smalltalk symbol) from the keycode."
+
+ |str|
+
+%{
+ Display *dpy = myDpy;
+ KeySym keysym;
+ char *keystring;
+
+ if (ISCONNECTED && __isSmallInteger(code)) {
+ if ((keysym = XKeycodeToKeysym(myDpy, __intVal(code), 0)) != NoSymbol &&
+ (keystring = XKeysymToString(keysym)) != 0)
+ str = __MKSTRING(keystring);
+ }
+%}.
+ ^ str
+
+ "
+ Display stringFromKeycode:28
+ "
+!
+
supportedImageFormats
"return an array with supported image formats;
each array entry is an attribute dictionary, consisting of
@@ -1268,104 +893,6 @@
^ false
!
-iconSizes
- "Get the preferrer icon sizes. These are set by the window manager.
- We return nil (if not set) or an OrderedCollection of Intervals."
-
- |xIconSizes count ret|
-
-%{
- Display *dpy = myDpy;
- int screen = _intVal(_INST(screen));
- XIconSize *sizeList;
- int cnt;
-
- if (ISCONNECTED) {
- 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 |
- | startX startY stopX stopY stepX stepY|
-
-%{
- XIconSize *slp;
-
- slp = &((XIconSize *)__externalBytesAddress(xIconSizes))[__intVal(i)-1];
- startX = __MKSMALLINT(slp->min_width);
- startY = __MKSMALLINT(slp->min_height);
- stopX = __MKSMALLINT(slp->max_width);
- stopY = __MKSMALLINT(slp->max_height);
- stepX = __MKSMALLINT(slp->width_inc);
- stepY = __MKSMALLINT(slp->height_inc);
-%}.
- ret add:(Interval from:startX@startY to:stopX@stopY by:stepX@stepY)
- ].
-
- xIconSizes free.
- ^ ret
-
- "
- Display iconSizes
- "
-!
-
-modifierMapping
- "Get the Modifier Mapping.
- We return an array of arrays of keycodes"
-
- |modifierKeyMap maxKeyPerMod ret nextKey|
-
-%{
- Display *dpy = myDpy;
- XModifierKeymap *modmap;
- OBJ __BYTEARRAY_UNINITIALIZED_NEW_INT();
-
- if (ISCONNECTED) {
- 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
- "
-!
-
supportsViewGravity
"return true, if this device supports gravity attributes.
We do not depend on it being implemented, but some resizing operations
@@ -1374,188 +901,6 @@
^ true
!
-blackpixel
- "return the colornumber of black"
-
- ^ blackpixel
-!
-
-whitepixel
- "return the colornumber of white"
-
- ^ whitepixel
-!
-
-stringFromKeycode:code
- "Get a KeySymbol (a smalltalk symbol) from the keycode."
-
- |str|
-
-%{
- Display *dpy = myDpy;
- KeySym keysym;
- char *keystring;
-
- if (ISCONNECTED && __isSmallInteger(code)) {
- if ((keysym = XKeycodeToKeysym(myDpy, __intVal(code), 0)) != NoSymbol &&
- (keystring = XKeysymToString(keysym)) != 0)
- str = __MKSTRING(keystring);
- }
-%}.
- ^ str
-
- "
- Display stringFromKeycode:28
- "
-!
-
-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
-!
-
-button1MotionMask
- "return the state-mask for button1 in motion events state-field.
- For backward compatibility."
-
-%{ /* NOCONTEXT */
- RETURN (_MKSMALLINT(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));
-%}
-!
-
-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));
-%}
-!
-
-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: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
-!
-
-defaultEventMask
- "return a mask to enable some events by default."
-
-%{ /* NOCONTEXT */
- RETURN (_MKSMALLINT( ExposureMask | StructureNotifyMask |
- KeyPressMask | KeyReleaseMask |
- EnterWindowMask | LeaveWindowMask |
- ButtonPressMask | ButtonMotionMask | ButtonReleaseMask ));
-%}
-!
-
-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 */
-
- Display *dpy = myDpy;
- int screen = _intVal(_INST(screen));
- OBJ xp, yp;
- int xpos, ypos;
- Window child_return;
-
- if (__isExternalAddress(windowId)
- && __isPoint(aPoint)) {
- 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
-!
-
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)
@@ -1601,21 +946,65 @@
^ (x2 @ y2)
!
-rootView
- rootView isNil ifTrue:[
- rootView := DisplayRootView on:self
- ].
- ^ rootView
+vendorRelease
+ "return the X-servers vendor release - should normally not be of
+ any interrest, but can be for special cases.
+ (to avoid bugs in certain implementations)"
+
+%{ /* NOCONTEXT */
+ if (ISCONNECTED) {
+ RETURN ( _MKSMALLINT(XVendorRelease(myDpy)) );
+ }
+ RETURN (nil);
+%}
"
- |v|
- v := Display rootView.
- v paint:Color red.
- v noClipByChildren.
- v fillRectangleX:10 y:10 width:100 height:100.
+ 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 */
+
+ Display *dpy = myDpy;
+ int screen = _intVal(_INST(screen));
+ OBJ xp, yp;
+ int xpos, ypos;
+ Window child_return;
+
+ if (__isExternalAddress(windowId)
+ && __isPoint(aPoint)) {
+ 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;
@@ -1640,10 +1029,85 @@
}
%}.
^ width @ height
+!
+
+whitepixel
+ "return the colornumber of white"
+
+ ^ whitepixel
! !
!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|
+
+%{
+ Display *dpy = myDpy;
+ 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) {
+ 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) {
+ 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 */
+
+ Display *dpy = myDpy;
+ int screen = _intVal(_INST(screen));
+ Pixmap newBitmap;
+
+ if (__bothSmallInteger(w, h) && ISCONNECTED) {
+ BEGIN_INTERRUPTSBLOCKED
+ newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
+ _intVal(w), _intVal(h), 1);
+ END_INTERRUPTSBLOCKED
+ RETURN ( (newBitmap != (Pixmap)0) ? __MKOBJ(newBitmap) : nil );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
createFaxImageFromArray:data width:w height:h type:type k:k msbFirst:msbFirst
"create a new faxImage in the workstation
type: 0 -> uncompressed
@@ -1698,29 +1162,6 @@
^ nil
!
-createBitmapWidth:w height:h
- "allocate a bitmap on the Xserver, the contents is undefined
- (i.e. random). Return a bitmap id or nil"
-
-%{ /* NOCONTEXT */
-
- Display *dpy = myDpy;
- int screen = _intVal(_INST(screen));
- Pixmap newBitmap;
-
- if (__bothSmallInteger(w, h) && ISCONNECTED) {
- BEGIN_INTERRUPTSBLOCKED
- newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
- _intVal(w), _intVal(h), 1);
- 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"
@@ -1744,294 +1185,6 @@
^ nil
!
-createBitmapFromFile:aString for:aForm
- |id w h|
-
-%{
- Display *dpy = myDpy;
- 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) {
- 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) {
- w = _MKSMALLINT(b_width);
- h = _MKSMALLINT(b_height);
- id = __MKOBJ(newBitmap);
- }
- }
- }
-%}.
- id notNil ifTrue:[
- aForm setWidth:w height:h
- ].
- ^ id
-!
-
-primCreateBitmapFromArray:anArray width:w height:h
-
-%{ /* UNLIMITEDSTACK */
-
- Display *dpy = myDpy;
- 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 (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)) {
- 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) == 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) == 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);
- END_INTERRUPTSBLOCKED
-fail: ;
- if (allocatedBits)
- free(allocatedBits);
- RETURN ( newBitmap ? __MKOBJ(newBitmap) : nil );
- }
-%}
-!
-
-createBitmapFromArray:anArray width:w height:h
- |bitmapId|
-
- bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
- bitmapId isNil ifTrue:[
- self primitiveFailed
- ].
- ^ bitmapId
-!
-
-destroyPixmap:aDrawableId
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
- BEGIN_INTERRUPTSBLOCKED
- XFreePixmap(myDpy, _PixmapVal(aDrawableId));
- END_INTERRUPTSBLOCKED
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-destroyFaxImage:aFaxImageId
-
-%{ /* NOCONTEXT */
-
-#ifdef FAX
- if (__isExternalAddress(aFaxImageId)) {
- BEGIN_INTERRUPTSBLOCKED
- XFAXImageFreeImage(myDpy, (FAXImage)_WindowVal(aFaxImageId));
- END_INTERRUPTSBLOCKED
- RETURN ( self );
- }
-#endif
-%}.
- self primitiveFailed
-!
-
-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."
-
-%{ /* NOCONTEXT */
-
- 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
-!
-
-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."
-
-%{ /* NOCONTEXT */
- 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;
- 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;
- 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 );
-%}
-!
-
-realRootWindowFor:aView
- "the name of this method is historic;
- - it will vanish"
-
- |id|
-
- id := self realRootWindowId.
- self addKnownView:aView withId:id.
- ^ id
-!
-
-rootWindowFor:aView
- |id|
-
- id := self rootWindowId.
- self addKnownView:aView withId:id.
- ^ id
-!
-
createWindowFor:aView left:xpos top:ypos width:wwidth height:wheight
"will vanish - for compatibility with previous versions"
@@ -2363,15 +1516,20 @@
^ windowId
!
-destroyView:aView withId:aWindowId
-%{
- if (__isExternalAddress(aWindowId) && ISCONNECTED) {
+destroyFaxImage:aFaxImageId
+
+%{ /* NOCONTEXT */
+
+#ifdef FAX
+ if (__isExternalAddress(aFaxImageId)) {
BEGIN_INTERRUPTSBLOCKED
- XDestroyWindow(myDpy, _WindowVal(aWindowId));
+ XFAXImageFreeImage(myDpy, (FAXImage)_WindowVal(aFaxImageId));
END_INTERRUPTSBLOCKED
- }
+ RETURN ( self );
+ }
+#endif
%}.
- self removeKnownView:aView
+ self primitiveFailed
!
destroyGC:aGCId
@@ -2387,22 +1545,29 @@
self primitiveFailed
!
-gcFor:aDrawableId
+destroyPixmap:aDrawableId
%{ /* NOCONTEXT */
- int screen = _intVal(_INST(screen));
- GC gc;
if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
BEGIN_INTERRUPTSBLOCKED
- gc = XCreateGC(myDpy, (Drawable)_WindowVal(aDrawableId),
- 0L, (XGCValues *)0);
+ XFreePixmap(myDpy, _PixmapVal(aDrawableId));
END_INTERRUPTSBLOCKED
- RETURN ( gc ? __MKOBJ(gc) : nil );
+ RETURN ( self );
}
%}.
- self primitiveFailed.
- ^ nil
+ self primitiveFailed
+!
+
+destroyView:aView withId:aWindowId
+%{
+ if (__isExternalAddress(aWindowId) && ISCONNECTED) {
+ BEGIN_INTERRUPTSBLOCKED
+ XDestroyWindow(myDpy, _WindowVal(aWindowId));
+ END_INTERRUPTSBLOCKED
+ }
+%}.
+ self removeKnownView:aView
!
dpsContextFor:aDrawableId and:aGCId
@@ -2431,1728 +1596,261 @@
.
self primitiveFailed.
^ nil
-! !
-
-!XWorkstation methodsFor:'resources'!
-
-getResource:name class:cls
-%{
- 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 COMMA_CON) : nil );
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-! !
-
-!XWorkstation methodsFor:'selections'!
-
-setTextProperty:propertyID value:aString for:aWindowID
- ^ self setProperty:propertyID type:(self atomIDOfSTRING) value:aString for:aWindowID
-!
-
-setLengthProperty:propertyID value:aNumber for:aWindowID
- ^ self setProperty:propertyID type:(self atomIDOfLENGTH) value:aNumber for:aWindowID
-!
-
-setObjectProperty:propertyID value:anObject for:aWindowID
- |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
-!
-
-setProperty:propertyID type:typeID value:anObject for:aWindowID
-
-%{ /* UNLIMITEDSTACK */
-
- Display *dpy = myDpy;
- Atom prop, type;
- Window window;
- unsigned int value;
-
- if (__isAtomID(propertyID)
- && __isAtomID(typeID)
- && ISCONNECTED
- && (__isString(anObject)
- || __isSmallInteger(anObject)
- || __isSymbol(anObject)
- || __isByteArray(anObject))) {
-
- 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 */
- XChangeProperty(dpy, window, prop, XA_STRING, 8,
- PropModeReplace,
- _stringVal(anObject),
- strlen(_stringVal(anObject)));
- }
- }
- RETURN (true);
- }
-%}.
- ^ false
-!
-
-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
-!
-
-getObjectProperty:propertyID from:aWindowID
- "get an object property; 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
-!
-
-getProperty:propertyID from:aWindowID into:aTwoArgBlock
- "get a property, evaluate aTwoArgBlock with typeID and value"
-
- |val typeID cls|
-
- cls := ByteArray.
-%{
- Display *dpy = myDpy;
- 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;
- OBJ __new(), __MKSTRING_L();
-# define PROP_SIZE 2048
-
- 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) 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 COMMA_CON);
- } 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
-!
-
-getSelectionOwnerOf:selectionAtomID
- "get the owner of a selection"
+!
+
+gcFor:aDrawableId
%{ /* NOCONTEXT */
- Display *dpy = myDpy;
- Atom selection;
- Window window;
-
- if (__isAtomID(selectionAtomID) && ISCONNECTED) {
- window = XGetSelectionOwner(dpy, _AtomVal(selectionAtomID));
- RETURN ((window == None) ? nil : __MKOBJ(window));
- }
-%}.
- self primitiveFailed.
- ^ nil
-!
-
-setSelectionOwner:aWindowId of:selectionID
- "set the owner of a selection; return false if failed"
-
-%{ /* NOCONTEXT */
- Display *dpy = myDpy;
- Window win;
-
- if (__isExternalAddress(aWindowId)
- && __isAtomID(selectionID)
- && ISCONNECTED) {
- win = _WindowVal(aWindowId);
- XSetSelectionOwner(dpy, _AtomVal(selectionID), win, CurrentTime);
- if (XGetSelectionOwner(dpy, _AtomVal(selectionID)) != win) {
- RETURN (false);
- }
- RETURN (true);
- }
-%}
-.
- self primitiveFailed.
- ^ 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
-!
-
-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
-!
-
-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 */
- Display *dpy = myDpy;
- Atom sel_prop;
- char *cp;
-
- if (__isExternalAddress(aWindowId)
- && ISCONNECTED
- && __isSmallInteger(typeID)
- && __isAtomID(selectionID)) {
- 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
- "
-!
-
-atomIDOfPRIMARY
- ^ primaryAtom
-!
-
-atomIDOfSECONDARY
- ^ secondaryAtom
-!
-
-atomIDOfSTRING
- ^ stringAtom
-!
-
-atomIDOfLENGTH
- ^ lengthAtom
-!
-
-atomIDOfCUTBUFFER0
- ^ cutBuffer0Atom
-!
-
-atomIDOf:aStringOrSymbol
- "return an Atoms ID; dont create if not already present"
-
- ^ self atomIDOf:aStringOrSymbol create:false
-!
-
-atomIDOf:aStringOrSymbol create:create
- "return an Atoms ID; if create is true, create it if not already present"
-
-%{ /* 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
- "
-!
-
-atomName:anAtomID
-%{ /* NOCONTEXT */
- OBJ str;
- char *name;
-
- if (ISCONNECTED) {
- if (__isAtomID(anAtomID)) {
- name = XGetAtomName(myDpy, _AtomVal(anAtomID));
- if (name == 0) {
- RETURN (nil);
- }
- str = __MKSTRING(name COMMA_CON);
- XFree(name);
- RETURN ( str );
- }
+ int screen = _intVal(_INST(screen));
+ GC gc;
+
+ if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
+ BEGIN_INTERRUPTSBLOCKED
+ gc = XCreateGC(myDpy, (Drawable)_WindowVal(aDrawableId),
+ 0L, (XGCValues *)0);
+ END_INTERRUPTSBLOCKED
+ RETURN ( gc ? __MKOBJ(gc) : nil );
}
%}.
self primitiveFailed.
^ nil
-
- "
- Display atomName:1
- "
-!
-
-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 */
- Display *dpy = myDpy;
-
- if (__isAtomID(propertyID)
- && __isExternalAddress(requestorID)
- && ISCONNECTED
- && __isAtomID(targetID)
- && __isAtomID(selectionID)) {
- 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 (self )
- }
-%}
-.
- self primitiveFailed
-!
-
-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
-!
-
-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
-!
-
-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:[
- 'ownerchange failed' errorPrintNL.
- ].
- ^ self setTextProperty:cutBuffer0Atom value:aString for:nil
-!
-
-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
-! !
-
-!XWorkstation methodsFor:'font stuff'!
-
-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 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].
- coding := aString copyFrom:start to:(end - 1).
-
- aBlock value:family value:face value:style value:size value:coding.
- ^ true
-
- "Modified: 27.9.1995 / 10:46:52 / stefan"
-!
-
-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 names aName fntDescr|
-
- 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
- "
-
- "Modified: 27.9.1995 / 10:54:47 / stefan"
-!
-
-getAvailableFontsMatching:pattern
- "return an Array filled with font names matching aPattern"
+!
+
+primCreateBitmapFromArray:anArray width:w height:h
%{ /* 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] COMMA_CON);
- UNPROTECT(arr);
- __ArrayInstPtr(arr)->a_element[i] = str; __STORE(arr, str);
- }
- RETURN (arr);
+ Display *dpy = myDpy;
+ 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 (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;
}
- }
-%}.
- ^ nil
-!
-
-getFontWithFamily:familyString face:faceString
- style:styleString size:sizeArg encoding:encodingSym
-
- "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."
-
- |theSize theName theId xlatedStyle enc|
-
- "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
- ].
-
-"/ new:
- xlatedStyle := styleString.
- xlatedStyle notNil ifTrue:[
- xlatedStyle := xlatedStyle first asString
- ].
-
- ^ self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:'normal'
- pixelSize:nil
- size:sizeArg
- registry:'*'
- encoding:encodingSym.
-
-
-"/ old:
-"/ xlatedStyle := styleString.
-"/ "oblique is named italic in times font"
-"/ ((familyString = 'Times') or:[familyString = 'times']) ifTrue:[
-"/ ((styleString = 'Oblique') or:[styleString = 'oblique']) ifTrue:[
-"/ xlatedStyle := 'italic'
-"/ ]
-"/ ].
-"/ (xlatedStyle = 'italic') ifTrue:[
-"/ xlatedStyle := 'i'
-"/ ] ifFalse:[
-"/ (xlatedStyle = 'roman') ifTrue:[
-"/ xlatedStyle := 'r'
-"/ ] ifFalse:[
-"/ (xlatedStyle = 'oblique') ifTrue:[
-"/ xlatedStyle := 'o'
-"/ ]
-"/ ]
-"/ ].
-"/
-"/ theId := nil.
-"/ theSize := sizeArg.
-"/ [theId isNil] whileTrue:[
-"/ "this works only on Release >= 3 - X-servers"
-"/ enc := encodingSym.
-"/ enc isNil ifTrue:[
-"/ enc := '*'
-"/ ].
-"/ theName := ('-*-' , familyString ,
-"/ '-' , faceString ,
-"/ '-' , xlatedStyle , '-*-*-*-'
-"/ , theSize printString , '0-*-*-*-*-'
-"/ , enc , '-*').
-"/"
-"/Transcript showCr:theName; endEntry.
-"/"
-"/ theId := self createFontFor:theName.
-"/ theId isNil ifTrue:[
-"/ "could not get the font - try next smaller one"
-"/ theSize := theSize - 1.
-"/ (theSize < (sizeArg // 2)) ifTrue:[
-"/ "thats too much - give up"
-"/ ^ self getDefaultFont
-"/ "^ nil"
-"/ ]
-"/ ]
-"/ ].
-"/ (theSize ~~ sizeArg) ifTrue:[
-"/ Transcript show:'next smaller font: '.
-"/ Transcript showCr:theName
-"/ ].
-"/ ^ theId
-!
-
-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 ... '*'
- "
-
- |theName sMatch|
-
- "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:[sMatch := '*'] ifFalse:[sMatch := size printString , '0'].
-
- theName := ('-' , (foundry isNil ifTrue:['*'] ifFalse:[foundry]),
- '-' , (family isNil ifTrue:['*'] ifFalse:[family]),
- '-' , (weight isNil ifTrue:['*'] ifFalse:[weight]) ,
- '-' , (slant isNil ifTrue:['*'] ifFalse:[slant]) ,
- '-' , (spc isNil ifTrue:['*'] ifFalse:[spc]) ,
- '-*' ,
- '-' , (pSize isNil ifTrue:['*'] ifFalse:[pSize printString]),
- '-' , sMatch ,
- '-*-*-*-*' ,
- '-' , (registry isNil ifTrue:['*'] ifFalse:[registry]) ,
- '-' , (encoding isNil ifTrue:['*'] ifFalse:[encoding])).
-"/ Transcript showCr:theName; endEntry.
-
- ^ self createFontFor:theName.
-
- "
- Display getFontWithFoundry:'*'
- family:'courier'
- weight:'medium'
- slant:'r'
- spacing:nil
- pixelSize:nil
- size:13
- registry:'iso8859'
- encoding:'*'
- "
-!
-
-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));
- END_INTERRUPTSBLOCKED
- RETURN ( newFont ? __MKOBJ(newFont) : nil );
+ firstCall = 0;
+ }
+
+ if (__bothSmallInteger(w, h) && _isNonNilObject(anArray)) {
+ 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;
}
- }
-%}.
- ^ nil
-!
-
-getDefaultFont
- "return a default font id - used when class Font cannot
- find anything usable"
-
- ^ self createFontFor:'fixed'
-!
-
-releaseFont:aFontId
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- BEGIN_INTERRUPTSBLOCKED
- XFreeFont(myDpy, f);
- END_INTERRUPTSBLOCKED
- RETURN ( self );
+
+ if (__qClass(anArray) == 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) == ByteArray) {
+ pBits = _ByteArrayInstPtr(anArray)->ba_element;
+ for (col = b_height*bytesPerRow; col; col--) {
+ *cp++ = reverseBitTable[*pBits++];
+ }
+ } else {
+ goto fail;
+ }
}
- }
-%}
-.
- self primitiveFailed
-!
-
-ascentOf:aFontId
- "the normal ascent"
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- RETURN ( _MKSMALLINT(f->ascent) );
+
+ BEGIN_INTERRUPTSBLOCKED
+ newBitmap = XCreateBitmapFromData(dpy, RootWindow(dpy, screen),
+ (char *)b_bits,
+ b_width, b_height);
+ END_INTERRUPTSBLOCKED
+fail: ;
+ if (allocatedBits)
+ free(allocatedBits);
+ RETURN ( newBitmap ? __MKOBJ(newBitmap) : nil );
}
%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-descentOf:aFontId
- "the normal descent"
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- RETURN ( _MKSMALLINT(f->descent) );
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-minWidthOfFont:aFontId
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- RETURN ( _MKSMALLINT(f->min_bounds.width) );
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-maxAscentOf:aFontId
- "the max ascent"
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- RETURN ( _MKSMALLINT(f->max_bounds.ascent) );
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-maxDescentOf:aFontId
- "the max descent"
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- RETURN ( _MKSMALLINT(f->max_bounds.descent) );
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-maxWidthOfFont:aFontId
- "the width of the widest character"
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- RETURN ( _MKSMALLINT(f->max_bounds.width) );
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-widthOf:aString inFont:aFontId
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
- char *cp;
- int len, n;
-
- if (__isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- if (__isString(aString) || __isSymbol(aString)) {
- n = _stringSize(aString);
- cp = (char *)_stringVal(aString);
- BEGIN_INTERRUPTSBLOCKED
- len = XTextWidth(f, cp, n);
- END_INTERRUPTSBLOCKED
- RETURN ( _MKSMALLINT(len) );
- }
-#ifdef TWOBYTESTRINGS
- if (__Class(aString) == @global(TwoByteString)) {
- n = _byteArraySize(aString) / 2;
- cp = (char *) _stringVal(aString);
- BEGIN_INTERRUPTSBLOCKED
- len = XTextWidth16(f, (XChar2b *)cp, n);
- END_INTERRUPTSBLOCKED
- RETURN ( _MKSMALLINT(len) );
- }
-#endif
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-widthOf:aString from:index1 to:index2 inFont:aFontId
+!
+
+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."
%{ /* NOCONTEXT */
- XFontStruct *f;
- char *cp;
- int len, n, i1, i2;
-
- if (__bothSmallInteger(index1, index2)
- && __isExternalAddress(aFontId)) {
- f = _FontVal(aFontId);
- i1 = _intVal(index1) - 1;
- i2 = _intVal(index2) - 1;
- if (__isString(aString) || __isSymbol(aString)) {
- cp = (char *) _stringVal(aString);
- n = _stringSize(aString);
- if ((i1 >= 0) && (i2 >= i1) && (i2 < n)) {
- cp += i1;
- BEGIN_INTERRUPTSBLOCKED
- len = XTextWidth(f, cp, i2 - i1 + 1);
- END_INTERRUPTSBLOCKED
- RETURN ( _MKSMALLINT(len) );
- }
- }
-#ifdef TWOBYTESTRINGS
- if (__Class(aString) == @global(TwoByteString)) {
- cp = (char *) _stringVal(aString);
- n = _byteArraySize(aString) / 2;
- if ((i1 >= 0) && (i2 >= i1) && (i2 < n)) {
- cp += (i1 * 2);
- BEGIN_INTERRUPTSBLOCKED
- len = XTextWidth16(f, (XChar2b *)cp, i2 - i1 + 1);
- END_INTERRUPTSBLOCKED
- RETURN ( _MKSMALLINT(len) );
- }
- }
-#endif
- }
-%}
-.
- self primitiveFailed.
- ^ nil
-!
-
-sizesInFamily:aFamilyName face:aFaceName style:aStyleName
- "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.
- (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'
- "
-! !
-
-!XWorkstation methodsFor:'cursor stuff'!
-
-destroyCursor:aCursorId
-
-%{ /* NOCONTEXT */
+ int screen = _intVal(_INST(screen));
+ Window root;
+ OBJ id;
+
+ if (_INST(rootId) != nil) {
+ RETURN (_INST(rootId));
+ }
if (ISCONNECTED) {
- if (__isExternalAddress(aCursorId)) {
- BEGIN_INTERRUPTSBLOCKED
- XFreeCursor(myDpy, _CursorVal(aCursorId));
- END_INTERRUPTSBLOCKED
- RETURN ( self );
- }
- }
-%}
-.
- self primitiveFailed
-!
-
-createCursorSourceForm:sourceForm maskForm:maskForm hotX:hx hotY:hy
- "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 (__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));
- END_INTERRUPTSBLOCKED
- if (newCursor != (Cursor)0) {
- id = __MKOBJ(newCursor);
+ root = RootWindow(myDpy, screen);
+ if (! root) {
+ id = nil;
+ } else {
+ _INST(rootId) = id = __MKOBJ(root); __STORE(self, id);
}
- }
-%}.
- ^ id
-!
-
-shapeNumberFromSymbol:shape
- "given a shape-symbol, return the corresponding cursor-number"
-
- "this is pure X-knowlegde - but you may easily add more"
-
- (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: invalid cursorShape:' , shape printString) errorPrintNL.
- ^ 0
-!
-
-createCursorShape:aShape
- "create a cursor given a shape-symbol"
-
- |number id|
-
- displayId isNil ifTrue:[
- self primitiveFailed.
- ^ nil
- ].
- number := self shapeNumberFromSymbol:aShape.
-%{
- Cursor newCursor;
-
- if (__isSmallInteger(number)) {
- BEGIN_INTERRUPTSBLOCKED
- newCursor = XCreateFontCursor(myDpy, _intVal(number));
- END_INTERRUPTSBLOCKED
- if (newCursor != (Cursor)0) {
- id = __MKOBJ(newCursor);
- }
+ RETURN (id);
}
%}.
+ self primitiveFailed
+!
+
+rootWindowFor:aView
+ |id|
+
+ id := self rootWindowId.
+ self addKnownView:aView withId:id.
^ id
!
-colorCursor:aCursorId foreground:fgColor background:bgColor
- "change a cursors colors"
-
- |fgR fgG fgB bgR bgG bgB|
-
- fgR := fgColor red.
- fgG := fgColor green.
- fgB := fgColor blue.
- bgR := bgColor red.
- bgG := bgColor green.
- bgB := bgColor blue.
-
- fgR := self percentToXColorValue:fgR.
- fgG := self percentToXColorValue:fgG.
- fgB := self percentToXColorValue:fgB.
- bgR := self percentToXColorValue:bgR.
- bgG := self percentToXColorValue:bgG.
- bgB := self percentToXColorValue:bgB.
-
-%{
- XColor fgcolor, bgcolor;
-
- if (__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
-! !
-
-!XWorkstation methodsFor:'grabbing '!
-
-grabKeyboardIn:aWindowId
- "grab the keyboard"
-
-%{ /* NOCONTEXT */
- int result, ok;
-
- if (__isExternalAddress(aWindowId)) {
- BEGIN_INTERRUPTSBLOCKED
- result = XGrabKeyboard(myDpy,
- _WindowVal(aWindowId),
- True /* False */,
- GrabModeAsync,
- GrabModeAsync,
- CurrentTime);
- END_INTERRUPTSBLOCKED
- ok = 0;
- switch(result) {
- case AlreadyGrabbed:
- printf("XWORKSTAT: grab keyboard: AlreadyGrabbed\n");
- break;
- case GrabNotViewable:
- printf("XWORKSTAT: grab keyboard: GrabNotViewable\n");
- break;
- case GrabInvalidTime:
- printf("XWORKSTAT: grab keyboard: InvalidTime\n");
- break;
- case GrabFrozen:
- printf("XWORKSTAT: grab keyboard: Frozen\n");
- break;
- default:
- ok = 1;
- break;
- }
- if (! ok) {
- XUngrabKeyboard(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
-!
-
-grabPointerIn:aWindowId withCursor:aCursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
- "grap the pointer - return true if ok"
+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."
%{ /* NOCONTEXT */
-
- int result, ok;
- Window confineWin;
- Cursor curs;
- int pointer_mode, keyboard_mode;
-
- 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:
- printf("XWORKSTAT: grab pointer: AlreadyGrabbed\n");
- break;
- case GrabNotViewable:
- printf("XWORKSTAT: grab pointer: GrabNotViewable\n");
- break;
- case GrabInvalidTime:
- printf("XWORKSTAT: grab pointer: InvalidTime\n");
- break;
- case GrabFrozen:
- printf("XWORKSTAT: grab pointer: Frozen\n");
- break;
- default:
- ok = 1;
- break;
- }
-
- if (! ok) {
- XUngrabPointer(myDpy, CurrentTime);
- RETURN (false);
- }
- RETURN ( true );
- }
-%}
-.
- self primitiveFailed
-!
-
-ungrabPointer
- "release the pointer"
-
-%{ /* NOCONTEXT */
+ 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
- XUngrabPointer(myDpy, CurrentTime);
- XSync(myDpy, 0);
+ /*
+ * 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;
+ 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;
+ break;
+ }
+ }
+ }
+ if (children) XFree( children );
+ }
+ }
+ }
END_INTERRUPTSBLOCKED
- }
-%}.
- activePointerGrab := nil
-!
-
-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) {
- BEGIN_INTERRUPTSBLOCKED
- XAllowEvents(myDpy, _mode, CurrentTime);
- END_INTERRUPTSBLOCKED
- RETURN (self);
- }
+#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 );
%}
-.
- self primitiveFailed
-! !
-
-!XWorkstation methodsFor:'pointer queries '!
-
-rootPositionOfLastEvent
- "return the position in root-window coordinates
- of the last button, key or pointer event"
-
- ^ eventRootX @ eventRootY
-!
-
-pointerPosition
- "return the current pointer position in root-window coordinates"
-
- |xpos ypos|
-
-%{
- Display *dpy = myDpy;
- Window w;
- int screen = _intVal(_INST(screen));
- Window rootRet, childRet;
- int rootX, rootY, winX, winY;
- unsigned int mask;
-
- 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
-!
-
-buttonStates
- "return an integer representing the state of the pointer buttons;
- a one-bit in positions 0.. represent a pressed button"
-
-%{ /* NOCONTEXT*/
- Display *dpy = myDpy;
- Window w;
- int screen = _intVal(_INST(screen));
- Window rootRet, childRet;
- int rootX, rootY, winX, winY;
- unsigned int mask;
-
- 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));
-%}
-!
-
-leftButtonStateMask
- "return an integer for masking out the left button from a
- buttonStates value"
-
- ^ 256
-!
-
-middleButtonStateMask
- "return an integer for masking out the middle button from a
- buttonStates value"
-
- ^ 512
-!
-
-rightButtonStateMask
- "return an integer for masking out the right button from a
- buttonStates value"
-
- ^ 1024
! !
!XWorkstation methodsFor:'color stuff'!
-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) 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
-!
-
-freeColor:colorIndex
- "free a display color when its no longer needed"
+colorCell
+ "allocate a color cell - return index.
+ This method will return nil for StaticGrey and StaticGrey displays."
%{ /* NOCONTEXT */
Display *dpy = myDpy;
- unsigned long color;
int screen = _intVal(_INST(screen));
-
-#ifdef LATER
- if (_INST(visualType) == @symbol(TrueColor)) {
- /* no need to do anything on TrueColor displays ... */
- RETURN (self);
- }
-#endif
- if (__isSmallInteger(colorIndex) && ISCONNECTED) {
- color = (long) _intVal(colorIndex);
- BEGIN_INTERRUPTSBLOCKED
- XFreeColors(dpy, DefaultColormap(dpy, screen), &color, 1, 0L);
- END_INTERRUPTSBLOCKED
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-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) );
+ XColor color;
+ unsigned long dummy;
+ Status ok;
+
+ BEGIN_INTERRUPTSBLOCKED
+ ok = XAllocColorCells(dpy, DefaultColormap(dpy, screen), (Bool)0,
+ &dummy, 0, &color.pixel, 1);
+ END_INTERRUPTSBLOCKED
+ if (ok) {
+ RETURN ( _MKSMALLINT(color.pixel) );
}
%}
.
- ^ (16rFFFF * aPercentage / 100) rounded
-!
-
-colorRed:redVal green:greenVal blue:blueVal
- "allocate a color with rgb values (0..100) - return index"
-
- |r g b|
-
- r := self percentToXColorValue:redVal.
- g := self percentToXColorValue:greenVal.
- b := self percentToXColorValue:blueVal.
-%{
- Display *dpy = myDpy;
- XColor ecolor;
- int screen = _intVal(_INST(screen));
- Status ok;
-
- if (__bothSmallInteger(r, g)
- && __isSmallInteger(b)
- && ISCONNECTED) {
- ecolor.red = _intVal(r);
- ecolor.green= _intVal(g);
- ecolor.blue = _intVal(b);
- BEGIN_INTERRUPTSBLOCKED
- ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
- END_INTERRUPTSBLOCKED
- if (! ok) {
- RETURN ( nil );
- }
- RETURN ( _MKSMALLINT(ecolor.pixel) );
- }
-%}
-.
- self primitiveFailed.
^ nil
!
@@ -4190,28 +1888,195 @@
^ nil
!
-colorCell
- "allocate a color cell - return index.
- This method will return nil for StaticGrey and StaticGrey displays."
+colorRed:redVal green:greenVal blue:blueVal
+ "allocate a color with rgb values (0..100) - return index"
+
+ |r g b|
+
+ r := self percentToXColorValue:redVal.
+ g := self percentToXColorValue:greenVal.
+ b := self percentToXColorValue:blueVal.
+%{
+ Display *dpy = myDpy;
+ XColor ecolor;
+ int screen = _intVal(_INST(screen));
+ Status ok;
+
+ if (__bothSmallInteger(r, g)
+ && __isSmallInteger(b)
+ && ISCONNECTED) {
+ ecolor.red = _intVal(r);
+ ecolor.green= _intVal(g);
+ ecolor.blue = _intVal(b);
+ BEGIN_INTERRUPTSBLOCKED
+ ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
+ END_INTERRUPTSBLOCKED
+ if (! ok) {
+ RETURN ( nil );
+ }
+ RETURN ( _MKSMALLINT(ecolor.pixel) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+freeColor:colorIndex
+ "free a display color when its no longer needed"
%{ /* NOCONTEXT */
Display *dpy = myDpy;
+ unsigned long color;
int screen = _intVal(_INST(screen));
- XColor color;
- unsigned long dummy;
- Status ok;
-
- BEGIN_INTERRUPTSBLOCKED
- ok = XAllocColorCells(dpy, DefaultColormap(dpy, screen), (Bool)0,
- &dummy, 0, &color.pixel, 1);
- END_INTERRUPTSBLOCKED
- if (ok) {
- RETURN ( _MKSMALLINT(color.pixel) );
+
+#ifdef LATER
+ if (_INST(visualType) == @symbol(TrueColor)) {
+ /* no need to do anything on TrueColor displays ... */
+ RETURN (self);
+ }
+#endif
+ if (__isSmallInteger(colorIndex) && ISCONNECTED) {
+ color = (long) _intVal(colorIndex);
+ BEGIN_INTERRUPTSBLOCKED
+ XFreeColors(dpy, DefaultColormap(dpy, screen), &color, 1, 0L);
+ END_INTERRUPTSBLOCKED
+ RETURN ( self );
}
%}
.
- ^ nil
+ 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"
+
+ |r g b|
+%{
+ Display *dpy = myDpy;
+ int screen = _intVal(_INST(screen));
+ XColor color;
+ double fr, fg, fb;
+ double floor();
+ int bits, scale, shift;
+
+ if (__isSmallInteger(index)) {
+ color.pixel = _intVal(index);
+ BEGIN_INTERRUPTSBLOCKED
+ XQueryColor(dpy, DefaultColormap(dpy, screen), &color);
+ END_INTERRUPTSBLOCKED
+
+ /* scale to 0..100 and round to the first decimal */
+
+ /*
+ * 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;
+
+ fr = floor( ( ((double)(color.red>>shift) * 1000.0) / scale) + 0.5) / 10.0;
+ fg = floor( ( ((double)(color.green>>shift) * 1000.0) / scale) + 0.5) / 10.0;
+ fb = floor( ( ((double)(color.blue>>shift) * 1000.0) / scale) + 0.5) / 10.0;
+
+ r = _MKFLOAT(fr COMMA_CON);
+ g = _MKFLOAT(fg COMMA_CON);
+ b = _MKFLOAT(fb COMMA_CON);
+ }
+%}.
+ aBlock value:r value:g value:b
+!
+
+getRGBFromName:colorName into:aBlock
+ "get rgb components (0..100) of color named colorName,
+ and evaluate the 3-arg block, aBlock with them"
+
+ |r g b|
+
+ displayId isNil ifTrue:[
+ self pimitiveFailed.
+ ^ nil
+ ].
+%{
+ Display *dpy = myDpy;
+ int screen = _intVal(_INST(screen));
+ XColor color;
+ double fr, fg, fb;
+ double floor();
+
+ if (__isString(colorName) || __isSymbol(colorName)) {
+ BEGIN_INTERRUPTSBLOCKED
+ if (XParseColor(dpy, DefaultColormap(dpy, screen),
+ (char *)_stringVal(colorName), &color)) {
+ /*
+ * scale to 0..100 and round to the first decimal
+ */
+ fr = floor( ((((double)color.red) * 1000.0) / 0xFFFF) + 0.5) / 10.0;
+ fg = floor( ((((double)color.green) * 1000.0) / 0xFFFF) + 0.5) / 10.0;
+ fb = floor( ((((double)color.blue) * 1000.0) / 0xFFFF) + 0.5) / 10.0;
+
+ r = _MKFLOAT(fr COMMA_CON);
+ g = _MKFLOAT(fg COMMA_CON);
+ b = _MKFLOAT(fb COMMA_CON);
+ }
+ 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) 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
+!
+
+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 red:redVal green:greenVal blue:blueVal
@@ -4260,1423 +2125,169 @@
%}
.
self primitiveFailed
-!
-
-getRGBFromName:colorName into:aBlock
- "get rgb components (0..100) of color named colorName,
- and evaluate the 3-arg block, aBlock with them"
-
- |r g b|
-
- displayId isNil ifTrue:[
- self pimitiveFailed.
- ^ nil
- ].
+! !
+
+!XWorkstation methodsFor:'cursor stuff'!
+
+colorCursor:aCursorId foreground:fgColor background:bgColor
+ "change a cursors colors"
+
+ |fgR fgG fgB bgR bgG bgB|
+
+ fgR := fgColor red.
+ fgG := fgColor green.
+ fgB := fgColor blue.
+ bgR := bgColor red.
+ bgG := bgColor green.
+ bgB := bgColor blue.
+
+ fgR := self percentToXColorValue:fgR.
+ fgG := self percentToXColorValue:fgG.
+ fgB := self percentToXColorValue:fgB.
+ bgR := self percentToXColorValue:bgR.
+ bgG := self percentToXColorValue:bgG.
+ bgB := self percentToXColorValue:bgB.
+
%{
- Display *dpy = myDpy;
- int screen = _intVal(_INST(screen));
- XColor color;
- double fr, fg, fb;
- double floor();
-
- if (__isString(colorName) || __isSymbol(colorName)) {
- BEGIN_INTERRUPTSBLOCKED
- if (XParseColor(dpy, DefaultColormap(dpy, screen),
- (char *)_stringVal(colorName), &color)) {
- /*
- * scale to 0..100 and round to the first decimal
- */
- fr = floor( ((((double)color.red) * 1000.0) / 0xFFFF) + 0.5) / 10.0;
- fg = floor( ((((double)color.green) * 1000.0) / 0xFFFF) + 0.5) / 10.0;
- fb = floor( ((((double)color.blue) * 1000.0) / 0xFFFF) + 0.5) / 10.0;
-
- r = _MKFLOAT(fr COMMA_CON);
- g = _MKFLOAT(fg COMMA_CON);
- b = _MKFLOAT(fb COMMA_CON);
- }
- END_INTERRUPTSBLOCKED
- }
-%}
-.
- aBlock value:r value:g value:b
-!
-
-getRGBFrom:index into:aBlock
- "get rgb components (0..100) of color in map at:index,
- and evaluate the 3-arg block, aBlock with them"
-
- |r g b|
-%{
- Display *dpy = myDpy;
- int screen = _intVal(_INST(screen));
- XColor color;
- double fr, fg, fb;
- double floor();
- int bits, scale, shift;
-
- if (__isSmallInteger(index)) {
- color.pixel = _intVal(index);
+ XColor fgcolor, bgcolor;
+
+ if (__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
- XQueryColor(dpy, DefaultColormap(dpy, screen), &color);
- END_INTERRUPTSBLOCKED
-
- /* scale to 0..100 and round to the first decimal */
-
- /*
- * 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;
-
- fr = floor( ( ((double)(color.red>>shift) * 1000.0) / scale) + 0.5) / 10.0;
- fg = floor( ( ((double)(color.green>>shift) * 1000.0) / scale) + 0.5) / 10.0;
- fb = floor( ( ((double)(color.blue>>shift) * 1000.0) / scale) + 0.5) / 10.0;
-
- r = _MKFLOAT(fr COMMA_CON);
- g = _MKFLOAT(fg COMMA_CON);
- b = _MKFLOAT(fb COMMA_CON);
- }
-%}.
- aBlock value:r value:g value:b
-! !
-
-!XWorkstation methodsFor:'window stuff'!
-
-setBackingStore:how in:aWindowId
- "turn on/off backing-store for a window"
-
-%{ /* NOCONTEXT */
-
- XSetWindowAttributes wa;
-
- if (__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 (__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
-!
-
-setWindowGravity:how in:aWindowId
- "set window gravity for a window"
-
-%{ /* NOCONTEXT */
-
- XSetWindowAttributes wa;
-
- if (__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);
+ XRecolorCursor(myDpy, _CursorVal(aCursorId), &fgcolor, &bgcolor);
END_INTERRUPTSBLOCKED
RETURN ( self );
}
-%}.
- self primitiveFailed
-!
-
-setSaveUnder:yesOrNo in:aWindowId
- "turn on/off save-under for a window"
-
-%{ /* NOCONTEXT */
-
- XSetWindowAttributes wa;
-
- if (__isExternalAddress(aWindowId)) {
- if (_INST(hasSaveUnder) == true) {
- wa.save_under = (yesOrNo == true) ? 1 : 0;
- XChangeWindowAttributes(myDpy, _WindowVal(aWindowId), CWSaveUnder, &wa);
- }
- RETURN ( self );
- }
-%}.
- 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 (__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 (__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 (__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 (__isExternalAddress(aWindowId)
- && __isExternalAddress(aPixmapId)) {
- XSetWindowBorderPixmap(myDpy, _WindowVal(aWindowId), _PixmapVal(aPixmapId));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-setWindowBorderWidth:aNumber in:aWindowId
- "set the windows border width"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)
- && __isSmallInteger(aNumber)) {
- XSetWindowBorderWidth(myDpy, _WindowVal(aWindowId), _intVal(aNumber));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setWindowBorderShape:aPixmapId in:aWindowId
- "set the windows border shape"
-
- hasShapeExtension ifFalse:[^ self].
-
-%{ /* NOCONTEXT */
-
-#ifdef SHAPE
- if (__isExternalAddress(aWindowId)
- && __isExternalAddress(aPixmapId)) {
- XShapeCombineMask(myDpy, _WindowVal(aWindowId), ShapeBounding,
- 0, 0, _PixmapVal(aPixmapId), ShapeSet);
- RETURN ( self );
- }
-#endif
-%}.
- self primitiveFailed
-!
-
-setWindowShape:aPixmapId in:aWindowId
- "set the windows shape"
-
- hasShapeExtension ifFalse:[^ self].
-
-%{ /* NOCONTEXT */
-
-#ifdef SHAPE
- if (__isExternalAddress(aWindowId)
- && __isExternalAddress(aPixmapId)) {
- XShapeCombineMask(myDpy, _WindowVal(aWindowId), ShapeClip,
- 0, 0,
- _PixmapVal(aPixmapId), ShapeSet);
- RETURN ( self );
- }
-#endif
-%}.
- self primitiveFailed
-!
-
-setCursor:aCursorId in:aWindowId
- "define a windows cursor"
-
-%{ /* NOCONTEXT */
-
- Display *dpy = myDpy;
-
- if (__isExternalAddress(aWindowId)
- && __isExternalAddress(aCursorId)) {
- XDefineCursor(dpy, _WindowVal(aWindowId), _CursorVal(aCursorId));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setWindowName:aString in:aWindowId
- "define a windows name"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)
- && (__isString(aString) || __isSymbol(aString))) {
- XStoreName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setIconName:aString in:aWindowId
- "define a windows iconname"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)
- && (__isString(aString) || __isSymbol(aString))) {
- XSetIconName(myDpy, _WindowVal(aWindowId), (char *)_stringVal(aString));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setWindowIcon:aForm in:aWindowId
- "define a bitmap to be used as icon"
-
- |iconId|
-
- aForm notNil ifTrue:[
- iconId := aForm id
- ].
-%{
- if (__isExternalAddress(iconId)
- && __isExternalAddress(aWindowId)) {
- XWMHints hints;
-
- hints.icon_pixmap = _PixmapVal(iconId);
- hints.flags = IconPixmapHint;
- 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 (__isExternalAddress(iconWindowId)
- && __isExternalAddress(aWindowId)) {
- XWMHints wmhints;
-
- wmhints.icon_window = _WindowVal(iconWindowId);
- wmhints.flags = IconWindowHint;
- XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setTransient:aWindowId for:aMainWindowId
- "set aWindowId to be a transient of aMainWindow"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)
- && __isExternalAddress(aMainWindowId)) {
- XSetTransientForHint(myDpy, _WindowVal(aWindowId),
- _WindowVal(aMainWindowId));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-clearWindow:aWindowId
- "clear a window to viewbackground"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)) {
- XClearWindow(myDpy, _WindowVal(aWindowId));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-clearRectangleX:x y:y width:width height:height in:aWindowId
- "clear a rectangular area to viewbackground"
-
-%{ /* NOCONTEXT */
-
- int w, h;
-
- if (__isExternalAddress(aWindowId)
- && __bothSmallInteger(x, y)
- && __bothSmallInteger(width, height)) {
- w = _intVal(width);
- h = _intVal(height);
- if (w < 0) w = 0;
- if (h < 0) h = 0;
- XClearArea(myDpy, _WindowVal(aWindowId), _intVal(x), _intVal(y), w, h, 0);
- 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;
- Display *dpy = myDpy;
- Window win;
-
- if (__isExternalAddress(aWindowId)) {
- 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 (__isExternalAddress(aWindowId)) {
- XMapWindow(myDpy, _WindowVal(aWindowId));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-unmapWindow:aWindowId
- "make a window invisible"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)) {
- XUnmapWindow(myDpy, _WindowVal(aWindowId));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-raiseWindow:aWindowId
- "bring a window to front"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)) {
- XRaiseWindow(myDpy, _WindowVal(aWindowId));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-lowerWindow:aWindowId
- "bring a window to back"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId)) {
- XLowerWindow(myDpy, _WindowVal(aWindowId));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-moveWindow:aWindowId x:x y:y
- "move a window"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aWindowId) && __bothSmallInteger(x, y)) {
- XMoveWindow(myDpy, _WindowVal(aWindowId), _intVal(x), _intVal(y));
- RETURN ( self );
- }
-%}
-.
- self primitiveFailed
-!
-
-resizeWindow:aWindowId width:w height:h
- "resize a window"
-
-%{ /* NOCONTEXT */
-
- int newWidth, newHeight;
-
- if (__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
-!
-
-moveResizeWindow:aWindowId x:x y:y width:w height:h
- "move and resize a window"
-
-%{ /* NOCONTEXT */
-
- int newWidth, newHeight;
-
- if (__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
!
-configureWindow:aWindowId sibling:siblingId stackMode:modeSymbol
- "configure stacking operation of aWindowId w.r.t siblingId"
-
-%{ /* NOCONTEXT */
-
- XWindowChanges chg;
- int mask = CWSibling | CWStackMode;
-
- 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
-! !
-
-!XWorkstation ignoredMethodsFor:'window stuff'!
-
-iconifyWindow:aWindowId
- "iconify a topView"
-
-%{ /* NOCONTEXT */
- if (__isExternalAddress(aWindowId)) {
- XWMHints wmhints;
-
- wmhints.initial_state = IconicState;
- wmhints.flags |= StateHint;
- XSetWMHints(myDpy, _WindowVal(aWindowId), &wmhints);
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-! !
-
-!XWorkstation methodsFor:'graphic context stuff'!
-
-setForeground:fgColorIndex in:aGCId
- "set foreground color to be drawn with"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aGCId)
- && __isSmallInteger(fgColorIndex)) {
- XSetForeground(myDpy, _GCVal(aGCId), _intVal(fgColorIndex));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setBackground:bgColorIndex in:aGCId
- "set background color to be drawn with"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aGCId)
- && __isSmallInteger(bgColorIndex)) {
- XSetBackground(myDpy, _GCVal(aGCId), _intVal(bgColorIndex));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setForeground:fgColorIndex background:bgColorIndex in:aGCId
- "set foreground and background colors to be drawn with"
-
-%{ /* NOCONTEXT */
-
- Display *dpy = myDpy;
- GC gc = _GCVal(aGCId);
-
- if (__bothSmallInteger(fgColorIndex, bgColorIndex)
- && __isExternalAddress(aGCId)) {
- XSetForeground(dpy, gc, _intVal(fgColorIndex));
- XSetBackground(dpy, gc, _intVal(bgColorIndex));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setForeground:fgColor background:bgColor mask:aBitmapId in:aGCId
- "set foreground and background colors to be drawn with using mask or
- solid (if aBitmapId is nil)"
-
-%{ /* NOCONTEXT */
-
- Display *dpy = myDpy;
- GC gc = _GCVal(aGCId);
-
- if (__isExternalAddress(aGCId)) {
- if (__isSmallInteger(fgColor))
- XSetForeground(dpy, gc, _intVal(fgColor));
- if (__isSmallInteger(bgColor))
- XSetBackground(dpy, gc, _intVal(bgColor));
-
- if (__isExternalAddress(aBitmapId)) {
- XSetStipple(dpy, gc, _PixmapVal(aBitmapId));
- XSetFillStyle(dpy, gc, FillOpaqueStippled);
- RETURN ( self );
- }
- if (aBitmapId == nil) {
- XSetFillStyle(dpy, gc, FillSolid);
- RETURN ( self );
+createCursorShape:aShape
+ "create a cursor given a shape-symbol"
+
+ |number id|
+
+ displayId isNil ifTrue:[
+ self primitiveFailed.
+ ^ nil
+ ].
+ number := self shapeNumberFromSymbol:aShape.
+%{
+ Cursor newCursor;
+
+ if (__isSmallInteger(number)) {
+ BEGIN_INTERRUPTSBLOCKED
+ newCursor = XCreateFontCursor(myDpy, _intVal(number));
+ END_INTERRUPTSBLOCKED
+ if (newCursor != (Cursor)0) {
+ id = __MKOBJ(newCursor);
}
}
%}.
- self primitiveFailed
-!
-
-setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
- "set line attributes"
-
-%{ /* NOCONTEXT */
-
- int x_style, x_cap, x_join;
-
- 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 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
-!
-
-setForeground:fgColor background:bgColor mask:aBitmapId lineWidth:lw in:aGCId
- "set foreground and background colors to be drawn with using mask or
- solid (if aBitmapId is nil); also set lineWidth"
-
-%{ /* NOCONTEXT */
-
- Display *dpy = myDpy;
- GC gc = _GCVal(aGCId);
-
- if (__isExternalAddress(aGCId)) {
- if (__isSmallInteger(lw)) {
- XSetLineAttributes(dpy, gc, _intVal(lw),
- LineSolid, CapNotLast, JoinMiter);
- }
- if (__isSmallInteger(fgColor))
- XSetForeground(dpy, gc, _intVal(fgColor));
- if (__isSmallInteger(bgColor))
- XSetBackground(dpy, gc, _intVal(bgColor));
-
- if (__isExternalAddress(aBitmapId)) {
- XSetStipple(dpy, gc, _PixmapVal(aBitmapId));
- XSetFillStyle(dpy, gc, FillOpaqueStippled);
- RETURN ( self );
- }
- if (aBitmapId == nil) {
- XSetFillStyle(dpy, gc, FillSolid);
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailed
-!
-
-setFunction:aFunctionSymbol in:aGCId
- "set alu function to be drawn with"
-
-%{ /* NOCONTEXT */
-
- GC gc = _GCVal(aGCId);
- int fun = -1;
-
- if (__isExternalAddress(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 );
+ ^ id
+!
+
+createCursorSourceForm:sourceForm maskForm:maskForm hotX:hx hotY:hy
+ "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 (__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));
+ END_INTERRUPTSBLOCKED
+ if (newCursor != (Cursor)0) {
+ id = __MKOBJ(newCursor);
}
}
%}.
- "
- 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
-!
-
-setFont:aFontId in:aGCId
- "set font to be drawn in"
-
-%{ /* NOCONTEXT */
-
- XFontStruct *f;
-
- 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
-!
-
-setPixmapMask:aPixmapId in:aGCId
- "set or clear the drawing mask - a pixmap mask providing full color"
+ ^ id
+!
+
+destroyCursor:aCursorId
%{ /* NOCONTEXT */
- Display *dpy = myDpy;
- GC gc = _GCVal(aGCId);
- Pixmap pixmap;
-
- if (__isExternalAddress(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
-!
-
-setBitmapMask:aBitmapId in:aGCId
- "set or clear the drawing mask - a bitmap mask using current fg/bg"
-
-%{ /* NOCONTEXT */
-
- Display *dpy = myDpy;
- GC gc = _GCVal(aGCId);
- Pixmap bitmap;
-
- if (__isExternalAddress(aGCId)) {
- if (__isExternalAddress(aBitmapId)) {
- bitmap = _PixmapVal(aBitmapId);
- XSetStipple(dpy, gc, bitmap);
- XSetFillStyle(dpy, gc, FillOpaqueStippled);
- RETURN ( self );
- }
- if (aBitmapId == nil) {
- XSetFillStyle(dpy, gc, FillSolid);
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aCursorId)) {
+ BEGIN_INTERRUPTSBLOCKED
+ XFreeCursor(myDpy, _CursorVal(aCursorId));
+ END_INTERRUPTSBLOCKED
RETURN ( self );
}
}
-%}.
- self primitiveFailed
-!
-
-setMaskOriginX:orgX y:orgY in:aGCid
- "set the mask origin"
-
-%{ /* NOCONTEXT */
-
- if (__bothSmallInteger(orgX, orgY) && __isExternalAddress(aGCid)) {
- XSetTSOrigin(myDpy, _GCVal(aGCid), _intVal(orgX), _intVal(orgY));
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setClipByChildren:aBool in:aGCId
- "enable/disable drawing into child views"
-
-%{ /* NOCONTEXT */
-
- XGCValues gcv;
- GC gc = _GCVal(aGCId);
-
- if (__isExternalAddress(aGCId)) {
- if (aBool == true)
- gcv.subwindow_mode = ClipByChildren;
- else
- gcv.subwindow_mode = IncludeInferiors;
-
- XChangeGC(myDpy, gc, GCSubwindowMode, &gcv);
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-noClipIn:aGCId
- "disable clipping rectangle"
-
-%{ /* NOCONTEXT */
-
- XGCValues gcv;
- GC gc = _GCVal(aGCId);
-
- if (__isExternalAddress(aGCId)) {
- gcv.clip_mask = None;
- XChangeGC(myDpy, gc, GCClipMask, &gcv);
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-setClipX:clipX y:clipY width:clipWidth height:clipHeight in:aGCId
- "clip to a rectangle"
-
-%{ /* NOCONTEXT */
-
- XRectangle r;
-
- 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
-!
-
-setGraphicsExposures:aBoolean in:aGCId
- "set or clear the graphics exposures flag"
-
-%{ /* NOCONTEXT */
-
- if (__isExternalAddress(aGCId)) {
- XSetGraphicsExposures(myDpy, _GCVal(aGCId), (aBoolean==true)?1:0);
- RETURN ( self );
- }
%}
.
self primitiveFailed
-! !
-
-!XWorkstation methodsFor:'retrieving pixels'!
-
-getPixelX:x y:y from:aDrawableId
- "return the pixel value at x/y; coordinates start at 0/0 for the upper left."
-
-%{ /* UNLIMITEDSTACK NOCONTEXT */
-
- Window win = _WindowVal(aDrawableId);
- XImage *img;
- int ret;
- int xpos, ypos;
-
- if (__isExternalAddress(aDrawableId) && __bothSmallInteger(x, y)) {
- 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);
- ret = XGetPixel(img, 0, 0);
- XDestroyImage(img);
- RETURN ( _MKSMALLINT(ret) );
- }
-%}.
- ^ nil
-!
-
-getBitsFrom: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."
-
- |info|
-
- ((w <= 0) or:[h <= 0]) ifTrue:[
- self primitiveFailed.
- ^ nil
- ].
-
- info := Array with:nil "depth"
- with:nil "bit order"
- with:nil "bytes_per_line"
- with:nil "byte_order".
-
- "/ 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 infoInfo:info) ifTrue:[
- ^ info
- ].
- "
- some error occured - either args are not smallintegers, imageBits is not a ByteArray
- or is too small to hold the bits
- "
- ^ self primitiveFailed
-!
-
-primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInfo:info
- "since XGetImage may allocate huge amount of stack space
- (some implementations use alloca), this must run with unlimited stack."
-
-%{ /* UNLIMITEDSTACK */
-
- Display *dpy = myDpy;
- Window win = _WindowVal(aDrawableId);
- XImage *image = (XImage *)0;
- int pad, bytes_per_line, numBytes;
-
- if (__isExternalAddress(aDrawableId)
- && __bothSmallInteger(srcx, srcy)
- && __bothSmallInteger(w, h)
- && __isArray(info)
- && __isByteArray(imageBits)) {
- image = XGetImage(dpy, win, _intVal(srcx), _intVal(srcy),
- _intVal(w), _intVal(h),
- (unsigned)AllPlanes, ZPixmap);
-
- 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("unsupported depth:%d in primGetBits\n", image->depth);
- goto fail;
- }
-
-#ifdef SUPERDEBUG
- printf("bytes need:%d bytes given:%d\n", numBytes, _byteArraySize(imageBits));
-#endif
-
- if (numBytes > _byteArraySize(imageBits)) {
- /* imageBits too small */
- 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);
- bcopy(image->data, _ByteArrayInstPtr(imageBits)->ba_element, numBytes);
- XDestroyImage(image);
- RETURN ( true );
- }
-fail:
- if (image) {
- XDestroyImage(image);
- }
-%}.
- ^ false
+!
+
+shapeNumberFromSymbol:shape
+ "given a shape-symbol, return the corresponding cursor-number"
+
+ "this is pure X-knowlegde - but you may easily add more"
+
+ (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: invalid cursorShape:' , shape printString) errorPrintNL.
+ ^ 0
! !
!XWorkstation methodsFor:'drawing'!
-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 = _GCVal(aGCId);
- Window win = _WindowVal(aDrawableId);
- unsigned char *cp;
- int n;
- OBJ cls;
-
- if (__isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __isNonNilObject(aString)
- && __bothSmallInteger(x, y)) {
- cls = __qClass(aString);
- if ((cls == String) || (cls == Symbol)) {
- cp = _stringVal(aString);
- 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 );
- }
-#ifdef TWOBYTESTRINGS
- if (cls == @global(TwoByteString)) {
- cp = _stringVal(aString);
- n = _byteArraySize(aString) / 2;
- if (n > 1000) n = 1000;
- 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);
- RETURN ( self );
- }
-#endif
- }
-%}.
- "x/y not integer, badGC or drawable, or not a string"
- 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 = _GCVal(aGCId);
- Window win = _WindowVal(aDrawableId);
- unsigned char *cp;
- OBJ cls;
- int i1, i2, l, n;
-
- if (__isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __isNonNilObject(aString)
- && __bothSmallInteger(index1, index2)
- && __bothSmallInteger(x, y)) {
- cls = __qClass(aString);
- if ((cls == String) || (cls == Symbol)) {
- i1 = _intVal(index1) - 1;
- i2 = _intVal(index2) - 1;
- n = _stringSize(aString);
- cp = _stringVal(aString);
- if ((i1 >= 0) && (i2 < n)) {
- if (i2 >= i1) {
- cp += i1;
- l = i2 - i1 + 1;
- 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 );
- }
- }
-#ifdef TWOBYTESTRINGS
- if (cls == @global(TwoByteString)) {
- i1 = _intVal(index1) - 1;
- i2 = _intVal(index2) - 1;
- n = _byteArraySize(aString) / 2;
- cp = _stringVal(aString);
- if ((i1 >= 0) && (i2 < n)) {
- if (i2 >= i1) {
- cp += (i1 * 2);
- l = i2 - i1 + 1;
- if (l > 1000) l = 1000;
- 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);
- RETURN ( self );
- }
- }
- }
-#endif
- }
-%}.
- "x/y not integer, badGC or drawable, or not a string"
- 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 = _GCVal(aGCId);
- Window win = _WindowVal(aDrawableId);
-
- if (__isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(x, y)) {
- XDrawPoint(myDpy, win, gc, _intVal(x), _intVal(y));
- RETURN ( self );
- }
-%}.
- "badGC, badDrawable or x/y 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 = _GCVal(aGCId);
- Window win = _WindowVal(aDrawableId);
-
- if (__isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(x0, y0)
- && __bothSmallInteger(x1, y1)) {
- XDrawLine(myDpy, win, gc, _intVal(x0), _intVal(y0),
- _intVal(x1), _intVal(y1));
- RETURN ( self );
- }
-%}.
- "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 = _GCVal(aGCId);
- Window win = _WindowVal(aDrawableId);
- int w, h;
-
- if (__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)) {
- XDrawRectangle(myDpy, win, gc, _intVal(x), _intVal(y), w, h);
- }
- RETURN ( self );
- }
-%}.
- "badGC, badDrawable or coordinates 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 = _GCVal(aGCId);
- Window win = _WindowVal(aDrawableId);
- extern OBJ Point, __AT_();
- OBJ point, x, y;
- int i, num;
- XPoint *points;
- XPoint qPoints[100];
-
- if (__isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __isSmallInteger(numberOfPoints)) {
- 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;
- } else
- points = qPoints;
-
- for (i=0; i<num; i++) {
- point = __AT_(aPolygon COMMA_CON, _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 (num > 100)
- free(points);
- RETURN ( self );
- }
-fail: ;
-%}.
- "badGC, badDrawable or coordinates not integer"
- self primitiveFailed
-!
-
copyFromFaxImage:sourceId x:srcX y:srcY to:destId x:dstX y:dstY
width:w height:h with:aGCId scaleX:scaleX scaleY:scaleY
@@ -5820,6 +2431,297 @@
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 = _GCVal(aGCId);
+ Window win = _WindowVal(aDrawableId);
+
+ if (__isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(x0, y0)
+ && __bothSmallInteger(x1, y1)) {
+ 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 = _GCVal(aGCId);
+ Window win = _WindowVal(aDrawableId);
+
+ if (__isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(x, y)) {
+ 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 = _GCVal(aGCId);
+ Window win = _WindowVal(aDrawableId);
+ extern OBJ Point, __AT_();
+ OBJ point, x, y;
+ int i, num;
+ XPoint *points;
+ XPoint qPoints[100];
+
+ if (__isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __isSmallInteger(numberOfPoints)) {
+ 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;
+ } else
+ points = qPoints;
+
+ for (i=0; i<num; i++) {
+ point = __AT_(aPolygon COMMA_CON, _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 (num > 100)
+ free(points);
+ RETURN ( self );
+ }
+fail: ;
+%}.
+ "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 = _GCVal(aGCId);
+ Window win = _WindowVal(aDrawableId);
+ int w, h;
+
+ if (__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)) {
+ 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 = _GCVal(aGCId);
+ Window win = _WindowVal(aDrawableId);
+ unsigned char *cp;
+ OBJ cls;
+ int i1, i2, l, n;
+
+ if (__isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __isNonNilObject(aString)
+ && __bothSmallInteger(index1, index2)
+ && __bothSmallInteger(x, y)) {
+ cls = __qClass(aString);
+ if ((cls == String) || (cls == Symbol)) {
+ i1 = _intVal(index1) - 1;
+ i2 = _intVal(index2) - 1;
+ n = _stringSize(aString);
+ cp = _stringVal(aString);
+ if ((i1 >= 0) && (i2 < n)) {
+ if (i2 >= i1) {
+ cp += i1;
+ l = i2 - i1 + 1;
+ 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 );
+ }
+ }
+#ifdef TWOBYTESTRINGS
+ if (cls == @global(TwoByteString)) {
+ i1 = _intVal(index1) - 1;
+ i2 = _intVal(index2) - 1;
+ n = _byteArraySize(aString) / 2;
+ cp = _stringVal(aString);
+ if ((i1 >= 0) && (i2 < n)) {
+ if (i2 >= i1) {
+ cp += (i1 * 2);
+ l = i2 - i1 + 1;
+ if (l > 1000) l = 1000;
+ 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);
+ RETURN ( self );
+ }
+ }
+ }
+#endif
+ }
+%}.
+ "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 = _GCVal(aGCId);
+ Window win = _WindowVal(aDrawableId);
+ unsigned char *cp;
+ int n;
+ OBJ cls;
+
+ if (__isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __isNonNilObject(aString)
+ && __bothSmallInteger(x, y)) {
+ cls = __qClass(aString);
+ if ((cls == String) || (cls == Symbol)) {
+ cp = _stringVal(aString);
+ 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 );
+ }
+#ifdef TWOBYTESTRINGS
+ if (cls == @global(TwoByteString)) {
+ cp = _stringVal(aString);
+ n = _byteArraySize(aString) / 2;
+ if (n > 1000) n = 1000;
+ 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);
+ RETURN ( self );
+ }
+#endif
+ }
+%}.
+ "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 w:width h:height from:startAngle angle:angle
in:aDrawableId with:aGCId
"fill an arc. If any coordinate is not integer, an error is triggered.
@@ -5864,34 +2766,6 @@
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 (__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
-!
-
fillPolygon:aPolygon in:aDrawableId with:aGCId
"fill a polygon given by its points.
If any coordinate is not integer, an error is triggered."
@@ -5944,67 +2818,32 @@
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
-
-!
-
-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
- ].
+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 (__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
@@ -6111,69 +2950,6 @@
!XWorkstation methodsFor:'event handling'!
-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));
-%}
-!
-
-setEventMask:aMask in:aWindowId
- "tell X that we are only interrested in events from aMask, which
- is the bitwise or of the eventMask bits (see 'eventMaskFor:')"
-
-%{ /* NOCONTEXT */
-
- int mask;
-
- if (__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
-!
-
XXcheckForEndOfDispatch
"return true, if there are still any views of interrest - if not,
stop dispatch"
@@ -6195,47 +2971,6 @@
]
!
-dispatchPendingEvents
- "central event handling method:
- 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"
-
- "interrested in exposes only ?"
- dispatchingExpose notNil ifTrue:[
- [self exposeEventPendingFor:dispatchingExpose] whileTrue:[
- self dispatchExposeEventFor:dispatchingExpose
- ].
- ^ self
- ].
-
- "no, general dispatch"
- [self eventPendingWithoutSync] whileTrue:[
- self dispatchEventFor:nil withMask:nil
- ]
-!
-
-handleExposeOnlyFor:aView
- "from now on, handle expose events only"
-
- dispatchingExpose := aView id
-!
-
-handleAllEvents
- "from now on, handle any kind of event"
-
- dispatchingExpose := nil
-!
-
-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)
-!
-
dispatchEventFor:aViewIdOrNil withMask:eventMask
"central event handling method:
get next event and send appropriate message to the sensor or view.
@@ -6251,65 +2986,12 @@
].
!
-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.
- BUG: uses a static buffer - has to be rewritten, to support multiple
- display connections.
- "
-
-%{ /* UNLIMITEDSTACK */
-
- Display *dpy = myDpy;
- Window win, wWanted;
- int evMask;
- OBJ eB;
- XEvent *ev;
-
- if (! ISCONNECTED) {
- RETURN (false);
- }
-
- 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
+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
@@ -6877,6 +3559,27 @@
^ true
!
+dispatchPendingEvents
+ "central event handling method:
+ 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"
+
+ "interrested in exposes only ?"
+ dispatchingExpose notNil ifTrue:[
+ [self exposeEventPendingFor:dispatchingExpose] whileTrue:[
+ self dispatchExposeEventFor:dispatchingExpose
+ ].
+ ^ self
+ ].
+
+ "no, general dispatch"
+ [self eventPendingWithoutSync] whileTrue:[
+ self dispatchEventFor:nil withMask:nil
+ ]
+!
+
disposeEventsWithMask:aMask for:aWindowIdOrNil
"dispose (throw away) specific events. If aWindowId is nil,
events matching the mask are thrown away regardless of which
@@ -6903,6 +3606,33 @@
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"
@@ -6913,6 +3643,12 @@
^ self eventPendingWithoutSync
!
+eventPending:anEventSymbol for:aWindowIdOrNil
+ "return true, if a specific event is pending"
+
+ ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil
+!
+
eventPendingWithSync
"return true, if any event is pending.
Do a flush output buffer before."
@@ -6945,6 +3681,33 @@
%}
!
+eventsPending:anEventMask for:aWindowIdOrNil
+ "return true, if any of the masked events is pending"
+
+%{ /* UNLIMITEDSTACK */
+
+ Display *dpy = myDpy;
+ XEvent ev;
+ Window win;
+ int thereIsOne;
+
+ if (ISCONNECTED && __isSmallInteger(anEventMask)) {
+ 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
"return true, if any expose event is pending"
@@ -6972,37 +3735,77 @@
%}
!
-eventsPending:anEventMask for:aWindowIdOrNil
- "return true, if any of the masked events is pending"
+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.
+ BUG: uses a static buffer - has to be rewritten, to support multiple
+ display connections.
+ "
%{ /* UNLIMITEDSTACK */
Display *dpy = myDpy;
- XEvent ev;
- Window win;
- int thereIsOne;
-
- if (ISCONNECTED && __isSmallInteger(anEventMask)) {
- 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);
+ Window win, wWanted;
+ int evMask;
+ OBJ eB;
+ XEvent *ev;
+
+ if (! ISCONNECTED) {
+ RETURN (false);
+ }
+
+ 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 );
}
- }
- RETURN ( false );
-%}
-!
-
-eventPending:anEventSymbol for:aWindowIdOrNil
- "return true, if a specific event is pending"
-
- ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil
+ } 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
@@ -7016,4 +3819,3175 @@
].
"Created: 1.12.1995 / 16:28:23 / stefan"
+!
+
+setEventMask:aMask in:aWindowId
+ "tell X that we are only interrested in events from aMask, which
+ is the bitwise or of the eventMask bits (see 'eventMaskFor:')"
+
+%{ /* NOCONTEXT */
+
+ int mask;
+
+ if (__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:'font stuff'!
+
+ascentOf:aFontId
+ "the normal ascent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->ascent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+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));
+ 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 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].
+ coding := aString copyFrom:start to:(end - 1).
+
+ aBlock value:family value:face value:style value:size value:coding.
+ ^ true
+
+ "Modified: 27.9.1995 / 10:46:52 / stefan"
+!
+
+descentOf:aFontId
+ "the normal descent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->descent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+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] COMMA_CON);
+ 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:styleString size:sizeArg encoding:encodingSym
+
+ "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."
+
+ |theSize theName theId xlatedStyle enc|
+
+ "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
+ ].
+
+"/ new:
+ xlatedStyle := styleString.
+ xlatedStyle notNil ifTrue:[
+ xlatedStyle := xlatedStyle first asString
+ ].
+
+ ^ self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:'normal'
+ pixelSize:nil
+ size:sizeArg
+ registry:'*'
+ encoding:encodingSym.
+
+
+"/ old:
+"/ xlatedStyle := styleString.
+"/ "oblique is named italic in times font"
+"/ ((familyString = 'Times') or:[familyString = 'times']) ifTrue:[
+"/ ((styleString = 'Oblique') or:[styleString = 'oblique']) ifTrue:[
+"/ xlatedStyle := 'italic'
+"/ ]
+"/ ].
+"/ (xlatedStyle = 'italic') ifTrue:[
+"/ xlatedStyle := 'i'
+"/ ] ifFalse:[
+"/ (xlatedStyle = 'roman') ifTrue:[
+"/ xlatedStyle := 'r'
+"/ ] ifFalse:[
+"/ (xlatedStyle = 'oblique') ifTrue:[
+"/ xlatedStyle := 'o'
+"/ ]
+"/ ]
+"/ ].
+"/
+"/ theId := nil.
+"/ theSize := sizeArg.
+"/ [theId isNil] whileTrue:[
+"/ "this works only on Release >= 3 - X-servers"
+"/ enc := encodingSym.
+"/ enc isNil ifTrue:[
+"/ enc := '*'
+"/ ].
+"/ theName := ('-*-' , familyString ,
+"/ '-' , faceString ,
+"/ '-' , xlatedStyle , '-*-*-*-'
+"/ , theSize printString , '0-*-*-*-*-'
+"/ , enc , '-*').
+"/"
+"/Transcript showCr:theName; endEntry.
+"/"
+"/ theId := self createFontFor:theName.
+"/ theId isNil ifTrue:[
+"/ "could not get the font - try next smaller one"
+"/ theSize := theSize - 1.
+"/ (theSize < (sizeArg // 2)) ifTrue:[
+"/ "thats too much - give up"
+"/ ^ self getDefaultFont
+"/ "^ nil"
+"/ ]
+"/ ]
+"/ ].
+"/ (theSize ~~ sizeArg) ifTrue:[
+"/ Transcript show:'next smaller font: '.
+"/ Transcript showCr:theName
+"/ ].
+"/ ^ theId
+!
+
+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 ... '*'
+ "
+
+ |theName sMatch|
+
+ "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:[sMatch := '*'] ifFalse:[sMatch := size printString , '0'].
+
+ theName := ('-' , (foundry isNil ifTrue:['*'] ifFalse:[foundry]),
+ '-' , (family isNil ifTrue:['*'] ifFalse:[family]),
+ '-' , (weight isNil ifTrue:['*'] ifFalse:[weight]) ,
+ '-' , (slant isNil ifTrue:['*'] ifFalse:[slant]) ,
+ '-' , (spc isNil ifTrue:['*'] ifFalse:[spc]) ,
+ '-*' ,
+ '-' , (pSize isNil ifTrue:['*'] ifFalse:[pSize printString]),
+ '-' , sMatch ,
+ '-*-*-*-*' ,
+ '-' , (registry isNil ifTrue:['*'] ifFalse:[registry]) ,
+ '-' , (encoding isNil ifTrue:['*'] ifFalse:[encoding])).
+"/ Transcript showCr:theName; endEntry.
+
+ ^ self createFontFor:theName.
+
+ "
+ Display getFontWithFoundry:'*'
+ family:'courier'
+ weight:'medium'
+ slant:'r'
+ spacing:nil
+ pixelSize:nil
+ size:13
+ registry:'iso8859'
+ encoding:'*'
+ "
+!
+
+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 names aName fntDescr|
+
+ 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
+ "
+
+ "Modified: 27.9.1995 / 10:54:47 / stefan"
+!
+
+maxAscentOf:aFontId
+ "the max ascent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.ascent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+maxDescentOf:aFontId
+ "the max descent"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.descent) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+maxWidthOfFont:aFontId
+ "the width of the widest character"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->max_bounds.width) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+minWidthOfFont:aFontId
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ RETURN ( _MKSMALLINT(f->min_bounds.width) );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+releaseFont:aFontId
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ BEGIN_INTERRUPTSBLOCKED
+ XFreeFont(myDpy, f);
+ END_INTERRUPTSBLOCKED
+ RETURN ( self );
+ }
+ }
+%}
+.
+ self primitiveFailed
+!
+
+sizesInFamily:aFamilyName face:aFaceName style:aStyleName
+ "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.
+ (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'
+ "
+!
+
+widthOf:aString from:index1 to:index2 inFont:aFontId
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+ char *cp;
+ int len, n, i1, i2;
+
+ if (__bothSmallInteger(index1, index2)
+ && __isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ i1 = _intVal(index1) - 1;
+ i2 = _intVal(index2) - 1;
+ if (__isString(aString) || __isSymbol(aString)) {
+ cp = (char *) _stringVal(aString);
+ n = _stringSize(aString);
+ if ((i1 >= 0) && (i2 >= i1) && (i2 < n)) {
+ cp += i1;
+ BEGIN_INTERRUPTSBLOCKED
+ len = XTextWidth(f, cp, i2 - i1 + 1);
+ END_INTERRUPTSBLOCKED
+ RETURN ( _MKSMALLINT(len) );
+ }
+ }
+#ifdef TWOBYTESTRINGS
+ if (__Class(aString) == @global(TwoByteString)) {
+ cp = (char *) _stringVal(aString);
+ n = _byteArraySize(aString) / 2;
+ if ((i1 >= 0) && (i2 >= i1) && (i2 < n)) {
+ cp += (i1 * 2);
+ BEGIN_INTERRUPTSBLOCKED
+ len = XTextWidth16(f, (XChar2b *)cp, i2 - i1 + 1);
+ END_INTERRUPTSBLOCKED
+ RETURN ( _MKSMALLINT(len) );
+ }
+ }
+#endif
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+widthOf:aString inFont:aFontId
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+ char *cp;
+ int len, n;
+
+ if (__isExternalAddress(aFontId)) {
+ f = _FontVal(aFontId);
+ if (__isString(aString) || __isSymbol(aString)) {
+ n = _stringSize(aString);
+ cp = (char *)_stringVal(aString);
+ BEGIN_INTERRUPTSBLOCKED
+ len = XTextWidth(f, cp, n);
+ END_INTERRUPTSBLOCKED
+ RETURN ( _MKSMALLINT(len) );
+ }
+#ifdef TWOBYTESTRINGS
+ if (__Class(aString) == @global(TwoByteString)) {
+ n = _byteArraySize(aString) / 2;
+ cp = (char *) _stringVal(aString);
+ BEGIN_INTERRUPTSBLOCKED
+ len = XTextWidth16(f, (XChar2b *)cp, n);
+ END_INTERRUPTSBLOCKED
+ RETURN ( _MKSMALLINT(len) );
+ }
+#endif
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+! !
+
+!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) {
+ BEGIN_INTERRUPTSBLOCKED
+ XAllowEvents(myDpy, _mode, CurrentTime);
+ END_INTERRUPTSBLOCKED
+ RETURN (self);
+ }
+%}
+.
+ self primitiveFailed
+!
+
+grabKeyboardIn:aWindowId
+ "grab the keyboard"
+
+%{ /* NOCONTEXT */
+ int result, ok;
+
+ if (__isExternalAddress(aWindowId)) {
+ BEGIN_INTERRUPTSBLOCKED
+ result = XGrabKeyboard(myDpy,
+ _WindowVal(aWindowId),
+ True /* False */,
+ GrabModeAsync,
+ GrabModeAsync,
+ CurrentTime);
+ END_INTERRUPTSBLOCKED
+ ok = 0;
+ switch(result) {
+ case AlreadyGrabbed:
+ printf("XWORKSTAT: grab keyboard: AlreadyGrabbed\n");
+ break;
+ case GrabNotViewable:
+ printf("XWORKSTAT: grab keyboard: GrabNotViewable\n");
+ break;
+ case GrabInvalidTime:
+ printf("XWORKSTAT: grab keyboard: InvalidTime\n");
+ break;
+ case GrabFrozen:
+ printf("XWORKSTAT: 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 (__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:
+ printf("XWORKSTAT: grab pointer: AlreadyGrabbed\n");
+ break;
+ case GrabNotViewable:
+ printf("XWORKSTAT: grab pointer: GrabNotViewable\n");
+ break;
+ case GrabInvalidTime:
+ printf("XWORKSTAT: grab pointer: InvalidTime\n");
+ break;
+ case GrabFrozen:
+ printf("XWORKSTAT: 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:aGCId
+ "disable clipping rectangle"
+
+%{ /* NOCONTEXT */
+
+ XGCValues gcv;
+ GC gc = _GCVal(aGCId);
+
+ if (__isExternalAddress(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 (__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 */
+
+ Display *dpy = myDpy;
+ GC gc = _GCVal(aGCId);
+ Pixmap bitmap;
+
+ if (__isExternalAddress(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:aGCId
+ "enable/disable drawing into child views"
+
+%{ /* NOCONTEXT */
+
+ XGCValues gcv;
+ GC gc = _GCVal(aGCId);
+
+ if (__isExternalAddress(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:aGCId
+ "clip to a rectangle"
+
+%{ /* NOCONTEXT */
+
+ XRectangle r;
+
+ 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
+!
+
+setFont:aFontId in:aGCId
+ "set font to be drawn in"
+
+%{ /* NOCONTEXT */
+
+ XFontStruct *f;
+
+ 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 */
+
+ Display *dpy = myDpy;
+ GC gc = _GCVal(aGCId);
+
+ if (__bothSmallInteger(fgColorIndex, bgColorIndex)
+ && __isExternalAddress(aGCId)) {
+ XSetForeground(dpy, gc, _intVal(fgColorIndex));
+ XSetBackground(dpy, gc, _intVal(bgColorIndex));
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+!
+
+setForeground:fgColor background:bgColor mask:aBitmapId in:aGCId
+ "set foreground and background colors to be drawn with using mask or
+ solid (if aBitmapId is nil)"
+
+%{ /* NOCONTEXT */
+
+ Display *dpy = myDpy;
+ GC gc = _GCVal(aGCId);
+
+ if (__isExternalAddress(aGCId)) {
+ if (__isSmallInteger(fgColor))
+ XSetForeground(dpy, gc, _intVal(fgColor));
+ if (__isSmallInteger(bgColor))
+ XSetBackground(dpy, gc, _intVal(bgColor));
+
+ if (__isExternalAddress(aBitmapId)) {
+ XSetStipple(dpy, gc, _PixmapVal(aBitmapId));
+ XSetFillStyle(dpy, gc, FillOpaqueStippled);
+ RETURN ( self );
+ }
+ if (aBitmapId == nil) {
+ XSetFillStyle(dpy, gc, FillSolid);
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailed
+!
+
+setForeground:fgColor background:bgColor mask:aBitmapId lineWidth:lw in:aGCId
+ "set foreground and background colors to be drawn with using mask or
+ solid (if aBitmapId is nil); also set lineWidth"
+
+%{ /* NOCONTEXT */
+
+ Display *dpy = myDpy;
+ GC gc = _GCVal(aGCId);
+
+ if (__isExternalAddress(aGCId)) {
+ if (__isSmallInteger(lw)) {
+ XSetLineAttributes(dpy, gc, _intVal(lw),
+ LineSolid, CapNotLast, JoinMiter);
+ }
+ if (__isSmallInteger(fgColor))
+ XSetForeground(dpy, gc, _intVal(fgColor));
+ if (__isSmallInteger(bgColor))
+ XSetBackground(dpy, gc, _intVal(bgColor));
+
+ if (__isExternalAddress(aBitmapId)) {
+ XSetStipple(dpy, gc, _PixmapVal(aBitmapId));
+ XSetFillStyle(dpy, gc, FillOpaqueStippled);
+ RETURN ( self );
+ }
+ if (aBitmapId == nil) {
+ XSetFillStyle(dpy, gc, FillSolid);
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailed
+!
+
+setForeground:fgColorIndex in:aGCId
+ "set foreground color to be drawn with"
+
+%{ /* NOCONTEXT */
+
+ 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 = _GCVal(aGCId);
+ int fun = -1;
+
+ if (__isExternalAddress(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 (__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"
+
+%{ /* NOCONTEXT */
+
+ int x_style, x_cap, x_join;
+
+ 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 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 (__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 = _GCVal(aGCId);
+ Pixmap pixmap;
+
+ if (__isExternalAddress(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'!
+
+close
+ "close down the connection to the X-server"
+
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ BEGIN_INTERRUPTSBLOCKED
+ XCloseDisplay(myDpy);
+ _INST(displayId) = nil;
+ 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|
+
+ dpyName := aDisplayName.
+ dpyName isNil ifTrue:[
+ "look for a '-display xxx' argument"
+ Arguments 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;
+ int shapeEventBase, shapeErrorBase;
+ int shmEventBase, shmErrorBase;
+ int faxEventBase, faxErrorBase;
+ 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") COMMA_CON);
+ nm = NULL;
+ }
+ dpy = XOpenDisplay(nm);
+
+ if (dpy) {
+ _INST(displayId) = dpyID = __MKOBJ(dpy); __STORE(self, dpyID);
+
+#ifdef SUPERDEBUG
+ XSynchronize(dpy, 1);
+#endif
+
+ XSetErrorHandler(__XErrorHandler__);
+ }
+
+ END_INTERRUPTSBLOCKED
+%}.
+ displayId isNil ifTrue:[
+ 'XWORKSTATION: cannot connect to Display.' errorPrintNL.
+ ^ 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 initializeDefaultValues.
+ self initializeEventBuffer.
+ self initializeSpecialFlags.
+ self initializeKeyboardMap.
+
+ ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayError.
+!
+
+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.
+
+ 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
+%{ /* NOCONTEXT */
+
+ Display *dpy = myDpy;
+ 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;
+ int faxEventBase, faxErrorBase;
+ char *type, *nm;
+ int dummy;
+ int mask, shift, nBits;
+
+ if (ISCONNECTED) {
+ _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, &shapeEventBase, &shapeErrorBase))
+ _INST(hasShapeExtension) = true;
+ else
+#endif
+ _INST(hasShapeExtension) = false;
+
+#ifdef SHM
+ if (XShmQueryExtension(dpy, &shmEventBase, &shmErrorBase))
+ _INST(hasShmExtension) = true;
+ else
+#endif
+ _INST(hasShmExtension) = false;
+
+#ifdef FAX
+ if (XFAXImageQueryExtension(dpy, &faxEventBase, &faxErrorBase))
+ _INST(hasFaxExtension) = true;
+ else
+#endif
+ _INST(hasFaxExtension) = 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
+
+ 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'!
+
+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."
+
+%{ /* 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)"
+
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ BEGIN_INTERRUPTSBLOCKED
+ XSync(myDpy, 0);
+ END_INTERRUPTSBLOCKED
+ }
+%}
+!
+
+flushDpsContext:aDPSContext
+
+%{ /* NOCONTEXT */
+#ifdef DPS
+ if (__isExternalAddress(aDPSContext)) {
+ BEGIN_INTERRUPTSBLOCKED
+ DPSFlushContext(MKDPSCONTEXT(aDPSContext));
+ END_INTERRUPTSBLOCKED
+ RETURN ( self );
+ }
+#endif
+%}
+.
+ self primitiveFailed
+!
+
+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
+!
+
+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
+!
+
+unBuffered
+ "make all drawing be sent immediately to the display"
+
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ BEGIN_INTERRUPTSBLOCKED
+ XSynchronize(myDpy, 1);
+ END_INTERRUPTSBLOCKED
+ }
+%}
+ "Display unbuffered"
+! !
+
+!XWorkstation methodsFor:'pointer queries '!
+
+buttonStates
+ "return an integer representing the state of the pointer buttons;
+ a one-bit in positions 0.. represent a pressed button"
+
+%{ /* NOCONTEXT*/
+ Display *dpy = myDpy;
+ Window w;
+ int screen = _intVal(_INST(screen));
+ Window rootRet, childRet;
+ int rootX, rootY, winX, winY;
+ unsigned int mask;
+
+ 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));
+%}
+!
+
+leftButtonStateMask
+ "return an integer for masking out the left button from a
+ buttonStates value"
+
+ ^ 256
+!
+
+middleButtonStateMask
+ "return an integer for masking out the middle button from a
+ buttonStates value"
+
+ ^ 512
+!
+
+pointerPosition
+ "return the current pointer position in root-window coordinates"
+
+ |xpos ypos|
+
+%{
+ Display *dpy = myDpy;
+ Window w;
+ int screen = _intVal(_INST(screen));
+ Window rootRet, childRet;
+ int rootX, rootY, winX, winY;
+ unsigned int mask;
+
+ 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"
+
+ ^ 1024
+!
+
+rootPositionOfLastEvent
+ "return the position in root-window coordinates
+ of the last button, key or pointer event"
+
+ ^ eventRootX @ eventRootY
+! !
+
+!XWorkstation methodsFor:'resources'!
+
+getResource:name class:cls
+%{
+ 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 COMMA_CON) : nil );
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+! !
+
+!XWorkstation methodsFor:'retrieving pixels'!
+
+getBitsFrom: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."
+
+ |info|
+
+ ((w <= 0) or:[h <= 0]) ifTrue:[
+ self primitiveFailed.
+ ^ nil
+ ].
+
+ info := Array with:nil "depth"
+ with:nil "bit order"
+ with:nil "bytes_per_line"
+ with:nil "byte_order".
+
+ "/ 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 infoInfo:info) ifTrue:[
+ ^ 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."
+
+%{ /* UNLIMITEDSTACK NOCONTEXT */
+
+ Window win = _WindowVal(aDrawableId);
+ XImage *img;
+ int ret;
+ int xpos, ypos;
+
+ if (__isExternalAddress(aDrawableId) && __bothSmallInteger(x, y)) {
+ 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);
+ ret = XGetPixel(img, 0, 0);
+ XDestroyImage(img);
+ RETURN ( _MKSMALLINT(ret) );
+ }
+%}.
+ ^ nil
+!
+
+primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInfo:info
+ "since XGetImage may allocate huge amount of stack space
+ (some implementations use alloca), this must run with unlimited stack."
+
+%{ /* UNLIMITEDSTACK */
+
+ Display *dpy = myDpy;
+ Window win = _WindowVal(aDrawableId);
+ XImage *image = (XImage *)0;
+ int pad, bytes_per_line, numBytes;
+
+ if (__isExternalAddress(aDrawableId)
+ && __bothSmallInteger(srcx, srcy)
+ && __bothSmallInteger(w, h)
+ && __isArray(info)
+ && __isByteArray(imageBits)) {
+ image = XGetImage(dpy, win, _intVal(srcx), _intVal(srcy),
+ _intVal(w), _intVal(h),
+ (unsigned)AllPlanes, ZPixmap);
+
+ 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("unsupported depth:%d in primGetBits\n", image->depth);
+ goto fail;
+ }
+
+#ifdef SUPERDEBUG
+ printf("bytes need:%d bytes given:%d\n", numBytes, _byteArraySize(imageBits));
+#endif
+
+ if (numBytes > _byteArraySize(imageBits)) {
+ /* imageBits too small */
+ 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);
+ bcopy(image->data, _ByteArrayInstPtr(imageBits)->ba_element, numBytes);
+ XDestroyImage(image);
+ RETURN ( true );
+ }
+fail:
+ if (image) {
+ XDestroyImage(image);
+ }
+%}.
+ ^ false
+! !
+
+!XWorkstation methodsFor:'selections'!
+
+atomIDOf:aStringOrSymbol
+ "return an Atoms ID; dont create if not already present"
+
+ ^ self atomIDOf:aStringOrSymbol create:false
+!
+
+atomIDOf:aStringOrSymbol create:create
+ "return an Atoms ID; if create is true, create it if not already present"
+
+%{ /* 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
+ ^ cutBuffer0Atom
+!
+
+atomIDOfLENGTH
+ ^ lengthAtom
+!
+
+atomIDOfPRIMARY
+ ^ primaryAtom
+!
+
+atomIDOfSECONDARY
+ ^ secondaryAtom
+!
+
+atomIDOfSTRING
+ ^ stringAtom
+!
+
+atomName:anAtomID
+%{ /* NOCONTEXT */
+ OBJ str;
+ char *name;
+
+ if (ISCONNECTED) {
+ if (__isAtomID(anAtomID)) {
+ name = XGetAtomName(myDpy, _AtomVal(anAtomID));
+ if (name == 0) {
+ RETURN (nil);
+ }
+ str = __MKSTRING(name COMMA_CON);
+ XFree(name);
+ RETURN ( str );
+ }
+ }
+%}.
+ self primitiveFailed.
+ ^ nil
+
+ "
+ Display atomName:1
+ "
+!
+
+getObjectProperty:propertyID from:aWindowID
+ "get an object property; 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
+!
+
+getProperty:propertyID from:aWindowID into:aTwoArgBlock
+ "get a property, evaluate aTwoArgBlock with typeID and value"
+
+ |val typeID cls|
+
+ cls := ByteArray.
+%{
+ Display *dpy = myDpy;
+ 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;
+ OBJ __new(), __MKSTRING_L();
+# define PROP_SIZE 2048
+
+ 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) 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 COMMA_CON);
+ } 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
+!
+
+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 */
+ Display *dpy = myDpy;
+ Atom selection;
+ Window window;
+
+ if (__isAtomID(selectionAtomID) && ISCONNECTED) {
+ window = XGetSelectionOwner(dpy, _AtomVal(selectionAtomID));
+ RETURN ((window == None) ? nil : __MKOBJ(window));
+ }
+%}.
+ self primitiveFailed.
+ ^ nil
+!
+
+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
+!
+
+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 */
+ Display *dpy = myDpy;
+ Atom sel_prop;
+ char *cp;
+
+ if (__isExternalAddress(aWindowId)
+ && ISCONNECTED
+ && __isSmallInteger(typeID)
+ && __isAtomID(selectionID)) {
+ 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 */
+ Display *dpy = myDpy;
+
+ if (__isAtomID(propertyID)
+ && __isExternalAddress(requestorID)
+ && ISCONNECTED
+ && __isAtomID(targetID)
+ && __isAtomID(selectionID)) {
+ 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 (self )
+ }
+%}
+.
+ self primitiveFailed
+!
+
+setLengthProperty:propertyID value:aNumber for:aWindowID
+ ^ self setProperty:propertyID type:(self atomIDOfLENGTH) value:aNumber for:aWindowID
+!
+
+setObjectProperty:propertyID value:anObject for:aWindowID
+ |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
+!
+
+setProperty:propertyID type:typeID value:anObject for:aWindowID
+
+%{ /* UNLIMITEDSTACK */
+
+ Display *dpy = myDpy;
+ Atom prop, type;
+ Window window;
+ unsigned int value;
+
+ if (__isAtomID(propertyID)
+ && __isAtomID(typeID)
+ && ISCONNECTED
+ && (__isString(anObject)
+ || __isSmallInteger(anObject)
+ || __isSymbol(anObject)
+ || __isByteArray(anObject))) {
+
+ 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 */
+ XChangeProperty(dpy, window, prop, XA_STRING, 8,
+ PropModeReplace,
+ _stringVal(anObject),
+ strlen(_stringVal(anObject)));
+ }
+ }
+ RETURN (true);
+ }
+%}.
+ ^ 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 */
+ Display *dpy = myDpy;
+ Window win;
+
+ if (__isExternalAddress(aWindowId)
+ && __isAtomID(selectionID)
+ && ISCONNECTED) {
+ win = _WindowVal(aWindowId);
+ XSetSelectionOwner(dpy, _AtomVal(selectionID), win, CurrentTime);
+ if (XGetSelectionOwner(dpy, _AtomVal(selectionID)) != win) {
+ RETURN (false);
+ }
+ RETURN (true);
+ }
+%}
+.
+ self primitiveFailed.
+ ^ nil
+!
+
+setTextProperty:propertyID value:aString for:aWindowID
+ ^ self setProperty:propertyID type:(self atomIDOfSTRING) value:aString for:aWindowID
+!
+
+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:[
+ 'ownerchange failed' errorPrintNL.
+ ].
+ ^ self setTextProperty:cutBuffer0Atom value:aString for:nil
+! !
+
+!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 (__isExternalAddress(aWindowId)
+ && __bothSmallInteger(x, y)
+ && __bothSmallInteger(width, height)) {
+ w = _intVal(width);
+ h = _intVal(height);
+ if (w < 0) w = 0;
+ if (h < 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 (__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 (__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 (__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;
+ Display *dpy = myDpy;
+ Window win;
+
+ if (__isExternalAddress(aWindowId)) {
+ 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 (__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 (__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 (__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 (__isExternalAddress(aWindowId)) {
+ XRaiseWindow(myDpy, _WindowVal(aWindowId));
+ RETURN ( self );
+ }
+%}
+.
+ self primitiveFailed
+!
+
+resizeWindow:aWindowId width:w height:h
+ "resize a window"
+
+%{ /* NOCONTEXT */
+
+ int newWidth, newHeight;
+
+ if (__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 (__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 (__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 (__isExternalAddress(aWindowId)
+ && __isExternalAddress(aCursorId)) {
+ XDefineCursor(dpy, _WindowVal(aWindowId), _CursorVal(aCursorId));
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+!
+
+setIconName:aString in:aWindowId
+ "define a windows iconname"
+
+%{ /* NOCONTEXT */
+
+ if (__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 (__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 (__isExternalAddress(aWindowId)
+ && __isExternalAddress(aMainWindowId)) {
+ XSetTransientForHint(myDpy, _WindowVal(aWindowId),
+ _WindowVal(aMainWindowId));
+ RETURN ( self );
+ }
+%}.
+ 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 (__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 (__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 (__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 (__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 (__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 (__isExternalAddress(aWindowId)
+ && __isSmallInteger(aNumber)) {
+ XSetWindowBorderWidth(myDpy, _WindowVal(aWindowId), _intVal(aNumber));
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+!
+
+setWindowGravity:how in:aWindowId
+ "set window gravity for a window"
+
+%{ /* NOCONTEXT */
+
+ XSetWindowAttributes wa;
+
+ if (__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 (__isExternalAddress(iconId)
+ && __isExternalAddress(aWindowId)) {
+ XWMHints hints;
+
+ hints.icon_pixmap = _PixmapVal(iconId);
+ hints.flags = IconPixmapHint;
+ 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 (__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 (__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 (__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 (__isExternalAddress(aWindowId)) {
+ XUnmapWindow(myDpy, _WindowVal(aWindowId));
+ RETURN ( self );
+ }
+%}
+.
+ self primitiveFailed
+! !
+
+!XWorkstation class methodsFor:'documentation'!
+
+version
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.88 1995-12-10 00:21:44 cg Exp $'
+! !
+XWorkstation initialize!