--- a/XWorkstation.st Thu Feb 06 12:50:14 2014 +0100
+++ b/XWorkstation.st Thu May 08 10:27:51 2014 +0200
@@ -1,6 +1,6 @@
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -9,6 +9,8 @@
other person. No title to or ownership of the software is
hereby transferred.
"
+'From Smalltalk/X, Version:6.2.3.0 on 04-04-2014 at 21:28:11' !
+
"{ Package: 'stx:libview' }"
DeviceWorkstation subclass:#XWorkstation
@@ -50,6 +52,13 @@
privateIn:XWorkstation
!
+DeviceGraphicsContext subclass:#X11GraphicsContext
+ instanceVariableNames:'useXftFont xftDrawId'
+ classVariableNames:''
+ poolDictionaries:''
+ privateIn:XWorkstation
+!
+
!XWorkstation primitiveDefinitions!
%{
@@ -247,16 +256,16 @@
*/
#define __ENTER_XLIB(whichTimeout) \
{ \
- __blockingPrimitiveTimoutHandler__ = (VOIDFUNC)__XTimeoutErrorHandler; \
- __blockingPrimitiveTimeoutArg__ = self; \
- __blockingPrimitiveTimeout__ = __intVal(__INST(whichTimeout)) * 1000; \
+ __blockingPrimitiveTimoutHandler__ = (VOIDFUNC)__XTimeoutErrorHandler; \
+ __blockingPrimitiveTimeoutArg__ = self; \
+ __blockingPrimitiveTimeout__ = __intVal(__INST(whichTimeout)) * 1000; \
} {
#define LEAVE_XLIB() \
{ \
- __blockingPrimitiveTimoutHandler__ = (VOIDFUNC)0; \
- __blockingPrimitiveTimeoutArg__ = nil; \
- __blockingPrimitiveTimeout__ = 0; \
+ __blockingPrimitiveTimoutHandler__ = (VOIDFUNC)0; \
+ __blockingPrimitiveTimeoutArg__ = nil; \
+ __blockingPrimitiveTimeout__ = 0; \
} }
#define ENTER_XLIB() __ENTER_XLIB(xlibTimeout)
@@ -350,18 +359,18 @@
# endif
static
dummyToForceLoading() {
- XCreateSimpleWindow(0, 0, 0, 0, 0, 0, 0, 0, 0);
- XCloseDisplay(0);
- XCreateImage(0, 0, 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0);
- XSetWindowColormap(0, 0, 0);
- XQueryColors(0,0,0,0);
+ XCreateSimpleWindow(0, 0, 0, 0, 0, 0, 0, 0, 0);
+ XCloseDisplay(0);
+ XCreateImage(0, 0, 0 ,0 ,0 ,0 ,0 ,0 ,0 ,0);
+ XSetWindowColormap(0, 0, 0);
+ XQueryColors(0,0,0,0);
# ifdef SHM
- XShmAttach(0, 0);
- XShmCreateImage(0, 0, 0, 0, 0, 0, 0 ,0);
- XShmDetach(0, 0);
- XShmPutImage(0, 0, 0, 0 , 0,0,0,0,0,0,0);
- shmctl(0,0,0);
- fgetc(0);
+ XShmAttach(0, 0);
+ XShmCreateImage(0, 0, 0, 0, 0, 0, 0 ,0);
+ XShmDetach(0, 0);
+ XShmPutImage(0, 0, 0, 0 , 0,0,0,0,0,0,0);
+ shmctl(0,0,0);
+ fgetc(0);
# endif
}
#endif
@@ -386,36 +395,39 @@
lastErrorMsg[127] = '\0';
if (lastErrorMsg[0] == '\0') {
- sprintf(lastErrorMsg, "code: %d", event->error_code);
+ sprintf(lastErrorMsg, "code: %d", event->error_code);
}
lastRequestCode = event->request_code;
lastMinorCode = event->minor_code;
lastResource = event->resourceid;
if ((event->error_code == BadWindow) && (lastRequestCode == 4) && (lastMinorCode == 0)) {
- /*
- * this is a BadWindow error for X_DestroyWindow.
- * ignore it here, since it results from the GC freeing windows
- * in non bottom-up window order.
- */
- return 0;
+ /*
+ * this is a BadWindow error for X_DestroyWindow.
+ * ignore it here, since it results from the GC freeing windows
+ * in non bottom-up window order.
+ */
+ return 0;
}
if (@global(DeviceWorkstation:ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [error]: x-error caught maj=%d (0x%x) min=%d (0x%x) resource=%"_lx_"\n",
- event->request_code, event->request_code,
- event->minor_code, event->minor_code, (INT)(event->resourceid));
- console_fprintf(stderr, "XWorkstation [error]: x-error message is [%d] '%s'\n",
- event->error_code, lastErrorMsg);
- }
+ console_fprintf(stderr, "XWorkstation [error]: x-error caught maj=%d (0x%x) min=%d (0x%x) resource=%"_lx_"\n",
+ event->request_code, event->request_code,
+ event->minor_code, event->minor_code, (INT)(event->resourceid));
+ console_fprintf(stderr, "XWorkstation [error]: x-error message is [%d] '%s'\n",
+ event->error_code, lastErrorMsg);
+ }
+#if 0
+ // cg: should no longer be needed - librun no longer sends an errorInterrupt while running on C-stack
#ifdef XFT
if ((strncmp(lastErrorMsg, "RenderBadPicture", 16) == 0)) {
- /*
- * this is a RenderBadPicture error from XFT drawing.
- * ignore it for now, as this is due to an incomplete implementation
- */
- console_fprintf(stderr, "XWorkstation [info]: x-error ignored\n");
- return 0;
- }
+ /*
+ * this is a RenderBadPicture error from XFT drawing.
+ * ignore it for now, as this is due to an incomplete implementation
+ */
+ console_fprintf(stderr, "XWorkstation [info]: x-error ignored\n");
+ return 0;
+ }
+#endif
#endif
__errorInterruptWithIDAndParameter__(@symbol(DisplayError), __MKEXTERNALADDRESS(dpy));
return 0;
@@ -434,10 +446,10 @@
Display *dpy;
{
if (@global(DeviceWorkstation:ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [error]: I/O error\n");
+ console_fprintf(stderr, "XWorkstation [error]: I/O error\n");
}
__immediateErrorInterruptWithIDAndParameter__(@symbol(DisplayIOError),
- __MKEXTERNALADDRESS(dpy));
+ __MKEXTERNALADDRESS(dpy));
#if 0
/*
@@ -469,12 +481,12 @@
OBJ displayDeviceInst;
{
if ((displayDeviceInst == @global(MainDisplay))
- || (displayDeviceInst == @global(DeviceWorkstation:DefaultScreen))) {
- console_fprintf(stderr, "XWorkstation [error]: keep display connection for master display after X11 timeout (no shutdown)\n");
- return;
+ || (displayDeviceInst == @global(DeviceWorkstation:DefaultScreen))) {
+ console_fprintf(stderr, "XWorkstation [error]: keep display connection for master display after X11 timeout (no shutdown)\n");
+ return;
}
if (@global(DeviceWorkstation:ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [error]: X11 request timeout dpy=%"_lx_"\n", (INT)displayDeviceInst);
+ console_fprintf(stderr, "XWorkstation [error]: X11 request timeout dpy=%"_lx_"\n", (INT)displayDeviceInst);
}
__OINST(displayDeviceInst, hasConnectionBroken) = true;
@@ -486,14 +498,14 @@
* if we return from the error interrupt ...
*/
if (__OINST(displayDeviceInst, displayId) != nil) {
- __internalError("unhandled X11 display timeout error");
-
- /*
- * the current process failed to do an X11 request.
- * Terminate it!
- */
- __terminateProcess(0); /* soft terminate */
- __terminateProcess(1); /* hard terminate */
+ __internalError("unhandled X11 display timeout error");
+
+ /*
+ * the current process failed to do an X11 request.
+ * Terminate it!
+ */
+ __terminateProcess(0); /* soft terminate */
+ __terminateProcess(1); /* hard terminate */
}
}
@@ -505,7 +517,7 @@
copyright
"
COPYRIGHT (c) 1989 by Claus Gittinger
- All Rights Reserved
+ 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
@@ -531,28 +543,28 @@
query is answered by the launcher when opening its applications.
Timeouts:
- sometimes, X-connections are lost and, as the Xlib is blocking and synchronous by
- default, this would lead to a locked ST/X system.
- Therefore, this class defines a timeOut, whenever doing an Xlib call.
- The default for this timeout is 30seconds.
- This may be a problem with windowmanagers which show a rubber-band rectangle
- when creating windows.
- If the user does not specify the rectangle within 30 seconds, the device assumes
- a timeout and closes the connection.
- As a (kludgy) workaround, a second timeout value is used for window-creation.
- This secondary timeout value defaults to 60*5 seconds (5 minutes).
+ sometimes, X-connections are lost and, as the Xlib is blocking and synchronous by
+ default, this would lead to a locked ST/X system.
+ Therefore, this class defines a timeOut, whenever doing an Xlib call.
+ The default for this timeout is 30seconds.
+ This may be a problem with windowmanagers which show a rubber-band rectangle
+ when creating windows.
+ If the user does not specify the rectangle within 30 seconds, the device assumes
+ a timeout and closes the connection.
+ As a (kludgy) workaround, a second timeout value is used for window-creation.
+ This secondary timeout value defaults to 60*5 seconds (5 minutes).
See more documentation in my superclass, DeviceWorkstation.
[author:]
- Claus Gittinger
+ Claus Gittinger
"
! !
!XWorkstation class methodsFor:'initialization'!
initialize
- ConservativeSync := OperatingSystem platformName == #win32.
+ ConservativeSync := OperatingSystem isMSWINDOWSlike.
"/ some XServers crash, when given too long strings in XDrawString/XDrawInageString.
"/ the following is an adjustable soft-limit.
@@ -563,18 +575,18 @@
DefaultXLibTimeoutForWindowCreation := 5*60.
RawKeySymTranslation isNil ifTrue:[
- "/ the following table maps X-keyevents to ST/X
- "/ device independend events.
- "/ It is NOT meant as a keyboardMap replacement.
-
- RawKeySymTranslation := Dictionary new:6.
- RawKeySymTranslation
- at:#'Delete_line' put:#DeleteLine;
- at:#'Delete_word' put:#DeleteWord;
- at:#Down put:#CursorDown;
- at:#Up put:#CursorUp;
- at:#Left put:#CursorLeft;
- at:#Right put:#CursorRight.
+ "/ the following table maps X-keyevents to ST/X
+ "/ device independend events.
+ "/ It is NOT meant as a keyboardMap replacement.
+
+ RawKeySymTranslation := Dictionary new:6.
+ RawKeySymTranslation
+ at:#'Delete_line' put:#DeleteLine;
+ at:#'Delete_word' put:#DeleteWord;
+ at:#Down put:#CursorDown;
+ at:#Up put:#CursorUp;
+ at:#Left put:#CursorLeft;
+ at:#Right put:#CursorRight.
]
"Modified: / 27.4.1999 / 17:21:30 / cg"
@@ -593,8 +605,8 @@
%{
#ifdef COUNT_RESOURCES
console_fprintf(stderr, "colors:%d bitmaps:%d views:%d gc:%d cursors:%d fonts:%d\n",
- __cnt_color, __cnt_bitmap,
- __cnt_view, __cnt_gc, __cnt_cursor, __cnt_font);
+ __cnt_color, __cnt_bitmap,
+ __cnt_view, __cnt_gc, __cnt_cursor, __cnt_font);
#endif
%}
@@ -637,31 +649,31 @@
"
match := 'XRequest.' , requestCode printString.
ErrorDBCache isNil ifTrue:[
- ErrorDBCache := IdentityDictionary new.
+ ErrorDBCache := IdentityDictionary new.
].
"if there is no XErrorDB or no entry, the line for the requestCode is cached as nil"
line := ErrorDBCache at:requestCode ifAbsentPut:[
- |errorLine|
-
- s := '/usr/share/X11/XErrorDB' asFilename readStreamOrNil.
- s notNil ifTrue:[
- errorLine := s peekForLineStartingWith:match.
- errorLine notNil ifTrue:[
- errorLine := errorLine copyFrom:(errorLine indexOf:$:)+1.
- ].
- s close.
- ].
- errorLine
- ].
+ |errorLine|
+
+ s := '/usr/share/X11/XErrorDB' asFilename readStreamOrNil.
+ s notNil ifTrue:[
+ errorLine := s peekForLineStartingWith:match.
+ errorLine notNil ifTrue:[
+ errorLine := errorLine copyFrom:(errorLine indexOf:$:)+1.
+ ].
+ s close.
+ ].
+ errorLine
+ ].
line isNil ifTrue:[
- line := match
+ line := match
].
^ string , ' in ' , line.
"
- Screen lastErrorString
+ Screen lastErrorString
"
!
@@ -683,7 +695,7 @@
%{ /* NOCONTEXT */
if (lastResource != 0) {
- RETURN ( __MKEXTERNALADDRESS(lastResource) );
+ RETURN ( __MKEXTERNALADDRESS(lastResource) );
}
%}.
@@ -691,7 +703,7 @@
"
- Screen resourceIdOfLastError
+ Screen resourceIdOfLastError
"
!
@@ -736,6 +748,21 @@
"Created: / 20-12-2013 / 11:02:39 / Jan Vrany <jan.vrany@fit.cvut.cz>"
!
+displayIdOrErrorIfBroken
+ (hasConnectionBroken or:[displayId isNil]) ifTrue:[
+ self primitiveFailedOrClosedConnection.
+ ^ nil.
+ ].
+ ^ displayId
+!
+
+displayIdOrNilIfBroken
+ hasConnectionBroken ifTrue:[
+ ^ nil.
+ ].
+ ^ displayId
+!
+
maxOperationsUntilFlush
^ maxOperationsUntilFlush
!
@@ -771,7 +798,7 @@
prev := activateOnClick ? false.
aBoolean notNil ifTrue:[
- activateOnClick := aBoolean.
+ activateOnClick := aBoolean.
].
^ prev
@@ -834,13 +861,13 @@
%{ /* NOCONTEXT */
if (aButton == __MKSMALLINT(1)) {
- RETURN (__MKSMALLINT(Button1MotionMask));
+ RETURN (__MKSMALLINT(Button1MotionMask));
}
if (aButton == __MKSMALLINT(2)) {
- RETURN (__MKSMALLINT(Button2MotionMask));
+ RETURN (__MKSMALLINT(Button2MotionMask));
}
if (aButton == __MKSMALLINT(3)) {
- RETURN (__MKSMALLINT(Button3MotionMask));
+ RETURN (__MKSMALLINT(Button3MotionMask));
}
%}.
^ nil
@@ -861,7 +888,7 @@
%{ /* NOCONTEXT */
#ifndef WIN32
if (ISCONNECTED) {
- RETURN ( __MKSMALLINT(ConnectionNumber(myDpy)) );
+ RETURN ( __MKSMALLINT(ConnectionNumber(myDpy)) );
}
#endif
RETURN (nil);
@@ -888,7 +915,7 @@
%{ /* NOCONTEXT */
if (ISCONNECTED) {
- RETURN ( __MKSMALLINT(XProtocolVersion(myDpy)) );
+ RETURN ( __MKSMALLINT(XProtocolVersion(myDpy)) );
}
RETURN (nil);
%}
@@ -904,7 +931,7 @@
(to avoid bugs in certain implementations)"
%{
if (ISCONNECTED) {
- RETURN ( __MKSTRING(XServerVendor(myDpy)) );
+ RETURN ( __MKSTRING(XServerVendor(myDpy)) );
}
RETURN (nil);
%}
@@ -945,28 +972,28 @@
&& __isExternalAddress(windowId1)
&& __isExternalAddress(windowId2)
&& __bothSmallInteger(x1, y1)) {
- Display *dpy = myDpy;
- Window rootWin;
-
- w1 = __WindowVal(windowId1);
- w2 = __WindowVal(windowId2);
-
- rootWin = RootWindow(dpy, screen);
- if (w1 == rootWin) {
- w1 = (Window)__externalAddressVal(rootWindowId);
- }
- if (w2 == rootWin) {
- w2 = (Window)__externalAddressVal(rootWindowId);
- }
-
- ENTER_XLIB();
- XTranslateCoordinates(dpy, w1, w2,
- __intVal(x1), __intVal(y1),
- &xpos, &ypos, &child_ret);
- LEAVE_XLIB();
-
- x2 = __MKSMALLINT(xpos);
- y2 = __MKSMALLINT(ypos);
+ Display *dpy = myDpy;
+ Window rootWin;
+
+ w1 = __WindowVal(windowId1);
+ w2 = __WindowVal(windowId2);
+
+ rootWin = RootWindow(dpy, screen);
+ if (w1 == rootWin) {
+ w1 = (Window)__externalAddressVal(rootWindowId);
+ }
+ if (w2 == rootWin) {
+ w2 = (Window)__externalAddressVal(rootWindowId);
+ }
+
+ ENTER_XLIB();
+ XTranslateCoordinates(dpy, w1, w2,
+ __intVal(x1), __intVal(y1),
+ &xpos, &ypos, &child_ret);
+ LEAVE_XLIB();
+
+ x2 = __MKSMALLINT(xpos);
+ y2 = __MKSMALLINT(ypos);
}
%}.
@@ -980,7 +1007,7 @@
%{ /* NOCONTEXT */
if (ISCONNECTED) {
- RETURN ( __MKSMALLINT(XVendorRelease(myDpy)) );
+ RETURN ( __MKSMALLINT(XVendorRelease(myDpy)) );
}
RETURN (nil);
%}
@@ -1007,31 +1034,31 @@
if (ISCONNECTED
&& __isExternalAddress(windowId)
&& __isPoint(aPoint)) {
- Display *dpy = myDpy;
-
- xp = _point_X(aPoint);
- yp = _point_Y(aPoint);
- if (__bothSmallInteger(xp, yp)) {
-
- ENTER_XLIB();
- XTranslateCoordinates(dpy,
- RootWindow(dpy, screen),
- __WindowVal(windowId),
- __intVal(xp), __intVal(yp),
- &xpos, &ypos, &child_ret);
- LEAVE_XLIB();
-
- if (child_ret) {
- RETURN ( __MKEXTERNALADDRESS(child_ret) );
- }
- RETURN ( nil );
- }
+ Display *dpy = myDpy;
+
+ xp = _point_X(aPoint);
+ yp = _point_Y(aPoint);
+ if (__bothSmallInteger(xp, yp)) {
+
+ ENTER_XLIB();
+ XTranslateCoordinates(dpy,
+ RootWindow(dpy, screen),
+ __WindowVal(windowId),
+ __intVal(xp), __intVal(yp),
+ &xpos, &ypos, &child_ret);
+ LEAVE_XLIB();
+
+ if (child_ret) {
+ RETURN ( __MKEXTERNALADDRESS(child_ret) );
+ }
+ RETURN ( nil );
+ }
}
%}.
windowId notNil ifTrue:[
- aPoint isPoint ifTrue:[
- ^ self viewIdFromPoint:aPoint asPoint truncated in:windowId
- ]
+ aPoint isPoint ifTrue:[
+ ^ self viewIdFromPoint:aPoint asPoint truncated in:windowId
+ ]
].
^ nil
@@ -1051,21 +1078,21 @@
if (ISCONNECTED
&& (__INST(rootId) != __INST(virtualRootId))
&& __isExternalAddress(__INST(virtualRootId))) {
- Window vRootWin;
- Window root;
- int x, y;
- unsigned int width, height;
- unsigned int dummy;
- int ret;
-
- vRootWin = __WindowVal(__INST(virtualRootId));
- ENTER_XLIB();
- ret = XGetGeometry(myDpy, vRootWin, &root, &x, &y, &width, &height,
- &dummy, &dummy);
- LEAVE_XLIB();
- if (ret) {
- RETURN ( __MKPOINT_INT(width, height) );
- }
+ Window vRootWin;
+ Window root;
+ int x, y;
+ unsigned int width, height;
+ unsigned int dummy;
+ int ret;
+
+ vRootWin = __WindowVal(__INST(virtualRootId));
+ ENTER_XLIB();
+ ret = XGetGeometry(myDpy, vRootWin, &root, &x, &y, &width, &height,
+ &dummy, &dummy);
+ LEAVE_XLIB();
+ if (ret) {
+ RETURN ( __MKPOINT_INT(width, height) );
+ }
}
%}.
^ width @ height
@@ -1108,9 +1135,9 @@
This method must be redefined for displays which need it (i.e. X11 on osx)"
OperatingSystem getOSType == #osx ifTrue:[
- "/ should check for local display here - sigh, osx's Xserver does not give
- "/ us a hint through the server vendor...
- ^ 16@16
+ "/ should check for local display here - sigh, osx's Xserver does not give
+ "/ us a hint through the server vendor...
+ ^ 16@16
].
^ 0@0
!
@@ -1140,11 +1167,11 @@
if (ISCONNECTED
&& __isStringLike(extensionString)) {
- ENTER_XLIB();
- if (XQueryExtension(myDpy, __stringVal(extensionString), &dummy, &dummy, &dummy)) {
- rslt = true;
- }
- LEAVE_XLIB();
+ ENTER_XLIB();
+ if (XQueryExtension(myDpy, __stringVal(extensionString), &dummy, &dummy, &dummy)) {
+ rslt = true;
+ }
+ LEAVE_XLIB();
}
RETURN (rslt);
%}
@@ -1247,44 +1274,44 @@
int cnt;
if (ISCONNECTED) {
- Display *dpy = myDpy;
- int status;
-
- ENTER_XLIB();
- status = XGetIconSizes(dpy, RootWindow(dpy, screen), &sizeList, &cnt);
- LEAVE_XLIB();
- if (status > 0) {
- xIconSizes = __MKEXTERNALBYTES(sizeList);
- count = __MKSMALLINT(cnt);
- }
+ Display *dpy = myDpy;
+ int status;
+
+ ENTER_XLIB();
+ status = XGetIconSizes(dpy, RootWindow(dpy, screen), &sizeList, &cnt);
+ LEAVE_XLIB();
+ if (status > 0) {
+ xIconSizes = __MKEXTERNALBYTES(sizeList);
+ count = __MKSMALLINT(cnt);
+ }
}
%}.
xIconSizes isNil ifTrue:[^ nil].
ret := OrderedCollection new:count.
1 to:count do:[ :i |
- |minWidth minHeight maxWidth maxHeight widthStep heightStep d|
-
-%{
- XIconSize *slp;
-
- slp = &((XIconSize *)__externalAddressVal(xIconSizes))[__intVal(i)-1];
- minWidth = __MKSMALLINT(slp->min_width);
- minHeight = __MKSMALLINT(slp->min_height);
- maxWidth = __MKSMALLINT(slp->max_width);
- maxHeight = __MKSMALLINT(slp->max_height);
- widthStep = __MKSMALLINT(slp->width_inc);
- heightStep = __MKSMALLINT(slp->height_inc);
-%}.
- d := IdentityDictionary new.
- d at:#minWidth put:minWidth.
- d at:#maxWidth put:maxWidth.
- d at:#widthStep put:widthStep.
- d at:#minHeight put:minHeight.
- d at:#maxHeight put:maxHeight.
- d at:#heightStep put:heightStep.
-
- ret add:d
+ |minWidth minHeight maxWidth maxHeight widthStep heightStep d|
+
+%{
+ XIconSize *slp;
+
+ slp = &((XIconSize *)__externalAddressVal(xIconSizes))[__intVal(i)-1];
+ minWidth = __MKSMALLINT(slp->min_width);
+ minHeight = __MKSMALLINT(slp->min_height);
+ maxWidth = __MKSMALLINT(slp->max_width);
+ maxHeight = __MKSMALLINT(slp->max_height);
+ widthStep = __MKSMALLINT(slp->width_inc);
+ heightStep = __MKSMALLINT(slp->height_inc);
+%}.
+ d := IdentityDictionary new.
+ d at:#minWidth put:minWidth.
+ d at:#maxWidth put:maxWidth.
+ d at:#widthStep put:widthStep.
+ d at:#minHeight put:minHeight.
+ d at:#maxHeight put:maxHeight.
+ d at:#heightStep put:heightStep.
+
+ ret add:d
].
xIconSizes free.
@@ -1312,52 +1339,52 @@
%{
#ifdef XINERAMA
if (ISCONNECTED && __INST(hasXineramaExtension) == true) {
- Display *dpy = myDpy;
- XineramaScreenInfo *screenInfo;
- int numDisplays;
- OBJ *cResultArray;
- int i, ci;
-
- screenInfo = XineramaQueryScreens (dpy, &numDisplays);
- if (screenInfo == 0) {
- goto out;
- }
-
- numberOfMonitors = __mkSmallInteger(numDisplays);
- resultArray = __ARRAY_NEW_INT(numDisplays * 5);
- cResultArray = __ArrayInstPtr(resultArray)->a_element;
-
- for (i=0, ci=0; i < numDisplays; i++, ci+=5) {
- cResultArray[ci] = __mkSmallInteger(screenInfo[i].screen_number);
- cResultArray[ci+1] = __mkSmallInteger(screenInfo[i].x_org);
- cResultArray[ci+2] = __mkSmallInteger(screenInfo[i].y_org);
- cResultArray[ci+3] = __mkSmallInteger(screenInfo[i].width);
- cResultArray[ci+4] = __mkSmallInteger(screenInfo[i].height);
- }
-
- XFree(screenInfo);
+ Display *dpy = myDpy;
+ XineramaScreenInfo *screenInfo;
+ int numDisplays;
+ OBJ *cResultArray;
+ int i, ci;
+
+ screenInfo = XineramaQueryScreens (dpy, &numDisplays);
+ if (screenInfo == 0) {
+ goto out;
+ }
+
+ numberOfMonitors = __mkSmallInteger(numDisplays);
+ resultArray = __ARRAY_NEW_INT(numDisplays * 5);
+ cResultArray = __ArrayInstPtr(resultArray)->a_element;
+
+ for (i=0, ci=0; i < numDisplays; i++, ci+=5) {
+ cResultArray[ci] = __mkSmallInteger(screenInfo[i].screen_number);
+ cResultArray[ci+1] = __mkSmallInteger(screenInfo[i].x_org);
+ cResultArray[ci+2] = __mkSmallInteger(screenInfo[i].y_org);
+ cResultArray[ci+3] = __mkSmallInteger(screenInfo[i].width);
+ cResultArray[ci+4] = __mkSmallInteger(screenInfo[i].height);
+ }
+
+ XFree(screenInfo);
}
#endif
out:;
%}.
numberOfMonitors isNil ifTrue:[
- "no xinerama - the display is the only monitor"
- ^ Array with:self bounds.
+ "no xinerama - the display is the only monitor"
+ ^ Array with:self bounds.
].
rawMonitorBounds = resultArray ifTrue:[
- ^ monitorBounds.
+ ^ monitorBounds.
].
bounds := Array new:numberOfMonitors.
1 to:numberOfMonitors do:[:idx|
- |rect baseIdx|
- baseIdx := (idx-1) * 5.
- rect := Rectangle
- left:(resultArray at:baseIdx+2)
- top:(resultArray at:baseIdx+3)
- width:(resultArray at:baseIdx+4)
- height:(resultArray at:baseIdx+5).
- bounds at:idx put:rect.
+ |rect baseIdx|
+ baseIdx := (idx-1) * 5.
+ rect := Rectangle
+ left:(resultArray at:baseIdx+2)
+ top:(resultArray at:baseIdx+3)
+ width:(resultArray at:baseIdx+4)
+ height:(resultArray at:baseIdx+5).
+ bounds at:idx put:rect.
].
rawMonitorBounds := resultArray.
@@ -1380,8 +1407,8 @@
bounds := self monitorBounds.
^ bounds
- detect:[:eachRectangle| eachRectangle containsPoint:aPoint]
- ifNone:[super monitorBoundsAt:aPoint].
+ detect:[:eachRectangle| eachRectangle containsPoint:aPoint]
+ ifNone:[super monitorBoundsAt:aPoint].
"
Screen current monitorBoundsAt:(0@0)
@@ -1396,7 +1423,7 @@
^ self monitorBounds size
"
- Display numberOfMonitors
+ Display numberOfMonitors
"
!
@@ -1427,7 +1454,7 @@
Redefined to return a special value on SGI servers."
self serverVendor = 'Silicon Graphics' ifTrue:[
- ^ 86@68
+ ^ 86@68
].
^ super preferredIconSize
@@ -1449,12 +1476,12 @@
minH := self usableHeight.
self monitorBounds do:[:eachBounds |
- minH := minH min: eachBounds height.
+ minH := minH min: eachBounds height.
].
^ minH
"
- Display smallestMonitorHeight
+ Display smallestMonitorHeight
"
!
@@ -1469,7 +1496,7 @@
Display *dpy;
if (! ISCONNECTED) {
- RETURN (nil);
+ RETURN (nil);
}
dpy = myDpy;
@@ -1481,30 +1508,30 @@
%}.
formatArray := Array new:nFormats.
1 to:nFormats do:[:index |
- |info bitsPerPixelInfo depthInfo paddingInfo i|
-
- i := index.
-%{
- ScreenFormat *format;
- Display *dpy = myDpy;
+ |info bitsPerPixelInfo depthInfo paddingInfo i|
+
+ i := index.
+%{
+ ScreenFormat *format;
+ Display *dpy = myDpy;
#ifdef NO_PRIVATE_DISPLAY_ACCESS
- depthInfo = __MKSMALLINT(1);
- bitsPerPixelInfo = __MKSMALLINT(1);
- paddingInfo = __MKSMALLINT(8);
+ depthInfo = __MKSMALLINT(1);
+ bitsPerPixelInfo = __MKSMALLINT(1);
+ paddingInfo = __MKSMALLINT(8);
#else
- format = DISPLAYACCESS(dpy)->pixmap_format;
- format += (__intVal(i)-1);
- bitsPerPixelInfo = __MKSMALLINT(format->bits_per_pixel);
- depthInfo = __MKSMALLINT(format->depth);
- paddingInfo = __MKSMALLINT(format->scanline_pad);
-#endif
-%}.
- info := IdentityDictionary new.
- info at:#depth put:depthInfo.
- info at:#bitsPerPixel put:bitsPerPixelInfo.
- info at:#padding put:paddingInfo.
- formatArray at:index put:info.
+ format = DISPLAYACCESS(dpy)->pixmap_format;
+ format += (__intVal(i)-1);
+ bitsPerPixelInfo = __MKSMALLINT(format->bits_per_pixel);
+ depthInfo = __MKSMALLINT(format->depth);
+ paddingInfo = __MKSMALLINT(format->scanline_pad);
+#endif
+%}.
+ info := IdentityDictionary new.
+ info at:#depth put:depthInfo.
+ info at:#bitsPerPixel put:bitsPerPixelInfo.
+ info at:#padding put:paddingInfo.
+ formatArray at:index put:info.
].
^ formatArray
@@ -1589,8 +1616,8 @@
h := (self monitorBoundsAt:aPoint) height.
OperatingSystem isOSXlike ifTrue:[
- "/ take away some space for the icon-panel at the bottom.
- ^ h - 50
+ "/ take away some space for the icon-panel at the bottom.
+ ^ h - 50
].
^ h
@@ -1613,7 +1640,7 @@
bitmapId := self primCreateBitmapFromArray:anArray width:w height:h.
bitmapId isNil ifTrue:[
- self primitiveFailedOrClosedConnection
+ self primitiveFailedOrClosedConnection
].
^ bitmapId
!
@@ -1628,35 +1655,35 @@
if (ISCONNECTED
&& __isStringLike(aString)) {
- Display *dpy = myDpy;
- char *filename;
- int status;
- Pixmap newBitmap;
- unsigned b_width, b_height;
- int b_x_hot, b_y_hot;
-
- filename = (char *) __stringVal(aString);
-
-
- ENTER_XLIB();
- status = XReadBitmapFile(dpy, RootWindow(dpy, screen),
- filename, &b_width, &b_height, &newBitmap,
- &b_x_hot, &b_y_hot);
- LEAVE_XLIB();
-
-
- if ((status == BitmapSuccess) && newBitmap) {
+ Display *dpy = myDpy;
+ char *filename;
+ int status;
+ Pixmap newBitmap;
+ unsigned b_width, b_height;
+ int b_x_hot, b_y_hot;
+
+ filename = (char *) __stringVal(aString);
+
+
+ ENTER_XLIB();
+ status = XReadBitmapFile(dpy, RootWindow(dpy, screen),
+ filename, &b_width, &b_height, &newBitmap,
+ &b_x_hot, &b_y_hot);
+ LEAVE_XLIB();
+
+
+ if ((status == BitmapSuccess) && newBitmap) {
#ifdef COUNT_RESOURCES
- __cnt_bitmap++;
-#endif
- w = __MKSMALLINT(b_width);
- h = __MKSMALLINT(b_height);
- id = __MKEXTERNALADDRESS(newBitmap);
- }
+ __cnt_bitmap++;
+#endif
+ w = __MKSMALLINT(b_width);
+ h = __MKSMALLINT(b_height);
+ id = __MKEXTERNALADDRESS(newBitmap);
+ }
}
%}.
id notNil ifTrue:[
- aForm setWidth:w height:h
+ aForm setWidth:w height:h
].
^ id
!
@@ -1672,19 +1699,19 @@
Pixmap newBitmap;
if (__bothSmallInteger(w, h) && ISCONNECTED) {
- Display *dpy = myDpy;
-
-
- ENTER_XLIB();
- newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
- __intVal(w), __intVal(h), 1);
- LEAVE_XLIB();
+ Display *dpy = myDpy;
+
+
+ ENTER_XLIB();
+ newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
+ __intVal(w), __intVal(h), 1);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- if (newBitmap)
- __cnt_bitmap++;
-#endif
-
- RETURN ( (newBitmap != (Pixmap)0) ? __MKEXTERNALADDRESS(newBitmap) : nil );
+ if (newBitmap)
+ __cnt_bitmap++;
+#endif
+
+ RETURN ( (newBitmap != (Pixmap)0) ? __MKEXTERNALADDRESS(newBitmap) : nil );
}
%}.
self primitiveFailedOrClosedConnection.
@@ -1702,19 +1729,19 @@
Pixmap newBitmap;
if (__bothSmallInteger(w, h) && ISCONNECTED) {
- Display *dpy = myDpy;
-
-
- ENTER_XLIB();
- newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
- __intVal(w), __intVal(h), __intVal(d));
- LEAVE_XLIB();
+ Display *dpy = myDpy;
+
+
+ ENTER_XLIB();
+ newBitmap = XCreatePixmap(dpy, RootWindow(dpy, screen),
+ __intVal(w), __intVal(h), __intVal(d));
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- if (newBitmap)
- __cnt_bitmap++;
-#endif
-
- RETURN ( (newBitmap != (Pixmap)0) ? __MKEXTERNALADDRESS(newBitmap) : nil );
+ if (newBitmap)
+ __cnt_bitmap++;
+#endif
+
+ RETURN ( (newBitmap != (Pixmap)0) ? __MKEXTERNALADDRESS(newBitmap) : nil );
}
%}.
self primitiveFailedOrClosedConnection.
@@ -1743,7 +1770,7 @@
vBgForm deepForm preferredVisual preferredDepth
wiconId wiconMaskId wiconViewId windowGroupWindowId|
- displayId isNil ifTrue:[
+ self isOpen ifFalse:[
self primitiveFailedOrClosedConnection.
^ nil
].
@@ -2141,25 +2168,25 @@
* ignore closed connection
*/
if (! ISCONNECTED) {
- RETURN ( self );
+ RETURN ( self );
}
if (__isExternalAddress(aGCId)) {
- GC gc = __GCVal(aGCId);
-
- if (gc) {
- __ExternalAddressInstPtr(aGCId)->e_address = NULL;
-
- ENTER_XLIB();
- XFreeGC(myDpy, gc);
- LEAVE_XLIB();
+ GC gc = __GCVal(aGCId);
+
+ if (gc) {
+ __ExternalAddressInstPtr(aGCId)->e_address = NULL;
+
+ ENTER_XLIB();
+ XFreeGC(myDpy, gc);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- __cnt_gc--;
-#endif
- } else {
- console_fprintf(stderr, "XWorkstation [warning]: trying to destroy GC twice\n");
- }
- RETURN ( self );
+ __cnt_gc--;
+#endif
+ } else {
+ console_fprintf(stderr, "XWorkstation [warning]: trying to destroy GC twice\n");
+ }
+ RETURN ( self );
}
%}.
self primitiveFailed
@@ -2173,31 +2200,31 @@
* ignore closed connection
*/
if (! ISCONNECTED) {
- RETURN ( self );
+ RETURN ( self );
}
if (__isExternalAddress(aDrawableId)) {
- Pixmap pix = __PixmapVal(aDrawableId);
-
- if (pix) {
-
- ENTER_XLIB();
- XFreePixmap(myDpy, pix);
- LEAVE_XLIB();
+ Pixmap pix = __PixmapVal(aDrawableId);
+
+ if (pix) {
+
+ ENTER_XLIB();
+ XFreePixmap(myDpy, pix);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- __cnt_bitmap--;
-#endif
-
- }
- RETURN ( self );
+ __cnt_bitmap--;
+#endif
+
+ }
+ RETURN ( self );
}
%}.
self primitiveFailed
!
-destroyView:aView withId:aWindowId
- self primDestroyView:aView withId:aWindowId.
- self removeKnownView:aView withId:aWindowId.
+destroyView:aViewOrNil withId:aWindowId
+ self primDestroyViewWithId:aWindowId.
+ self removeKnownView:aViewOrNil withId:aWindowId.
!
dpsContextFor:aDrawableId and:aGCId
@@ -2214,16 +2241,16 @@
&& __isExternalAddress(aGCId)
&& ISCONNECTED) {
- ENTER_XLIB();
- dps = XDPSCreateContext(myDpy, __DrawableVal(aDrawableId),
- __GCVal(aGCId),
- 0, height, 0, colormap, NULL, 0,
- XDPSDefaultTextBackstop,
- XDPSDefaultErrorProc,
- NULL);
- LEAVE_XLIB();
-
- RETURN ( dps ? __MKEXTERNALADDRESS(dps) : nil );
+ ENTER_XLIB();
+ dps = XDPSCreateContext(myDpy, __DrawableVal(aDrawableId),
+ __GCVal(aGCId),
+ 0, height, 0, colormap, NULL, 0,
+ XDPSDefaultTextBackstop,
+ XDPSDefaultErrorProc,
+ NULL);
+ LEAVE_XLIB();
+
+ RETURN ( dps ? __MKEXTERNALADDRESS(dps) : nil );
}
#endif
%}.
@@ -2240,16 +2267,16 @@
if (__isExternalAddress(aDrawableId) && ISCONNECTED) {
- ENTER_XLIB();
- gc = XCreateGC(myDpy, __DrawableVal(aDrawableId), 0L, (XGCValues *)0);
- LEAVE_XLIB();
+ ENTER_XLIB();
+ gc = XCreateGC(myDpy, __DrawableVal(aDrawableId), 0L, (XGCValues *)0);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- if (gc)
- __cnt_gc++;
-#endif
-
- RETURN ( gc ? __MKEXTERNALADDRESS(gc) : nil );
+ if (gc)
+ __cnt_gc++;
+#endif
+
+ RETURN ( gc ? __MKEXTERNALADDRESS(gc) : nil );
}
%}.
self primitiveFailedOrClosedConnection.
@@ -2286,86 +2313,86 @@
int bytesPerRow;
if (! ISCONNECTED) {
- RETURN (nil);
+ RETURN (nil);
}
dpy = myDpy;
if (firstCall) {
- for (index=0; index < 256; index++) {
- int t = 0;
-
- if (index & 128) t |= 1;
- if (index & 64) t |= 2;
- if (index & 32) t |= 4;
- if (index & 16) t |= 8;
- if (index & 8) t |= 16;
- if (index & 4) t |= 32;
- if (index & 2) t |= 64;
- if (index & 1) t |= 128;
-
- reverseBitTable[index] = t;
- }
- firstCall = 0;
+ for (index=0; index < 256; index++) {
+ int t = 0;
+
+ if (index & 128) t |= 1;
+ if (index & 64) t |= 2;
+ if (index & 32) t |= 4;
+ if (index & 16) t |= 8;
+ if (index & 8) t |= 16;
+ if (index & 4) t |= 32;
+ if (index & 2) t |= 64;
+ if (index & 1) t |= 128;
+
+ reverseBitTable[index] = t;
+ }
+ firstCall = 0;
}
if (__bothSmallInteger(w, h) && _isNonNilObject(anArray)) {
- newBitmap = (Pixmap)0;
- b_width = __intVal(w);
- b_height = __intVal(h);
- bytesPerRow = (b_width + 7) / 8;
- nBytes = b_height * bytesPerRow;
- if (nBytes < sizeof(fastBits)) {
- cp = b_bits = fastBits;
- allocatedBits = 0;
- } else {
- cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
- if (! cp) goto fail;
- }
-
- if (__isArrayLike(anArray)) {
- 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)) {
- bits = __intVal(num);
- } else {
- bits = __longIntVal(num);
- if (bits == 0) {
- goto fail;
- }
- }
- *cp++ = reverseBitTable[bits & 0xFF];
- }
- }
- } else {
- if (__isByteArrayLike(anArray)) {
- pBits = __ByteArrayInstPtr(anArray)->ba_element;
- for (col = b_height*bytesPerRow; col; col--) {
- *cp++ = reverseBitTable[*pBits++];
- }
- } else {
- goto fail;
- }
- }
-
-
- ENTER_XLIB();
- newBitmap = XCreateBitmapFromData(dpy, RootWindow(dpy, screen),
- (char *)b_bits,
- b_width, b_height);
- LEAVE_XLIB();
+ newBitmap = (Pixmap)0;
+ b_width = __intVal(w);
+ b_height = __intVal(h);
+ bytesPerRow = (b_width + 7) / 8;
+ nBytes = b_height * bytesPerRow;
+ if (nBytes < sizeof(fastBits)) {
+ cp = b_bits = fastBits;
+ allocatedBits = 0;
+ } else {
+ cp = b_bits = allocatedBits = (unsigned char *) malloc(nBytes);
+ if (! cp) goto fail;
+ }
+
+ if (__isArrayLike(anArray)) {
+ 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)) {
+ bits = __intVal(num);
+ } else {
+ bits = __longIntVal(num);
+ if (bits == 0) {
+ goto fail;
+ }
+ }
+ *cp++ = reverseBitTable[bits & 0xFF];
+ }
+ }
+ } else {
+ if (__isByteArrayLike(anArray)) {
+ pBits = __ByteArrayInstPtr(anArray)->ba_element;
+ for (col = b_height*bytesPerRow; col; col--) {
+ *cp++ = reverseBitTable[*pBits++];
+ }
+ } else {
+ goto fail;
+ }
+ }
+
+
+ ENTER_XLIB();
+ newBitmap = XCreateBitmapFromData(dpy, RootWindow(dpy, screen),
+ (char *)b_bits,
+ b_width, b_height);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- if (newBitmap)
- __cnt_bitmap++;
+ if (newBitmap)
+ __cnt_bitmap++;
#endif
fail: ;
- if (allocatedBits)
- free(allocatedBits);
- RETURN ( newBitmap ? __MKEXTERNALADDRESS(newBitmap) : nil );
+ if (allocatedBits)
+ free(allocatedBits);
+ RETURN ( newBitmap ? __MKEXTERNALADDRESS(newBitmap) : nil );
}
%}.
^ nil
@@ -2378,7 +2405,7 @@
!
-primDestroyView:aView withId:aWindowId
+primDestroyViewWithId:aWindowId
<context: #return>
%{
if (! ISCONNECTED) {
@@ -2436,14 +2463,14 @@
s := aString ? ''.
s isString ifFalse:[
- s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
+ s := s asStringWithCRsFrom:1 to:(s size) compressTabs:false withCR:false
].
viewID := aView id.
viewID notNil ifTrue:[ "/ if the view is not already closed
- "/ for now - should add support to pass emphasis information too
- s := s string.
- self setPrimaryText:s owner:viewID.
+ "/ for now - should add support to pass emphasis information too
+ s := s string.
+ self setPrimaryText:s owner:viewID.
]
"Created: / 27-03-2012 / 14:46:48 / Jan Vrany <jan.vrany@fit.cvut.cz>"
@@ -2464,20 +2491,20 @@
Status ok;
if (ISCONNECTED) {
- Display *dpy = myDpy;
-
-
- ENTER_XLIB();
- ok = XAllocColorCells(dpy, DefaultColormap(dpy, screen), (Bool)0,
- &dummy, 0, &color.pixel, 1);
- LEAVE_XLIB();
-
- if (ok) {
+ Display *dpy = myDpy;
+
+
+ ENTER_XLIB();
+ ok = XAllocColorCells(dpy, DefaultColormap(dpy, screen), (Bool)0,
+ &dummy, 0, &color.pixel, 1);
+ LEAVE_XLIB();
+
+ if (ok) {
#ifdef COUNT_RESOURCES
- __cnt_color++;
-#endif
- RETURN ( __MKSMALLINT(color.pixel) );
- }
+ __cnt_color++;
+#endif
+ RETURN ( __MKSMALLINT(color.pixel) );
+ }
}
%}.
^ nil
@@ -2498,35 +2525,35 @@
if (ISCONNECTED
&& __isStringLike(aString)) {
- Display *dpy = myDpy;
-
- colorname = (char *) __stringVal(aString);
-
-
- ENTER_XLIB();
- ok = XParseColor(dpy, DefaultColormap(dpy, screen), colorname, &ecolor);
- LEAVE_XLIB();
- if (ok) {
+ Display *dpy = myDpy;
+
+ colorname = (char *) __stringVal(aString);
+
+
+ ENTER_XLIB();
+ ok = XParseColor(dpy, DefaultColormap(dpy, screen), colorname, &ecolor);
+ LEAVE_XLIB();
+ if (ok) {
#ifdef QUICK_TRUE_COLORS
- if (__INST(visualType) == @symbol(TrueColor)) {
- id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
- id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
- id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
- RETURN ( __MKSMALLINT(id) );
- }
-#endif
- ENTER_XLIB();
- ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
- LEAVE_XLIB();
- }
-
- if (! ok) {
- RETURN ( nil );
- }
+ if (__INST(visualType) == @symbol(TrueColor)) {
+ id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
+ id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
+ id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
+ RETURN ( __MKSMALLINT(id) );
+ }
+#endif
+ ENTER_XLIB();
+ ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
+ LEAVE_XLIB();
+ }
+
+ if (! ok) {
+ RETURN ( nil );
+ }
#ifdef COUNT_RESOURCES
- __cnt_color++;
-#endif
- RETURN ( __MKSMALLINT(ecolor.pixel) );
+ __cnt_color++;
+#endif
+ RETURN ( __MKSMALLINT(ecolor.pixel) );
}
%}.
^ super colorNamed:aString
@@ -2546,30 +2573,30 @@
if (__bothSmallInteger(r, g)
&& __isSmallInteger(b)
&& ISCONNECTED) {
- ecolor.red = __intVal(r);
- ecolor.green= __intVal(g);
- ecolor.blue = __intVal(b);
+ ecolor.red = __intVal(r);
+ ecolor.green= __intVal(g);
+ ecolor.blue = __intVal(b);
#ifdef QUICK_TRUE_COLORS
- if (__INST(visualType) == @symbol(TrueColor)) {
- id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
- id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
- id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
- RETURN ( __MKSMALLINT(id) );
- }
-#endif
- dpy = myDpy;
-
- ENTER_XLIB();
- ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
- LEAVE_XLIB();
-
- if (! ok) {
- RETURN ( nil );
- }
+ if (__INST(visualType) == @symbol(TrueColor)) {
+ id = ((ecolor.red >> (16 - __intVal(__INST(bitsRed)))) << __intVal(__INST(redShift))) & __intVal(__INST(redMask));
+ id += ((ecolor.green >> (16 - __intVal(__INST(bitsGreen)))) << __intVal(__INST(greenShift))) & __intVal(__INST(greenMask));
+ id += ((ecolor.blue >> (16 - __intVal(__INST(bitsBlue)))) << __intVal(__INST(blueShift))) & __intVal(__INST(blueMask));
+ RETURN ( __MKSMALLINT(id) );
+ }
+#endif
+ dpy = myDpy;
+
+ ENTER_XLIB();
+ ok = XAllocColor(dpy, DefaultColormap(dpy, screen), &ecolor);
+ LEAVE_XLIB();
+
+ if (! ok) {
+ RETURN ( nil );
+ }
#ifdef COUNT_RESOURCES
- __cnt_color++;
-#endif
- RETURN ( __MKSMALLINT(ecolor.pixel) );
+ __cnt_color++;
+#endif
+ RETURN ( __MKSMALLINT(ecolor.pixel) );
}
%}.
^ super colorScaledRed:r scaledGreen:g scaledBlue:b
@@ -2600,8 +2627,8 @@
#ifdef QUICK_TRUE_COLORS
if (__INST(visualType) == @symbol(TrueColor)) {
- /* no need to do anything on TrueColor displays ... */
- RETURN (self);
+ /* no need to do anything on TrueColor displays ... */
+ RETURN (self);
}
#endif
@@ -2609,21 +2636,21 @@
* ignore closed connection
*/
if (! ISCONNECTED) {
- RETURN (self);
+ RETURN (self);
}
if (__isSmallInteger(colorIndex)) {
- dpy = myDpy;
- color = (long) __intVal(colorIndex);
-
- ENTER_XLIB();
- XFreeColors(dpy, DefaultColormap(dpy, screen), &color, 1, 0L);
- LEAVE_XLIB();
+ dpy = myDpy;
+ color = (long) __intVal(colorIndex);
+
+ ENTER_XLIB();
+ XFreeColors(dpy, DefaultColormap(dpy, screen), &color, 1, 0L);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- __cnt_color--;
-#endif
-
- RETURN ( self );
+ __cnt_color--;
+#endif
+
+ RETURN ( self );
}
%}.
self primitiveFailed
@@ -2642,29 +2669,29 @@
if (ISCONNECTED
&& __isSmallInteger(index)) {
- Display *dpy = myDpy;
-
- color.pixel = __intVal(index);
-
- ENTER_XLIB();
- XQueryColor(dpy, DefaultColormap(dpy, screen), &color);
- LEAVE_XLIB();
-
-
- /*
- * have to compensate for an error in X ?, which does not scale
- * colors correctly if lesser than 16bits are valid in a color,
- * (for example, color white on a 4bitsPerRGB server will Return
- * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
- */
- bits = __intVal(__INST(bitsPerRGB));
- scale = (1<<bits) - 1;
- shift = 16 - bits;
-
- sr = ((double)(color.red>>shift) / scale) * 0xFFFF;
- sg = ((double)(color.green>>shift) / scale) * 0xFFFF;
- sb = ((double)(color.blue>>shift) / scale) * 0xFFFF;
- RETURN ( __ARRAY_WITH3(__MKSMALLINT(sr), __MKSMALLINT(sg), __MKSMALLINT(sb)));
+ Display *dpy = myDpy;
+
+ color.pixel = __intVal(index);
+
+ ENTER_XLIB();
+ XQueryColor(dpy, DefaultColormap(dpy, screen), &color);
+ LEAVE_XLIB();
+
+
+ /*
+ * have to compensate for an error in X ?, which does not scale
+ * colors correctly if lesser than 16bits are valid in a color,
+ * (for example, color white on a 4bitsPerRGB server will Return
+ * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
+ */
+ bits = __intVal(__INST(bitsPerRGB));
+ scale = (1<<bits) - 1;
+ shift = 16 - bits;
+
+ sr = ((double)(color.red>>shift) / scale) * 0xFFFF;
+ sg = ((double)(color.green>>shift) / scale) * 0xFFFF;
+ sb = ((double)(color.blue>>shift) / scale) * 0xFFFF;
+ RETURN ( __ARRAY_WITH3(__MKSMALLINT(sr), __MKSMALLINT(sg), __MKSMALLINT(sb)));
}
%}.
^ super getScaledRGBFrom:index
@@ -2683,39 +2710,39 @@
if (ISCONNECTED
&& __isStringLike(colorName)) {
- Display *dpy = myDpy;
-
-
- if (XParseColor(dpy, DefaultColormap(dpy, screen),
- (char *) __stringVal(colorName), &color)) {
- /*
- * have to compensate for an error in X ?, which does not scale
- * colors correctly if lesser than 16bits are valid in a color,
- * (for example, color white on a 4bitsPerRGB server will Return
- * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
- */
- bits = __intVal(__INST(bitsPerRGB));
- scale = (1<<bits) - 1;
- shift = 16 - bits;
-
- /* do assignment to doubles (no cast) - avoid alignment problems in HPPA */
- dr = color.red>>shift;
- dg = color.green>>shift;
- db = color.blue>>shift;
-
- sr = (dr / scale) * 0xFFFF;
- sg = (dg / scale) * 0xFFFF;
- sb = (db / scale) * 0xFFFF;
- RETURN ( __ARRAY_WITH3(__MKSMALLINT(sr), __MKSMALLINT(sg), __MKSMALLINT(sb)));
- }
+ Display *dpy = myDpy;
+
+
+ if (XParseColor(dpy, DefaultColormap(dpy, screen),
+ (char *) __stringVal(colorName), &color)) {
+ /*
+ * have to compensate for an error in X ?, which does not scale
+ * colors correctly if lesser than 16bits are valid in a color,
+ * (for example, color white on a 4bitsPerRGB server will Return
+ * (16rF000 16rF000 16rF000) instead of (16rFFFF 16rFFFF 16rFFFF)
+ */
+ bits = __intVal(__INST(bitsPerRGB));
+ scale = (1<<bits) - 1;
+ shift = 16 - bits;
+
+ /* do assignment to doubles (no cast) - avoid alignment problems in HPPA */
+ dr = color.red>>shift;
+ dg = color.green>>shift;
+ db = color.blue>>shift;
+
+ sr = (dr / scale) * 0xFFFF;
+ sg = (dg / scale) * 0xFFFF;
+ sb = (db / scale) * 0xFFFF;
+ RETURN ( __ARRAY_WITH3(__MKSMALLINT(sr), __MKSMALLINT(sg), __MKSMALLINT(sb)));
+ }
}
%}.
^ super getScaledRGBFromName:colorName
"
- Screen current getScaledRGBFromName:'red'
- Screen current getScaledRGBFromName:'orange'
+ Screen current getScaledRGBFromName:'red'
+ Screen current getScaledRGBFromName:'orange'
"
!
@@ -2730,22 +2757,22 @@
aStream isNil ifTrue:[^ nil].
list := OrderedCollection new.
[aStream atEnd] whileFalse:[
- line := aStream nextLine.
- line notNil ifTrue:[
- "skip the r/g/b numbers"
- index := 1.
- [(line at:index) isSeparator] whileTrue:[index := index + 1].
- [(line at:index) isDigit] whileTrue:[index := index + 1].
- [(line at:index) isSeparator] whileTrue:[index := index + 1].
- [(line at:index) isDigit] whileTrue:[index := index + 1].
- [(line at:index) isSeparator] whileTrue:[index := index + 1].
- [(line at:index) isDigit] whileTrue:[index := index + 1].
- [(line at:index) isSeparator] whileTrue:[index := index + 1].
- colorName := line copyFrom:index.
- ((colorName occurrencesOf:(Character space)) == 0) ifTrue:[
- list add:colorName
- ]
- ]
+ line := aStream nextLine.
+ line notNil ifTrue:[
+ "skip the r/g/b numbers"
+ index := 1.
+ [(line at:index) isSeparator] whileTrue:[index := index + 1].
+ [(line at:index) isDigit] whileTrue:[index := index + 1].
+ [(line at:index) isSeparator] whileTrue:[index := index + 1].
+ [(line at:index) isDigit] whileTrue:[index := index + 1].
+ [(line at:index) isSeparator] whileTrue:[index := index + 1].
+ [(line at:index) isDigit] whileTrue:[index := index + 1].
+ [(line at:index) isSeparator] whileTrue:[index := index + 1].
+ colorName := line copyFrom:index.
+ ((colorName occurrencesOf:(Character space)) == 0) ifTrue:[
+ list add:colorName
+ ]
+ ]
].
aStream close.
^ list sort
@@ -2765,10 +2792,10 @@
%{ /* NOCONTEXT */
if (__isSmallInteger(aPercentage)) {
- RETURN ( __MKSMALLINT(0xFFFF * __intVal(aPercentage) / 100) );
+ RETURN ( __MKSMALLINT(0xFFFF * __intVal(aPercentage) / 100) );
}
if (__isFloat(aPercentage)) {
- RETURN ( __MKSMALLINT(0xFFFF * (int)(__floatVal(aPercentage)) / 100) );
+ RETURN ( __MKSMALLINT(0xFFFF * (int)(__floatVal(aPercentage)) / 100) );
}
%}.
^ (16rFFFF * aPercentage / 100) rounded
@@ -2788,33 +2815,33 @@
int ok = 1;
if (__isSmallInteger(sred))
- r = __intVal(sred);
+ r = __intVal(sred);
else ok = 0;
if (__isSmallInteger(sgreen))
- g = __intVal(sgreen);
+ g = __intVal(sgreen);
else ok = 0;
if (__isSmallInteger(sblue))
- b = __intVal(sblue);
+ b = __intVal(sblue);
else ok = 0;
if (ISCONNECTED
&& __isSmallInteger(index) && ok) {
- Display *dpy = myDpy;
-
- color.pixel = __intVal(index);
- color.red = r;
- color.green = g;
- color.blue = b;
- color.flags = DoRed | DoGreen | DoBlue;
-
-
- ENTER_XLIB();
- XStoreColor(dpy, DefaultColormap(dpy, screen), &color);
- LEAVE_XLIB();
-
- RETURN ( self );
+ Display *dpy = myDpy;
+
+ color.pixel = __intVal(index);
+ color.red = r;
+ color.green = g;
+ color.blue = b;
+ color.flags = DoRed | DoGreen | DoBlue;
+
+
+ ENTER_XLIB();
+ XStoreColor(dpy, DefaultColormap(dpy, screen), &color);
+ LEAVE_XLIB();
+
+ RETURN ( self );
}
%}.
self primitiveFailedOrClosedConnection
@@ -2831,30 +2858,30 @@
"/ if you add something here, also add to #shapeNumberFromCursor ...
^ #(
- #upLeftArrow "/ XC_top_left_arrow
- #upRightHand "/ XC_hand1
- #upDownArrow "/ XC_sb_v_double_arrow
- #leftRightArrow "/ XC_sb_h_double_arrow
- #upLimitArrow "/ XC_top_side
- #downLimitArrow "/ XC_bottom_side
- #leftLimitArrow "/ XC_left_side
- #rightLimitArrow "/ XC_right_side
- #text "/ XC_xterm
- #upRightArrow "/ XC_draft_large
- #leftHand "/ XC_hand2
- #questionMark "/ XC_question_arrow
- #cross "/ XC_X_cursor
- #wait "/ XC_watch
- #crossHair "/ XC_tcross
- #origin "/ XC_ul_angle
- #topLeft "/ XC_ul_angle
- #corner "/ XC_lr_angle
- #bottomRight "/ XC_lr_angle
- #topRight "/ XC_ur_angle
- #bottomLeft "/ XC_ll_angle
- #square "/ XC_dotbox
- #fourWay "/ XC_fleur
- #crossCursor "/ XC_X_cursor
+ #upLeftArrow "/ XC_top_left_arrow
+ #upRightHand "/ XC_hand1
+ #upDownArrow "/ XC_sb_v_double_arrow
+ #leftRightArrow "/ XC_sb_h_double_arrow
+ #upLimitArrow "/ XC_top_side
+ #downLimitArrow "/ XC_bottom_side
+ #leftLimitArrow "/ XC_left_side
+ #rightLimitArrow "/ XC_right_side
+ #text "/ XC_xterm
+ #upRightArrow "/ XC_draft_large
+ #leftHand "/ XC_hand2
+ #questionMark "/ XC_question_arrow
+ #cross "/ XC_X_cursor
+ #wait "/ XC_watch
+ #crossHair "/ XC_tcross
+ #origin "/ XC_ul_angle
+ #topLeft "/ XC_ul_angle
+ #corner "/ XC_lr_angle
+ #bottomRight "/ XC_lr_angle
+ #topRight "/ XC_ur_angle
+ #bottomLeft "/ XC_ll_angle
+ #square "/ XC_dotbox
+ #fourWay "/ XC_fleur
+ #crossCursor "/ XC_X_cursor
)
"Created: 8.4.1997 / 10:12:30 / cg"
@@ -2883,18 +2910,18 @@
&& __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);
-
- ENTER_XLIB();
- XRecolorCursor(myDpy, __CursorVal(aCursorId), &fgcolor, &bgcolor);
- LEAVE_XLIB();
-
- RETURN ( self );
+ fgcolor.red = __intVal(fgR);
+ fgcolor.green= __intVal(fgG);
+ fgcolor.blue = __intVal(fgB);
+ bgcolor.red = __intVal(bgR);
+ bgcolor.green= __intVal(bgG);
+ bgcolor.blue = __intVal(bgB);
+
+ ENTER_XLIB();
+ XRecolorCursor(myDpy, __CursorVal(aCursorId), &fgcolor, &bgcolor);
+ LEAVE_XLIB();
+
+ RETURN ( self );
}
%}.
self primitiveFailedOrClosedConnection
@@ -2916,10 +2943,10 @@
"create a cursor given 2 bitmaps (source, mask) and a hotspot"
^ self
- primCreateCursorSourceFormId:sourceForm id
- maskFormId:maskForm id
- hotX:hx hotY:hy
- width:w height:h
+ primCreateCursorSourceFormId:sourceForm id
+ maskFormId:maskForm id
+ hotX:hx hotY:hy
+ width:w height:h
!
destroyCursor:aCursorId
@@ -2931,22 +2958,22 @@
* ignore closed connection
*/
if (! ISCONNECTED) {
- RETURN ( self );
+ RETURN ( self );
}
if (__isExternalAddress(aCursorId)) {
- Cursor curs = __CursorVal(aCursorId);
-
- if (curs) {
-
- ENTER_XLIB();
- XFreeCursor(myDpy, curs);
- LEAVE_XLIB();
+ Cursor curs = __CursorVal(aCursorId);
+
+ if (curs) {
+
+ ENTER_XLIB();
+ XFreeCursor(myDpy, curs);
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- __cnt_cursor--;
-#endif
- }
- RETURN ( self );
+ __cnt_cursor--;
+#endif
+ }
+ RETURN ( self );
}
%}.
self primitiveFailed
@@ -2966,17 +2993,17 @@
if (ISCONNECTED
&& __isSmallInteger(aShapeNumber)) {
- ENTER_XLIB();
- newCursor = XCreateFontCursor(myDpy, __intVal(aShapeNumber));
- LEAVE_XLIB();
+ ENTER_XLIB();
+ newCursor = XCreateFontCursor(myDpy, __intVal(aShapeNumber));
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- if (newCursor)
- __cnt_cursor++;
-#endif
-
- if (newCursor != (Cursor)0) {
- RETURN (__MKEXTERNALADDRESS(newCursor));
- }
+ if (newCursor)
+ __cnt_cursor++;
+#endif
+
+ if (newCursor != (Cursor)0) {
+ RETURN (__MKEXTERNALADDRESS(newCursor));
+ }
}
%}.
self primitiveFailedOrClosedConnection.
@@ -2995,28 +3022,28 @@
&& __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;
-
-
- ENTER_XLIB();
- newCursor = XCreatePixmapCursor(myDpy,
- __PixmapVal(sourceId),
- __PixmapVal(maskId),
- &fgColor, &bgColor, __intVal(hx), __intVal(hy));
- LEAVE_XLIB();
+ fgColor.red = 0; /* fg is black */
+ fgColor.green = 0;
+ fgColor.blue = 0;
+ bgColor.red = 0xFFFF; /* bg is white */
+ bgColor.green = 0xFFFF;
+ bgColor.blue = 0xFFFF;
+
+
+ ENTER_XLIB();
+ newCursor = XCreatePixmapCursor(myDpy,
+ __PixmapVal(sourceId),
+ __PixmapVal(maskId),
+ &fgColor, &bgColor, __intVal(hx), __intVal(hy));
+ LEAVE_XLIB();
#ifdef COUNT_RESOURCES
- if (newCursor)
- __cnt_cursor++;
-#endif
-
- if (newCursor != (Cursor)0) {
- RETURN (__MKEXTERNALADDRESS(newCursor));
- }
+ if (newCursor)
+ __cnt_cursor++;
+#endif
+
+ if (newCursor != (Cursor)0) {
+ RETURN (__MKEXTERNALADDRESS(newCursor));
+ }
}
%}.
self primitiveFailedOrClosedConnection.
@@ -3071,128 +3098,128 @@
(msgType := self atomIDOf:#DndProtocol) notNil ifTrue:[
- "/ DND can drop files, file, dir, links, dirLink and text
- "/ check for this.
-
- dropObjects isCollection ifFalse:[
- dropColl := Array with:dropObjects
- ] ifTrue:[
- dropColl := dropObjects
- ].
- anyFile := anyDir := anyText := anyOther := false.
- dropColl do:[:aDropObject |
- aDropObject isFileObject ifTrue:[
- aDropObject theObject isDirectory ifTrue:[
- anyDir := true
- ] ifFalse:[
- anyFile := true
- ]
- ] ifFalse:[
- aDropObject isTextObject ifTrue:[
- anyText := true
- ] ifFalse:[
- anyOther := true
- ]
- ]
- ].
-
- anyOther ifTrue:[
- "/ DND does not support this ...
- 'XWorkstation [info]: DND can only drop files or text' infoPrintCR.
- ^ false
- ].
- anyText ifTrue:[
- (anyFile or:[anyDir]) ifTrue:[
- "/ DND does not support mixed types
- 'XWorkstation [info]: DND cannot drop both files and text' infoPrintCR.
- ^ false
- ]
- ].
-
- dropCollSize := dropColl size.
- anyFile ifTrue:[
- dropType := #DndFiles.
- dropCollSize == 1 ifTrue:[
- dropType := #DndFile
- ]
- ] ifFalse:[
- anyDir ifTrue:[
- dropType := #DndFiles.
- dropCollSize == 1 ifTrue:[
- dropType := #DndDir
- ]
- ] ifFalse:[
- anyText ifTrue:[
- dropCollSize == 1 ifTrue:[
- dropType := #DndText
- ] ifFalse:[
- "/ can only drop a single text object
- 'XWorkstation [info]: DND can only drop a single text' infoPrintCR.
- ^ false
- ]
- ] ifFalse:[
- "/ mhmh ...
- 'XWorkstation [info]: DND cannot drop this' infoPrintCR.
- ^ false
- ]
- ]
- ].
-
- dropTypeCode := self dndDropTypes indexOf:dropType.
- dropTypeCode == 0 ifTrue:[
- 'XWorkstation [info]: DND cannot drop this' infoPrintCR.
- ^ false
- ].
- dropTypeCode := dropTypeCode - 1.
-
-
- "/ place the selection inTo the DndSelection property
- "/ of the rootView ...
- "/ ... need a single string, with 0-terminated parts.
-
- strings := OrderedCollection new.
- sz := 0.
- dropColl do:[:anObject |
- |s o|
-
- o := anObject theObject.
- anObject isFileObject ifTrue:[
- o := o pathName
- ].
- s := o asString.
- strings add:s.
- sz := sz + (s size) + 1.
- ].
- val := String new:sz.
- idx := 1.
- strings do:[:aString |
- |sz|
-
- sz := aString size.
- val replaceFrom:idx to:(idx + sz - 1) with:aString startingAt:1.
- idx := idx + sz.
- val at:idx put:(Character value:0).
- idx := idx + 1
- ].
-
- self
- setProperty:(self atomIDOf:#DndSelection)
- type:(self atomIDOf:#STRING)
- value:val
- for:rootId.
-
- ^ self
- sendClientEvent:msgType
- format:32
- to:destinationId
- propagate:true
- eventMask:nil
- window:destinationId
- data1:dropTypeCode
- data2:0
- data3:destinationId
- data4:nil
- data5:nil.
+ "/ DND can drop files, file, dir, links, dirLink and text
+ "/ check for this.
+
+ dropObjects isCollection ifFalse:[
+ dropColl := Array with:dropObjects
+ ] ifTrue:[
+ dropColl := dropObjects
+ ].
+ anyFile := anyDir := anyText := anyOther := false.
+ dropColl do:[:aDropObject |
+ aDropObject isFileObject ifTrue:[
+ aDropObject theObject isDirectory ifTrue:[
+ anyDir := true
+ ] ifFalse:[
+ anyFile := true
+ ]
+ ] ifFalse:[
+ aDropObject isTextObject ifTrue:[
+ anyText := true
+ ] ifFalse:[
+ anyOther := true
+ ]
+ ]
+ ].
+
+ anyOther ifTrue:[
+ "/ DND does not support this ...
+ 'XWorkstation [info]: DND can only drop files or text' infoPrintCR.
+ ^ false
+ ].
+ anyText ifTrue:[
+ (anyFile or:[anyDir]) ifTrue:[
+ "/ DND does not support mixed types
+ 'XWorkstation [info]: DND cannot drop both files and text' infoPrintCR.
+ ^ false
+ ]
+ ].
+
+ dropCollSize := dropColl size.
+ anyFile ifTrue:[
+ dropType := #DndFiles.
+ dropCollSize == 1 ifTrue:[
+ dropType := #DndFile
+ ]
+ ] ifFalse:[
+ anyDir ifTrue:[
+ dropType := #DndFiles.
+ dropCollSize == 1 ifTrue:[
+ dropType := #DndDir
+ ]
+ ] ifFalse:[
+ anyText ifTrue:[
+ dropCollSize == 1 ifTrue:[
+ dropType := #DndText
+ ] ifFalse:[
+ "/ can only drop a single text object
+ 'XWorkstation [info]: DND can only drop a single text' infoPrintCR.
+ ^ false
+ ]
+ ] ifFalse:[
+ "/ mhmh ...
+ 'XWorkstation [info]: DND cannot drop this' infoPrintCR.
+ ^ false
+ ]
+ ]
+ ].
+
+ dropTypeCode := self dndDropTypes indexOf:dropType.
+ dropTypeCode == 0 ifTrue:[
+ 'XWorkstation [info]: DND cannot drop this' infoPrintCR.
+ ^ false
+ ].
+ dropTypeCode := dropTypeCode - 1.
+
+
+ "/ place the selection inTo the DndSelection property
+ "/ of the rootView ...
+ "/ ... need a single string, with 0-terminated parts.
+
+ strings := OrderedCollection new.
+ sz := 0.
+ dropColl do:[:anObject |
+ |s o|
+
+ o := anObject theObject.
+ anObject isFileObject ifTrue:[
+ o := o pathName
+ ].
+ s := o asString.
+ strings add:s.
+ sz := sz + (s size) + 1.
+ ].
+ val := String new:sz.
+ idx := 1.
+ strings do:[:aString |
+ |sz|
+
+ sz := aString size.
+ val replaceFrom:idx to:(idx + sz - 1) with:aString startingAt:1.
+ idx := idx + sz.
+ val at:idx put:(Character value:0).
+ idx := idx + 1
+ ].
+
+ self
+ setProperty:(self atomIDOf:#DndSelection)
+ type:(self atomIDOf:#STRING)
+ value:val
+ for:rootId.
+
+ ^ self
+ sendClientEvent:msgType
+ format:32
+ to:destinationId
+ propagate:true
+ eventMask:nil
+ window:destinationId
+ data1:dropTypeCode
+ data2:0
+ data3:destinationId
+ data4:nil
+ data5:nil.
].
^ false
@@ -3205,14 +3232,14 @@
"return the dropTypes as supported by DND"
^ #(
- DndUnknown "/ 0
- DndRawData "/ 1
- DndFile "/ 2
- DndFiles "/ 3
- DndText "/ 4
- DndDir "/ 5
- DndLink "/ 6
- DndExe "/ 7
+ DndUnknown "/ 0
+ DndRawData "/ 1
+ DndFile "/ 2
+ DndFiles "/ 3
+ DndText "/ 4
+ DndDir "/ 5
+ DndLink "/ 6
+ DndExe "/ 7
)
"Created: 6.4.1997 / 12:57:56 / cg"
@@ -3227,11 +3254,11 @@
"/ see, if the display supports the DND protocol ...
"/
(self atomIDOf:#DndProtocol) notNil ifTrue:[
- ^ self
- dndDrop:aCollectionOfDropObjects
- inWindowID:destinationId
- position:destinationPoint
- rootPosition:rootPoint
+ ^ self
+ dndDrop:aCollectionOfDropObjects
+ inWindowID:destinationId
+ position:destinationPoint
+ rootPosition:rootPoint
].
"/ add more drag&drop protocols here.
@@ -3252,11 +3279,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3270,22 +3297,22 @@
&& __bothSmallInteger(w, h)
&& __bothSmallInteger(srcX, srcY)
&& __bothSmallInteger(dstX, dstY)) {
- int _sX, _sY, _w, _h, _dX, _dY;
-
- _sX = __intVal(srcX);
- _sY = __intVal(srcY);
- _w = __intVal(w);
- _h = __intVal(h);
- _dX = __intVal(dstX);
- _dY = __intVal(dstY);
-
- gc = __GCVal(dstGCId);
- source = __DrawableVal(sourceId);
- dest = __DrawableVal(destId);
- ENTER_XLIB();
- XCopyArea(myDpy, source, dest, gc, _sX, _sY, _w, _h, _dX, _dY);
- LEAVE_XLIB();
- RETURN ( self );
+ int _sX, _sY, _w, _h, _dX, _dY;
+
+ _sX = __intVal(srcX);
+ _sY = __intVal(srcY);
+ _w = __intVal(w);
+ _h = __intVal(h);
+ _dX = __intVal(dstX);
+ _dY = __intVal(dstY);
+
+ gc = __GCVal(dstGCId);
+ source = __DrawableVal(sourceId);
+ dest = __DrawableVal(destId);
+ ENTER_XLIB();
+ XCopyArea(myDpy, source, dest, gc, _sX, _sY, _w, _h, _dX, _dY);
+ LEAVE_XLIB();
+ RETURN ( self );
}
%}.
"badGC, bad sourceDrawableId or destDrawableID
@@ -3304,11 +3331,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3322,20 +3349,20 @@
&& __bothSmallInteger(w, h)
&& __bothSmallInteger(srcX, srcY)
&& __bothSmallInteger(dstX, dstY)) {
- Display *dpy = myDpy;
-
- gc = __GCVal(dstGCId);
- source = __DrawableVal(sourceId);
- dest = __DrawableVal(destId);
- ENTER_XLIB();
- XSetGraphicsExposures(dpy, gc, 0);
- XCopyArea(dpy, source, dest, gc,
- __intVal(srcX), __intVal(srcY),
- __intVal(w), __intVal(h),
- __intVal(dstX), __intVal(dstY));
- XSetGraphicsExposures(dpy, gc, 1);
- LEAVE_XLIB();
- RETURN ( self );
+ Display *dpy = myDpy;
+
+ gc = __GCVal(dstGCId);
+ source = __DrawableVal(sourceId);
+ dest = __DrawableVal(destId);
+ ENTER_XLIB();
+ XSetGraphicsExposures(dpy, gc, 0);
+ XCopyArea(dpy, source, dest, gc,
+ __intVal(srcX), __intVal(srcY),
+ __intVal(w), __intVal(h),
+ __intVal(dstX), __intVal(dstY));
+ XSetGraphicsExposures(dpy, gc, 1);
+ LEAVE_XLIB();
+ RETURN ( self );
}
%}.
"badGC, bad sourceDrawableId or destDrawableID
@@ -3354,11 +3381,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3372,16 +3399,16 @@
&& __bothSmallInteger(w, h)
&& __bothSmallInteger(srcX, srcY)
&& __bothSmallInteger(dstX, dstY)) {
- gc = __GCVal(dstGCId);
- source = __DrawableVal(sourceId);
- dest = __DrawableVal(destId);
- ENTER_XLIB();
- XCopyPlane(myDpy, source, dest, gc,
- __intVal(srcX), __intVal(srcY),
- __intVal(w), __intVal(h),
- __intVal(dstX), __intVal(dstY), 1);
- LEAVE_XLIB();
- RETURN ( self );
+ gc = __GCVal(dstGCId);
+ source = __DrawableVal(sourceId);
+ dest = __DrawableVal(destId);
+ ENTER_XLIB();
+ XCopyPlane(myDpy, source, dest, gc,
+ __intVal(srcX), __intVal(srcY),
+ __intVal(w), __intVal(h),
+ __intVal(dstX), __intVal(dstY), 1);
+ LEAVE_XLIB();
+ RETURN ( self );
}
%}.
"badGC, bad sourceDrawableId or destDrawableID
@@ -3401,11 +3428,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3419,20 +3446,20 @@
&& __bothSmallInteger(w, h)
&& __bothSmallInteger(srcX, srcY)
&& __bothSmallInteger(dstX, dstY)) {
- Display *dpy = myDpy;
-
- gc = __GCVal(dstGCId);
- source = __DrawableVal(sourceId);
- dest = __DrawableVal(destId);
- ENTER_XLIB();
- XSetGraphicsExposures(dpy, gc, 0);
- XCopyPlane(dpy, source, dest, gc,
- __intVal(srcX), __intVal(srcY),
- __intVal(w), __intVal(h),
- __intVal(dstX), __intVal(dstY), 1);
- XSetGraphicsExposures(dpy, gc, 1);
- LEAVE_XLIB();
- RETURN ( self );
+ Display *dpy = myDpy;
+
+ gc = __GCVal(dstGCId);
+ source = __DrawableVal(sourceId);
+ dest = __DrawableVal(destId);
+ ENTER_XLIB();
+ XSetGraphicsExposures(dpy, gc, 0);
+ XCopyPlane(dpy, source, dest, gc,
+ __intVal(srcX), __intVal(srcY),
+ __intVal(w), __intVal(h),
+ __intVal(dstX), __intVal(dstY), 1);
+ XSetGraphicsExposures(dpy, gc, 1);
+ LEAVE_XLIB();
+ RETURN ( self );
}
%}.
"badGC, bad sourceDrawableId or destDrawableID
@@ -3448,11 +3475,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3462,23 +3489,23 @@
double f;
if (__isSmallInteger(startAngle))
- angle1 = __intVal(startAngle) * 64;
+ angle1 = __intVal(startAngle) * 64;
else if (__isFloat(startAngle)) {
- f = __floatVal(startAngle);
- angle1 = f * 64;
+ f = __floatVal(startAngle);
+ angle1 = f * 64;
} else if (__isShortFloat(startAngle)) {
- f = __shortFloatVal(startAngle);
- angle1 = f * 64;
+ f = __shortFloatVal(startAngle);
+ angle1 = f * 64;
} else goto bad;
if (__isSmallInteger(angle))
- angle2 = __intVal(angle) * 64;
+ angle2 = __intVal(angle) * 64;
else if (__isFloat(angle)) {
- f = __floatVal(angle);
- angle2 = f * 64;
+ f = __floatVal(angle);
+ angle2 = f * 64;
} else if (__isShortFloat(angle)) {
- f = __shortFloatVal(angle);
- angle2 = f * 64;
+ f = __shortFloatVal(angle);
+ angle2 = f * 64;
} else goto bad;
if (ISCONNECTED
@@ -3486,20 +3513,20 @@
&& __isExternalAddress(aDrawableId)
&& __bothSmallInteger(x, y)
&& __bothSmallInteger(width, height)) {
- win = __WindowVal(aDrawableId);
- gc = __GCVal(aGCId);
- w = __intVal(width);
- h = __intVal(height);
- /*
- * need this check here: some servers simply dump core with bad args
- */
- if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
- ENTER_XLIB();
- XDrawArc(myDpy, win, gc, __intVal(x), __intVal(y),
- w, h, angle1, angle2);
- LEAVE_XLIB();
- }
- RETURN ( self );
+ win = __WindowVal(aDrawableId);
+ gc = __GCVal(aGCId);
+ w = __intVal(width);
+ h = __intVal(height);
+ /*
+ * need this check here: some servers simply dump core with bad args
+ */
+ if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
+ ENTER_XLIB();
+ XDrawArc(myDpy, win, gc, __intVal(x), __intVal(y),
+ w, h, angle1, angle2);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
}
bad: ;
%}.
@@ -3515,11 +3542,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3531,35 +3558,35 @@
&& __isExternalAddress(aDrawableId)
&& __bothSmallInteger(x0, y0)
&& __bothSmallInteger(x1, y1)) {
- Display *dpy = myDpy;
- int ix0, iy0, ix1, iy1;
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
-
- ix0 = __intVal(x0);
- iy0 = __intVal(y0);
- ix1 = __intVal(x1);
- iy1 = __intVal(y1);
-
- /* attention: coordinates in X are shorts and wrap; clamp here. */
- if (ix0 > 0x7FFF) ix0 = 0x7FFF;
- else if (ix0 < -0x8000) ix0 = -0x8000;
- if (iy0 > 0x7FFF) iy0 = 0x7FFF;
- else if (iy0 < -0x8000) iy0 = -0x8000;
- if (ix1 > 0x7FFF) ix1 = 0x7FFF;
- else if (ix1 < -0x8000) ix1 = -0x8000;
- if (iy1 > 0x7FFF) iy1 = 0x7FFF;
- else if (iy1 < -0x8000) iy1 = -0x8000;
-
- ENTER_XLIB();
- if ((ix0 == ix1) && (iy0 == iy1)) {
- /* little bit shorter X-lib message (better with slow connections...) */
- XDrawPoint(dpy, win, gc, ix0, iy0);
- } else {
- XDrawLine(dpy, win, gc, ix0, iy0, ix1, iy1);
- }
- LEAVE_XLIB();
- RETURN ( self );
+ Display *dpy = myDpy;
+ int ix0, iy0, ix1, iy1;
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+
+ ix0 = __intVal(x0);
+ iy0 = __intVal(y0);
+ ix1 = __intVal(x1);
+ iy1 = __intVal(y1);
+
+ /* attention: coordinates in X are shorts and wrap; clamp here. */
+ if (ix0 > 0x7FFF) ix0 = 0x7FFF;
+ else if (ix0 < -0x8000) ix0 = -0x8000;
+ if (iy0 > 0x7FFF) iy0 = 0x7FFF;
+ else if (iy0 < -0x8000) iy0 = -0x8000;
+ if (ix1 > 0x7FFF) ix1 = 0x7FFF;
+ else if (ix1 < -0x8000) ix1 = -0x8000;
+ if (iy1 > 0x7FFF) iy1 = 0x7FFF;
+ else if (iy1 < -0x8000) iy1 = -0x8000;
+
+ ENTER_XLIB();
+ if ((ix0 == ix1) && (iy0 == iy1)) {
+ /* little bit shorter X-lib message (better with slow connections...) */
+ XDrawPoint(dpy, win, gc, ix0, iy0);
+ } else {
+ XDrawLine(dpy, win, gc, ix0, iy0, ix1, iy1);
+ }
+ LEAVE_XLIB();
+ RETURN ( self );
}
%}.
"badGC, badDrawable or coordinates not integer"
@@ -3576,15 +3603,15 @@
|noY|
(noY := yValues size) < 2 ifTrue:[
- ^ self
+ ^ self
].
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
OBJ yA, t;
@@ -3600,109 +3627,109 @@
if (ISCONNECTED
&& __isExternalAddress(aGCId)
&& __isExternalAddress(aDrawableId) ) {
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
-
- if( __isSmallInteger(scaleY) )
- sY = (float) __intVal( scaleY );
- else if (__isFloat(scaleY))
- sY = __floatVal( scaleY );
- else if (__isShortFloat(scaleY))
- sY = __shortFloatVal( scaleY );
- else {
- t = __SSEND0(scaleY, @symbol(asFloat), 0);
- if (! __isFloat(t)) goto fail;
- sY = __floatVal( t );
- }
-
- if( __isSmallInteger(transY) )
- tY = (float) __intVal( transY );
- else if (__isFloat(transY))
- tY = __floatVal( transY );
- else if (__isShortFloat(transY))
- tY = __shortFloatVal( transY );
- else {
- t = __SSEND0(transY, @symbol(asFloat), 0);
- if (! __isFloat(t)) goto fail;
- tY = __floatVal( t );
- }
-
- if( __isSmallInteger(startX) )
- x = (float) __intVal( startX );
- else if (__isFloat(startX))
- x = __floatVal( startX );
- else if (__isShortFloat(startX))
- x = __shortFloatVal( startX );
- else {
- t = __SSEND0(startX, @symbol(asFloat), 0);
- if (! __isFloat(t)) goto fail;
- x = __floatVal( t );
- }
-
- if( __isSmallInteger(stepX) )
- step = (float) __intVal( stepX );
- else if (__isFloat(stepX))
- step = __floatVal( stepX );
- else if (__isShortFloat(stepX))
- step = __shortFloatVal( stepX );
- else {
- t = __SSEND0(stepX, @symbol(asFloat), 0);
- if (! __isFloat(t)) goto fail;
- step = __floatVal( t );
- }
-
- num = __intVal( noY );
- if( num > 200 ) {
- if( ! (points = (XPoint *) malloc ( sizeof(XPoint) * num )) )
- goto fail;
- mustFree = 1;
- } else {
- points = qPoints;
- }
- for( i = 0; i < num; ++i ) {
- int px, py;
-
- yA = __AT_(yValues, __MKSMALLINT(i+1) );
-
- if( __isFloat(yA) )
- y = __floatVal( yA );
- else if( __isSmallInteger(yA) )
- y = (float) __intVal( yA );
- else if( __isShortFloat( yA) )
- y = __shortFloatVal( yA );
- else {
- t = __SSEND0(yA, @symbol(asFloat), 0);
- if (! __isFloat(t)) goto fail;
- y = __floatVal( t );
- }
-
- px = (int) (x + 0.5);
- py = (int) ((y * sY) + tY + 0.5);
-
- /* attention: coordinates in X are shorts and wrap; clamp here. */
- if (px > 0x7FFF) px = 0x7FFF;
- else if (px < -0x8000) px = -0x8000;
- if (py > 0x7FFF) py = 0x7FFF;
- else if (py < -0x8000) py = -0x8000;
-
- points[i].x = px;
- points[i].y = py;
- x = x + step;
- }
-
- ENTER_XLIB();
- XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
- LEAVE_XLIB();
-
- if( mustFree ) {
- free( points );
- }
- RETURN ( self );
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+
+ if( __isSmallInteger(scaleY) )
+ sY = (float) __intVal( scaleY );
+ else if (__isFloat(scaleY))
+ sY = __floatVal( scaleY );
+ else if (__isShortFloat(scaleY))
+ sY = __shortFloatVal( scaleY );
+ else {
+ t = __SSEND0(scaleY, @symbol(asFloat), 0);
+ if (! __isFloat(t)) goto fail;
+ sY = __floatVal( t );
+ }
+
+ if( __isSmallInteger(transY) )
+ tY = (float) __intVal( transY );
+ else if (__isFloat(transY))
+ tY = __floatVal( transY );
+ else if (__isShortFloat(transY))
+ tY = __shortFloatVal( transY );
+ else {
+ t = __SSEND0(transY, @symbol(asFloat), 0);
+ if (! __isFloat(t)) goto fail;
+ tY = __floatVal( t );
+ }
+
+ if( __isSmallInteger(startX) )
+ x = (float) __intVal( startX );
+ else if (__isFloat(startX))
+ x = __floatVal( startX );
+ else if (__isShortFloat(startX))
+ x = __shortFloatVal( startX );
+ else {
+ t = __SSEND0(startX, @symbol(asFloat), 0);
+ if (! __isFloat(t)) goto fail;
+ x = __floatVal( t );
+ }
+
+ if( __isSmallInteger(stepX) )
+ step = (float) __intVal( stepX );
+ else if (__isFloat(stepX))
+ step = __floatVal( stepX );
+ else if (__isShortFloat(stepX))
+ step = __shortFloatVal( stepX );
+ else {
+ t = __SSEND0(stepX, @symbol(asFloat), 0);
+ if (! __isFloat(t)) goto fail;
+ step = __floatVal( t );
+ }
+
+ num = __intVal( noY );
+ if( num > 200 ) {
+ if( ! (points = (XPoint *) malloc ( sizeof(XPoint) * num )) )
+ goto fail;
+ mustFree = 1;
+ } else {
+ points = qPoints;
+ }
+ for( i = 0; i < num; ++i ) {
+ int px, py;
+
+ yA = __AT_(yValues, __MKSMALLINT(i+1) );
+
+ if( __isFloat(yA) )
+ y = __floatVal( yA );
+ else if( __isSmallInteger(yA) )
+ y = (float) __intVal( yA );
+ else if( __isShortFloat( yA) )
+ y = __shortFloatVal( yA );
+ else {
+ t = __SSEND0(yA, @symbol(asFloat), 0);
+ if (! __isFloat(t)) goto fail;
+ y = __floatVal( t );
+ }
+
+ px = (int) (x + 0.5);
+ py = (int) ((y * sY) + tY + 0.5);
+
+ /* attention: coordinates in X are shorts and wrap; clamp here. */
+ if (px > 0x7FFF) px = 0x7FFF;
+ else if (px < -0x8000) px = -0x8000;
+ if (py > 0x7FFF) py = 0x7FFF;
+ else if (py < -0x8000) py = -0x8000;
+
+ points[i].x = px;
+ points[i].y = py;
+ x = x + step;
+ }
+
+ ENTER_XLIB();
+ XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
+ LEAVE_XLIB();
+
+ if( mustFree ) {
+ free( points );
+ }
+ RETURN ( self );
}
fail:
if( mustFree )
- free( points );
+ free( points );
%}.
^ super displayLinesFromX:startX step:stepX yValues:yValues scaleY:scaleY transY:transY in:aDrawableId with:aGCId
@@ -3715,11 +3742,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3730,20 +3757,20 @@
&& __isExternalAddress(aGCId)
&& __isExternalAddress(aDrawableId)
&& __bothSmallInteger(x, y)) {
- int px, py;
-
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- px = __intVal(x);
- py = __intVal(y);
- if (px > 0x7FFF) px = 0x7FFF;
- else if (px < -0x8000) px = -0x8000;
- if (py > 0x7FFF) py = 0x7FFF;
- else if (py < -0x8000) py = -0x8000;
- ENTER_XLIB();
- XDrawPoint(myDpy, win, gc, px, py);
- LEAVE_XLIB();
- RETURN ( self );
+ int px, py;
+
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ px = __intVal(x);
+ py = __intVal(y);
+ if (px > 0x7FFF) px = 0x7FFF;
+ else if (px < -0x8000) px = -0x8000;
+ if (py > 0x7FFF) py = 0x7FFF;
+ else if (py < -0x8000) py = -0x8000;
+ ENTER_XLIB();
+ XDrawPoint(myDpy, win, gc, px, py);
+ LEAVE_XLIB();
+ RETURN ( self );
}
%}.
"badGC, badDrawable or x/y not integer"
@@ -3760,11 +3787,11 @@
|numberOfPoints newPoints|
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
numberOfPoints := aPolygon size.
%{
@@ -3780,53 +3807,53 @@
&& __isExternalAddress(aGCId)
&& __isExternalAddress(aDrawableId)
&& __isSmallInteger(numberOfPoints)) {
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- num = __intVal(numberOfPoints);
- /*
- * avoid a (slow) malloc, if the number of points is small
- */
- if (num > 100) {
- points = (XPoint *)malloc(sizeof(XPoint) * num);
- if (! points) goto fail;
- mustFree = 1;
- } else
- points = qPoints;
-
- for (i=0; i<num; i++) {
- int px, py;
-
- point = __AT_(aPolygon, __MKSMALLINT(i+1));
- if (! __isPoint(point)) goto fail;
- x = _point_X(point);
- y = _point_Y(point);
- if (! __bothSmallInteger(x, y))
- goto fail;
-
- px = __intVal(x);
- py = __intVal(y);
-
- /* attention: coordinates in X are shorts and wrap; clamp here. */
- if (px > 0x7FFF) px = 0x7FFF;
- else if (px < -0x8000) px = -0x8000;
- if (py > 0x7FFF) py = 0x7FFF;
- else if (py < -0x8000) py = -0x8000;
-
- points[i].x = px;
- points[i].y = py;
- }
-
- ENTER_XLIB();
- XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
- LEAVE_XLIB();
-
- if (mustFree)
- free(points);
- RETURN ( self );
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ num = __intVal(numberOfPoints);
+ /*
+ * avoid a (slow) malloc, if the number of points is small
+ */
+ if (num > 100) {
+ points = (XPoint *)malloc(sizeof(XPoint) * num);
+ if (! points) goto fail;
+ mustFree = 1;
+ } else
+ points = qPoints;
+
+ for (i=0; i<num; i++) {
+ int px, py;
+
+ point = __AT_(aPolygon, __MKSMALLINT(i+1));
+ if (! __isPoint(point)) goto fail;
+ x = _point_X(point);
+ y = _point_Y(point);
+ if (! __bothSmallInteger(x, y))
+ goto fail;
+
+ px = __intVal(x);
+ py = __intVal(y);
+
+ /* attention: coordinates in X are shorts and wrap; clamp here. */
+ if (px > 0x7FFF) px = 0x7FFF;
+ else if (px < -0x8000) px = -0x8000;
+ if (py > 0x7FFF) py = 0x7FFF;
+ else if (py < -0x8000) py = -0x8000;
+
+ points[i].x = px;
+ points[i].y = py;
+ }
+
+ ENTER_XLIB();
+ XDrawLines(myDpy, win, gc, points, num, CoordModeOrigin);
+ LEAVE_XLIB();
+
+ if (mustFree)
+ free(points);
+ RETURN ( self );
}
fail: ;
if (mustFree)
- free(points);
+ free(points);
%}.
"badGC, badDrawable or coordinates not integer"
self primitiveFailedOrClosedConnection
@@ -3838,11 +3865,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3855,31 +3882,31 @@
&& __isExternalAddress(aDrawableId)
&& __bothSmallInteger(x, y)
&& __bothSmallInteger(width, height)) {
- int px, py;
-
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- w = __intVal(width);
- h = __intVal(height);
-
- /*
- * need this check here: some servers simply dump core with bad args
- */
- if ((w >= 0) && (h >= 0)) {
- px = __intVal(x);
- py = __intVal(y);
-
- /* attention: coordinates in X are shorts and wrap; clamp here. */
- if (px > 0x7FFF) px = 0x7FFF;
- else if (px < -0x8000) px = -0x8000;
- if (py > 0x7FFF) py = 0x7FFF;
- else if (py < -0x8000) py = -0x8000;
-
- ENTER_XLIB();
- XDrawRectangle(myDpy, win, gc, px, py, w, h);
- LEAVE_XLIB();
- }
- RETURN ( self );
+ int px, py;
+
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ w = __intVal(width);
+ h = __intVal(height);
+
+ /*
+ * need this check here: some servers simply dump core with bad args
+ */
+ if ((w >= 0) && (h >= 0)) {
+ px = __intVal(x);
+ py = __intVal(y);
+
+ /* attention: coordinates in X are shorts and wrap; clamp here. */
+ if (px > 0x7FFF) px = 0x7FFF;
+ else if (px < -0x8000) px = -0x8000;
+ if (py > 0x7FFF) py = 0x7FFF;
+ else if (py < -0x8000) py = -0x8000;
+
+ ENTER_XLIB();
+ XDrawRectangle(myDpy, win, gc, px, py, w, h);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
}
%}.
"badGC, badDrawable or coordinates not integer"
@@ -3894,11 +3921,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -3916,173 +3943,173 @@
&& __isNonNilObject(aString)
&& __bothSmallInteger(index1, index2)
&& __bothSmallInteger(x, y)) {
- int lMax = __intVal(@global(MaxStringLength));
- Display *dpy = myDpy;
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
-
- i1 = __intVal(index1) - 1;
- if (i1 >= 0) {
- OBJ cls;
-
- i2 = __intVal(index2) - 1;
- if (i2 < i1) {
- RETURN (self);
- }
- cp = (char *) __stringVal(aString);
- l = i2 - i1 + 1;
-
- if (__isStringLike(aString)) {
- n = __stringSize(aString);
- if (i2 < n) {
- cp += i1;
- if (l > lMax) l = lMax;
- ENTER_XLIB();
- if (opaque == true)
- XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
- else
- XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-
- cls = __qClass(aString);
- nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- cp += nInstBytes;
-
- if (__isBytes(aString)) {
- n = __byteArraySize(aString) - nInstBytes - 1;
-
- if (i2 < n) {
- cp += i1;
- if (l > lMax) l = lMax;
- ENTER_XLIB();
- if (opaque == true)
- XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
- else
- XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-
- /* TWOBYTESTRINGS */
- if (__isWords(aString)) {
- n = (__byteArraySize(aString) - nInstBytes) / 2;
- if (i2 < n) {
- union {
- char b[2];
- unsigned short s;
- } u;
- int i;
- XChar2b *cp2 = (XChar2b *)0;
- int mustFree = 0;
-
- cp += (i1 * 2);
- if (l > lMax) l = lMax;
+ int lMax = __intVal(@global(MaxStringLength));
+ Display *dpy = myDpy;
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+
+ i1 = __intVal(index1) - 1;
+ if (i1 >= 0) {
+ OBJ cls;
+
+ i2 = __intVal(index2) - 1;
+ if (i2 < i1) {
+ RETURN (self);
+ }
+ cp = (char *) __stringVal(aString);
+ l = i2 - i1 + 1;
+
+ if (__isStringLike(aString)) {
+ n = __stringSize(aString);
+ if (i2 < n) {
+ cp += i1;
+ if (l > lMax) l = lMax;
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
+ else
+ XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+
+ cls = __qClass(aString);
+ nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ cp += nInstBytes;
+
+ if (__isBytes(aString)) {
+ n = __byteArraySize(aString) - nInstBytes - 1;
+
+ if (i2 < n) {
+ cp += i1;
+ if (l > lMax) l = lMax;
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
+ else
+ XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, l);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+
+ /* TWOBYTESTRINGS */
+ if (__isWords(aString)) {
+ n = (__byteArraySize(aString) - nInstBytes) / 2;
+ if (i2 < n) {
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2 = (XChar2b *)0;
+ int mustFree = 0;
+
+ cp += (i1 * 2);
+ if (l > lMax) l = lMax;
#if defined(MSBFIRST) || defined(__MSBFIRST)
- /*
- * chars already in correct order
- */
+ /*
+ * chars already in correct order
+ */
#else
# if ! (defined(LSBFIRST) || defined(__LSBFIRST))
- /*
- * ST/X TwoByteStrings store the asciiValue in native byteOrder;
- * X expects them MSB first
- * convert as required
- */
- u.s = 0x1234;
- if (u.b[0] != 0x12)
+ /*
+ * ST/X TwoByteStrings store the asciiValue in native byteOrder;
+ * X expects them MSB first
+ * convert as required
+ */
+ u.s = 0x1234;
+ if (u.b[0] != 0x12)
# endif
- {
- if (l <= NLOCALBUFFER) {
- cp2 = xlatebuffer;
- } else {
- cp2 = (XChar2b *)(malloc(l * 2));
- mustFree = 1;
- }
- for (i=0; i<l; i++) {
- cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
- cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
- }
- cp = (char *) cp2;
- }
-#endif
- ENTER_XLIB();
- if (opaque == true)
- XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
- else
- XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
- LEAVE_XLIB();
-
- if (mustFree) {
- free(cp2);
- }
-
- RETURN ( self );
- }
- }
-
- /* FOURBYTESTRINGS */
- if (__isLongs(aString)) {
- n = (__byteArraySize(aString) - nInstBytes) / 4;
- if (i2 < n) {
- union {
- char b[2];
- unsigned short s;
- } u;
- int i;
- XChar2b *cp2 = (XChar2b *)0;
- int32 *ip;
- int mustFree = 0;
-
- cp += (i1 * 4);
- if (l > lMax) l = lMax;
-
- /*
- * all codePoints <= 16rFFFF are draw; above 16bit range are drawn as 16rFFFF.
- */
- if (l <= NLOCALBUFFER) {
- cp2 = xlatebuffer;
- } else {
- cp2 = (XChar2b *)(malloc(l * 2));
- mustFree = 1;
- }
- for (i=0; i<l; i++) {
- int32 codePoint = ((int32 *)cp)[i];
-
- if (codePoint > 0xFFFF) {
- codePoint = 0xFFFF;
- }
- cp2[i].byte1 = (codePoint >> 8) & 0xFF;
- cp2[i].byte2 = codePoint & 0xFF;
- }
- cp = (char *) cp2;
-
- ENTER_XLIB();
- if (opaque == true)
- XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
- else
- XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
- LEAVE_XLIB();
-
- if (mustFree) {
- free(cp2);
- }
-
- RETURN ( self );
- }
- }
- }
+ {
+ if (l <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(l * 2));
+ mustFree = 1;
+ }
+ for (i=0; i<l; i++) {
+ cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
+ cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
+ }
+ cp = (char *) cp2;
+ }
+#endif
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
+ else
+ XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
+ LEAVE_XLIB();
+
+ if (mustFree) {
+ free(cp2);
+ }
+
+ RETURN ( self );
+ }
+ }
+
+ /* FOURBYTESTRINGS */
+ if (__isLongs(aString)) {
+ n = (__byteArraySize(aString) - nInstBytes) / 4;
+ if (i2 < n) {
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2 = (XChar2b *)0;
+ int32 *ip;
+ int mustFree = 0;
+
+ cp += (i1 * 4);
+ if (l > lMax) l = lMax;
+
+ /*
+ * all codePoints <= 16rFFFF are draw; above 16bit range are drawn as 16rFFFF.
+ */
+ if (l <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(l * 2));
+ mustFree = 1;
+ }
+ for (i=0; i<l; i++) {
+ int32 codePoint = ((int32 *)cp)[i];
+
+ if (codePoint > 0xFFFF) {
+ codePoint = 0xFFFF;
+ }
+ cp2[i].byte1 = (codePoint >> 8) & 0xFF;
+ cp2[i].byte2 = codePoint & 0xFF;
+ }
+ cp = (char *) cp2;
+
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
+ else
+ XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, l);
+ LEAVE_XLIB();
+
+ if (mustFree) {
+ free(cp2);
+ }
+
+ RETURN ( self );
+ }
+ }
+ }
}
#undef NLOCALBUFFER
%}.
(aString isString and:[aString bitsPerCharacter > 16]) ifTrue:[
- self displayString:(TwoByteString new:aString size withAll:16rFFFF asCharacter)
- from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId opaque:opaque.
- ^ self.
+ self displayString:(TwoByteString new:aString size withAll:16rFFFF asCharacter)
+ from:index1 to:index2 x:x y:y in:aDrawableId with:aGCId opaque:opaque.
+ ^ self.
].
"x/y not integer, badGC or drawable, or not a string"
@@ -4097,11 +4124,11 @@
<context: #return>
operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
].
%{
@@ -4119,10 +4146,9050 @@
&& __isExternalAddress(aDrawableId)
&& __isNonNilObject(aString)
&& __bothSmallInteger(x, y)) {
- int lMax = __intVal(@global(MaxStringLength));
- Display *dpy = myDpy;
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
+ int lMax = __intVal(@global(MaxStringLength));
+ Display *dpy = myDpy;
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+
+ cp = (char *) __stringVal(aString);
+
+ if (__isStringLike(aString)) {
+ n = __stringSize(aString);
+ if (n > lMax) n = lMax;
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ else
+ XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+
+ cls = __qClass(aString);
+ nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ cp += nInstBytes;
+
+ if (__isBytes(aString)) {
+ n = __byteArraySize(aString) - nInstBytes - 1;
+
+ if (n > lMax) n = lMax;
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ else
+ XDrawString(dpy, win, gc, __intVal(x), __intVal(y), cp, n);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+
+ /* TWOBYTESTRINGS */
+ if (__isWords(aString)) {
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2;
+ int mustFree = 0;
+
+ n = (__byteArraySize(aString) - nInstBytes) / 2;
+ if (n > lMax) n = lMax;
+
+#if defined(MSBFIRST) || defined(__MSBFIRST)
+ /*
+ * chars already in correct order
+ */
+#else
+# if ! (defined(LSBFIRST) || defined(__LSBFIRST))
+ /*
+ * ST/X TwoByteStrings store the asciiValue in native byteOrder;
+ * X expects them MSB first
+ * convert as required
+ */
+ u.s = 0x1234;
+ if (u.b[0] != 0x12)
+# endif
+ {
+ if (n <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(n * 2));
+ mustFree = 1;
+ }
+
+ for (i=0; i<n; i++) {
+ cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
+ cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
+ }
+ cp = (char *) cp2;
+ }
+#endif
+ ENTER_XLIB();
+ if (opaque == true)
+ XDrawImageString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
+ else
+ XDrawString16(dpy, win, gc, __intVal(x), __intVal(y), (XChar2b *)cp, n);
+ LEAVE_XLIB();
+
+ if (mustFree) {
+ free(cp2);
+ }
+
+ RETURN ( self );
+ }
+ }
+#undef NLOCALBUFFER
+%}.
+ ^ super displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque
+!
+
+drawBits:givenBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:givenPadding
+ 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."
+
+ |fmt padding bits wantedPadding|
+
+ padding := givenPadding.
+ bits := givenBits.
+
+ "/ the XF86_VGA16 server seems to report an error when we pass it an
+ "/ 8-bit padded image. (it wants it 32bit padded).
+ "/ as a workaround, repad it here (although, the server and/or Xlib should
+ "/ care for that.
+
+ ((imageDepth == 4) and:[depth == 4]) ifTrue:[
+ fmt := self supportedImageFormatForDepth:4.
+ fmt isNil ifTrue:[
+ self primitiveFailed. "/ cannot represent this image
+ ^ nil
+ ].
+ wantedPadding := fmt at:#padding.
+ wantedPadding > givenPadding ifTrue:[
+ bits := self
+ repadBits:givenBits
+ width:imageWidth
+ height:imageHeight
+ depth:imageDepth
+ from:givenPadding
+ to:wantedPadding.
+ padding := wantedPadding.
+ ]
+ ].
+
+
+ operationsUntilFlush notNil ifTrue:[
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
+ ].
+ "
+ sorry; I had to separate it into 2 methods, since XPutImage needs
+ an unlimited stack, and thus cannot send primitiveFailed
+ "
+ (self
+ primDrawBits:bits
+ bitsPerPixel:bitsPerPixel
+ depth:imageDepth
+ msb:true
+ padding:padding
+ 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 primitiveFailedOrClosedConnection
+ ].
+!
+
+fillArcX:x y:y width:width height:height from:startAngle angle:angle
+ in:aDrawableId with:aGCId
+ "fill an arc. If any coordinate is not integer, an error is triggered.
+ The angles may be floats or integer - they are given in degrees."
+
+ <context: #return>
+
+ operationsUntilFlush notNil ifTrue:[
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
+ ].
+%{
+
+ GC gc;
+ Window win;
+ int w, h, angle1, angle2;
+ double f;
+
+ if (__isSmallInteger(startAngle))
+ angle1 = __intVal(startAngle) * 64;
+ else if (__isFloat(startAngle)) {
+ f = __floatVal(startAngle);
+ angle1 = f * 64;
+ } else if (__isShortFloat(startAngle)) {
+ f = __shortFloatVal(startAngle);
+ angle1 = f * 64;
+ } else goto bad;
+
+ if (__isSmallInteger(angle))
+ angle2 = __intVal(angle) * 64;
+ else if (__isFloat(angle)) {
+ f = __floatVal(angle);
+ angle2 = f * 64;
+ } else if (__isShortFloat(angle)) {
+ f = __shortFloatVal(angle);
+ angle2 = f * 64;
+ } else goto bad;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(x, y)
+ && __bothSmallInteger(width, height)) {
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ w = __intVal(width);
+ h = __intVal(height);
+ /*
+ * need this check here: some servers simply dump core with bad args
+ */
+ if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
+ ENTER_XLIB();
+ XFillArc(myDpy, win, gc, __intVal(x), __intVal(y),
+ w, h, angle1, angle2);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
+ }
+ bad: ;
+%}.
+ "badGC, badDrawable or coordinates not integer
+ or non float angle(s)"
+
+ self primitiveFailedOrClosedConnection
+!
+
+fillPolygon:aPolygon in:aDrawableId with:aGCId
+ "fill a polygon given by its points.
+ If any coordinate is not integer, an error is triggered."
+
+ <context: #return>
+
+ |numberOfPoints|
+
+ operationsUntilFlush notNil ifTrue:[
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
+ ].
+ numberOfPoints := aPolygon size.
+%{
+ GC gc;
+ Window win;
+ OBJ point, x, y;
+ int i, num;
+ XPoint *points;
+ XPoint qPoints[100];
+ int mustFree = 0;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __isSmallInteger(numberOfPoints)) {
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ num = __intVal(numberOfPoints);
+ if (num < 3) {
+ RETURN ( self );
+ }
+ /*
+ * avoid (slow) malloc, if not many points
+ */
+ if (num > 100) {
+ points = (XPoint *) malloc(sizeof(XPoint) * num);
+ if (! points) goto fail;
+ mustFree = 1;
+ } else
+ points = qPoints;
+ for (i=0; i<num; i++) {
+ point = __AT_(aPolygon, __MKSMALLINT(i+1));
+ if (! __isPoint(point)) goto fail;
+ x = _point_X(point);
+ y = _point_Y(point);
+ if (! __bothSmallInteger(x, y))
+ goto fail;
+ points[i].x = __intVal(x);
+ points[i].y = __intVal(y);
+ }
+ ENTER_XLIB();
+ XFillPolygon(myDpy, win, gc, points, num, Complex, CoordModeOrigin);
+ LEAVE_XLIB();
+ if (mustFree)
+ free(points);
+ RETURN ( self );
+
+fail: ;
+ if (mustFree)
+ free(points);
+ }
+%}.
+ "badGC, badDrawable or coordinates not integer"
+ self primitiveFailedOrClosedConnection
+!
+
+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."
+
+ <context: #return>
+
+ operationsUntilFlush notNil ifTrue:[
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
+ ].
+%{
+
+ int w, h;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(x, y)
+ && __bothSmallInteger(width, height)) {
+ w = __intVal(width);
+ h = __intVal(height);
+ /*
+ * need this check here: some servers simply dump core with bad args
+ */
+ if ((w >= 0) && (h >= 0)) {
+ ENTER_XLIB();
+ XFillRectangle(myDpy,
+ __DrawableVal(aDrawableId), __GCVal(aGCId),
+ __intVal(x), __intVal(y), w, h);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
+ }
+%}.
+ "badGC, badDrawable or coordinates not integer"
+ self primitiveFailedOrClosedConnection
+!
+
+primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth msb:msb masks:maskArray padding:bitPadding
+ extent:imageExtent sourceOrigin:srcOrg
+ into:aDrawableId
+ destinationOrigin:dstOrg extent:dstExtent
+ with:aGCId
+
+ <context: #return>
+
+ |imageWidth imageHeight rm gm bm srcx srcy dstx dsty w h|
+
+ imageWidth := imageExtent x.
+ imageHeight := imageExtent y.
+ rm := maskArray at:1.
+ gm := maskArray at:2.
+ bm := maskArray at:3.
+ srcx := srcOrg x.
+ srcy := srcOrg y.
+ dstx := dstOrg x.
+ dsty := dstOrg y.
+ w := dstExtent x.
+ h := dstExtent y.
+
+ "since XPutImage may allocate huge amount of stack space
+ (some implementations use alloca), this must run with unlimited stack."
+
+%{ /* UNLIMITEDSTACK */
+
+ /*
+ * need unlimited stack, since some Xlibs do a huge alloca in
+ * XPutImage
+ */
+ GC gc;
+ Window win;
+ XImage image;
+ int imgWdth;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(srcx, srcy)
+ && __bothSmallInteger(dstx, dsty)
+ && __bothSmallInteger(w, h)
+ && __bothSmallInteger(imageWidth, imageHeight)
+ && __bothSmallInteger(imageDepth, bitsPerPixel)
+ && __isSmallInteger(bitPadding)
+ && __bothSmallInteger(rm, gm)
+ && __isSmallInteger(bm)
+ && __isByteArrayLike(imageBits)) {
+ Display *dpy = myDpy;
+ int pad = __intVal(bitPadding);
+
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ if (! gc || !win)
+ goto fail;
+#ifdef ARGDEBUG
+ console_printf("args ok\n");
+#endif
+ image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
+ image.width = imgWdth = __intVal(imageWidth);
+ image.height = __intVal(imageHeight);
+ image.xoffset = 0;
+ image.format = ZPixmap;
+ image.byte_order = (msb == true) ? MSBFirst : LSBFirst;
+ image.bitmap_unit = 8;
+ image.bitmap_bit_order = MSBFirst;
+ image.bitmap_pad = pad;
+ image.depth = __intVal(imageDepth);
+ image.bits_per_pixel = __intVal(bitsPerPixel);
+ image.red_mask = __intVal(rm);
+ image.green_mask = __intVal(gm);
+ image.blue_mask = __intVal(bm);
+
+ image.bytes_per_line = ((((imgWdth * image.bits_per_pixel) + (pad-1)) / pad) * pad) / 8;
+
+ switch (image.bits_per_pixel) {
+ case 1:
+ case 2:
+ case 4:
+ case 8:
+ case 16:
+ case 24:
+ case 32:
+ break;
+
+ default:
+#ifdef ARGDEBUG
+ console_printf("bits_per_pixel=%d\n",image.bits_per_pixel);
+#endif
+ goto fail;
+ }
+
+ /* ENTER_XLIB(); */
+ XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
+ __intVal(dstx), __intVal(dsty),
+ __intVal(w), __intVal(h));
+ /* LEAVE_XLIB(); */
+
+ RETURN ( true );
+ }
+#ifdef ARGDEBUG
+ if (!! __isExternalAddress(aGCId)) console_printf("GC\n");
+ if (!! __isExternalAddress(aDrawableId)) console_printf("aDrawableId\n");
+ if (!! __isSmallInteger(srcx)) console_printf("srcx\n");
+ if (!! __isSmallInteger(srcy)) console_printf("srcy\n");
+ if (!! __isSmallInteger(dstx)) console_printf("dstx\n");
+ if (!! __isSmallInteger(dsty)) console_printf("dsty\n");
+ if (!! __isSmallInteger(w)) console_printf("w\n");
+ if (!! __isSmallInteger(h)) console_printf("h\n");
+ if (!! __isSmallInteger(imageWidth)) console_printf("imageWidth\n");
+ if (!! __isSmallInteger(imageHeight)) console_printf("imageHeight\n");
+ if (!! __isSmallInteger(imageDepth)) console_printf("imageDepth\n");
+ if (!! __isSmallInteger(bitsPerPixel)) console_printf("bitsPerPixel\n");
+ if (!! __isByteArrayLike(imageBits)) console_printf("imageBits\n");
+#endif
+
+fail: ;
+%}
+.
+ ^ false
+!
+
+primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth msb:msb padding:bitPadding
+ width:imageWidth height:imageHeight
+ x:srcx y:srcy
+ into:aDrawableId
+ x:dstx y:dsty
+ width:w height:h
+ with:aGCId
+
+ <context: #return>
+
+ "since XPutImage may allocate huge amount of stack space
+ (some implementations use alloca), this must run with unlimited stack."
+
+%{ /* UNLIMITEDSTACK */
+
+ /*
+ * need unlimited stack, since some Xlibs do a huge alloca in
+ * XPutImage
+ */
+ GC gc;
+ Window win;
+ XImage image;
+ int imgWdth;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aGCId)
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(srcx, srcy)
+ && __bothSmallInteger(dstx, dsty)
+ && __bothSmallInteger(w, h)
+ && __bothSmallInteger(imageWidth, imageHeight)
+ && __bothSmallInteger(imageDepth, bitsPerPixel)
+ && __isSmallInteger(bitPadding)
+ && __isByteArrayLike(imageBits)) {
+ Display *dpy = myDpy;
+ int pad = __intVal(bitPadding);
+
+ gc = __GCVal(aGCId);
+ win = __WindowVal(aDrawableId);
+ if (! gc || !win)
+ goto fail;
+#ifdef ARGDEBUG
+ console_printf("args ok\n");
+#endif
+ image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
+ image.width = imgWdth = __intVal(imageWidth);
+ image.height = __intVal(imageHeight);
+ image.xoffset = 0;
+ image.format = ZPixmap;
+ image.byte_order = (msb == true) ? MSBFirst : LSBFirst;
+ image.bitmap_unit = 8;
+ image.bitmap_bit_order = MSBFirst;
+ image.bitmap_pad = pad;
+ image.depth = __intVal(imageDepth);
+ image.bits_per_pixel = __intVal(bitsPerPixel);
+
+ /*
+ image.bytes_per_line = ((((imgWdth * image.depth) + (pad-1)) / pad) * pad) / 8;
+ */
+ image.bytes_per_line = ((((imgWdth * image.bits_per_pixel) + (pad-1)) / pad) * pad) / 8;
+
+ switch (image.bits_per_pixel) {
+ case 1:
+ case 2:
+ case 4:
+ case 8:
+ case 16:
+ case 24:
+ case 32:
+ break;
+
+ default:
+#ifdef ARGDEBUG
+ console_printf("bits_per_pixel=%d\n",image.bits_per_pixel);
+#endif
+ goto fail;
+ }
+
+ image.red_mask = 0xFFFF;
+ image.green_mask = 0xFFFF;
+ image.blue_mask = 0xFFFF;
+
+ /* ENTER_XLIB(); */
+ XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
+ __intVal(dstx), __intVal(dsty),
+ __intVal(w), __intVal(h));
+ /* LEAVE_XLIB(); */
+
+ RETURN ( true );
+ }
+#ifdef ARGDEBUG
+ if (!! __isExternalAddress(aGCId)) console_printf("GC\n");
+ if (!! __isExternalAddress(aDrawableId)) console_printf("aDrawableId\n");
+ if (!! __isSmallInteger(srcx)) console_printf("srcx\n");
+ if (!! __isSmallInteger(srcy)) console_printf("srcy\n");
+ if (!! __isSmallInteger(dstx)) console_printf("dstx\n");
+ if (!! __isSmallInteger(dsty)) console_printf("dsty\n");
+ if (!! __isSmallInteger(w)) console_printf("w\n");
+ if (!! __isSmallInteger(h)) console_printf("h\n");
+ if (!! __isSmallInteger(imageWidth)) console_printf("imageWidth\n");
+ if (!! __isSmallInteger(imageHeight)) console_printf("imageHeight\n");
+ if (!! __isSmallInteger(imageDepth)) console_printf("imageDepth\n");
+ if (!! __isSmallInteger(bitsPerPixel)) console_printf("bitsPerPixel\n");
+ if (!! __isByteArrayLike(imageBits)) console_printf("imageBits\n");
+#endif
+
+fail: ;
+%}
+.
+ ^ false
+! !
+
+!XWorkstation methodsFor:'event forwarding'!
+
+buttonMotion:view state:state x:x y:y rootX:rX rootY:rY time:time
+ "forward a buttonMotion event for some view"
+
+ lastEventTime := time.
+ self buttonMotion:state x:x y:y view:view
+!
+
+buttonPress:view button:button state:state x:x y:y rootX:rX rootY:rY time:time
+ "forward a buttonPress event for some view"
+
+ |logicalButton|
+
+ lastEventTime := time.
+ altDown := state bitTest:altModifierMask.
+ metaDown := state bitTest:metaModifierMask.
+ shiftDown := state bitTest:(self shiftModifierMask).
+ ctrlDown := state bitTest:(self ctrlModifierMask).
+
+ eventRootX := rX.
+ eventRootY := rY.
+
+ "/ physical to logical button translation
+ logicalButton := buttonTranslation at:button ifAbsent:button.
+
+ "/ special for mouse-wheel implementation
+ (logicalButton == #wheelFwd or:[logicalButton == #wheelBwd]) ifTrue:[
+ self mouseWheelMotion:state x:x y:y amount:(logicalButton == #wheelFwd ifTrue:[10] ifFalse:[-10]) deltaTime:10 view:view.
+ ^ self.
+ ].
+
+ logicalButton isInteger ifTrue:[
+ buttonsPressed := buttonsPressed bitOr:(1 bitShift:logicalButton-1).
+ ].
+
+ (multiClickTimeDelta notNil and:[lastButtonPressTime notNil]) ifTrue:[
+ time < (lastButtonPressTime + multiClickTimeDelta) ifTrue:[
+ lastButtonPressTime := time.
+ self buttonMultiPress:logicalButton x:x y:y view:view.
+ ^ self.
+ ].
+ ].
+ lastButtonPressTime := time.
+
+ view isNil ifTrue:[
+ "/ event arrived, after I destroyed it myself
+ ^ self
+ ].
+ logicalButton == 1 ifTrue:[
+ activateOnClick == true ifTrue:[
+ "/ dont raise above an active popup view.
+ (activeKeyboardGrab isNil and:[activePointerGrab isNil]) ifTrue:[
+ view topView raise.
+ ]
+ ].
+ ].
+ super buttonPress:logicalButton x:x y:y view:view
+!
+
+buttonRelease:view button:button state:state x:x y:y rootX:rX rootY:rY time:time
+ "forward a buttonPress event for some view"
+
+ |logicalButton|
+
+ lastEventTime := time.
+ altDown := state bitTest:altModifierMask.
+ metaDown := state bitTest:metaModifierMask.
+ shiftDown := state bitTest:(self shiftModifierMask).
+ ctrlDown := state bitTest:(self ctrlModifierMask).
+
+ eventRootX := rX.
+ eventRootY := rY.
+
+ "/ physical to logical button translation
+ logicalButton := buttonTranslation at:button ifAbsent:button.
+
+ "/ special for HPs mouse-wheel implementation
+ (logicalButton == #wheelFwd or:[logicalButton == #wheelBwd]) ifTrue:[
+ ^ self
+ ].
+
+ logicalButton isInteger ifTrue:[
+ buttonsPressed := buttonsPressed bitClear:(1 bitShift:logicalButton-1).
+ ].
+ self buttonRelease:logicalButton x:x y:y view:view
+!
+
+clientMessage:targetView type:typeAtom format:format data:data
+ |sensor|
+
+ targetView isNil ifTrue:[
+ "targetView is gone? Anyway, cannot do anything with this event..."
+ ^ self.
+ ].
+
+ "DND drag&drop protocol"
+ (format == 32 and:[typeAtom == (self atomIDOf:#DndProtocol)]) ifTrue:[
+ self dndMessage:nil data:data view:targetView.
+ ^ self.
+ ].
+
+ sensor := targetView sensor.
+ "not posted, if there is no sensor ..."
+ sensor notNil ifTrue:[
+ sensor clientMessage:typeAtom format:format eventData:data view:targetView
+ ].
+
+ "Created: 4.4.1997 / 17:49:26 / cg"
+!
+
+configure:view relativeTo:anotherViewId x:x y:y width:w height:h borderWidth:borderWidth above:aboveViewId overrideRedirect:overrideBool
+ "forward a size-change event for some view"
+
+"/ anotherViewId notNil ifTrue:[
+"/ |parentViewOrSelf|
+"/ parentViewOrSelf := self viewFromId:anotherViewId.
+"/ parentViewOrSelf notNil ifTrue:[
+"/ ].
+"/ ].
+ self configureX:x y:y width:w height:h view:view.
+ aboveViewId notNil ifTrue:[
+ |aboveView|
+ aboveView := self viewFromId:aboveViewId.
+ aboveView notNil ifTrue:[
+ "view is now on the top of the window stack"
+ self coveredBy:view view:aboveView.
+ ].
+ ].
+!
+
+createWindow:view x:x y:y width:w height:h
+
+ view isNil ifTrue:[
+ "/ event arrived, after I destroyed it myself
+ ^ self
+ ].
+ view sensor createWindow:view x:x y:y width:w height:h
+
+ "Created: / 30-05-2011 / 16:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+ "Modified: / 30-05-2011 / 19:00:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+dndMessage:event data:data view:targetView
+ "handle a drag&drop protocol message"
+
+ |sensor property dropType dropValue names i1 i2 propertyType|
+
+ dropType := data doubleWordAt:1.
+
+ "/ see def's in DragAndDropTypes.h
+ dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
+
+ property := self
+ getProperty:(self atomIDOf:#DndSelection)
+ from:rootId
+ delete:false.
+
+ propertyType := property key.
+ dropValue := property value.
+
+ "/ preconvert into a collection
+ "/ of fileNames, string or byteArray
+ "/ Notice: we do not yet convert into dropObjects
+ "/ here, to allow arbitrary data to be handled by
+ "/ redefined dropMessage methods in applications.
+ "/ Conversion is done for some well known types
+ "/ in the default dropMessage handling of SimpleView.
+
+ dropType == #DndFiles ifTrue:[
+ "/ actually, a list of fileNames
+ propertyType ~~ stringAtom ifTrue:[
+ 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+ ^ self
+ ].
+
+ names := OrderedCollection new.
+ i1 := 1.
+ [i1 ~~ 0] whileTrue:[
+ i2 := dropValue indexOf:(Character value:0) startingAt:i1.
+ i2 ~~ 0 ifTrue:[
+ names add:(dropValue copyFrom:i1 to:(i2-1)).
+ i1 := i2 + 1.
+ ] ifFalse:[
+ i1 := i2
+ ].
+ ].
+ dropValue := names.
+ dropValue := dropValue collect:[:nm | nm asFilename].
+ dropType := #files.
+ ] ifFalse:[ (dropType == #DndFile) ifTrue:[
+ propertyType ~~ stringAtom ifTrue:[
+ 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+ ^ self
+ ].
+ dropValue := dropValue asFilename.
+ dropType := #file.
+ ] ifFalse:[ (dropType == #DndDir) ifTrue:[
+ propertyType ~~ stringAtom ifTrue:[
+ 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+ ^ self
+ ].
+ dropValue := dropValue asFilename.
+ dropType := #directory.
+ ] ifFalse:[ (dropType == #DndText) ifTrue:[
+ propertyType ~~ stringAtom ifTrue:[
+ 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+ ^ self
+ ].
+ dropType := #text.
+ ] ifFalse:[ (dropType == #DndExe) ifTrue:[
+ propertyType ~~ stringAtom ifTrue:[
+ 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+ ^ self
+ ].
+ dropType := #executable.
+ ] ifFalse:[ (dropType == #DndLink) ifTrue:[
+ propertyType ~~ stringAtom ifTrue:[
+ 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+ ^ self
+ ].
+ dropType := #link.
+ ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
+ dropType := #rawData.
+ ] ifFalse:[
+ 'XWorkstation [info]: unsupported dropType: ' infoPrint. dropType infoPrintCR.
+ 'XWorkstation [info]: data: ' infoPrint. dropValue infoPrintCR.
+ dropType := #unknown.
+ ]]]]]]].
+
+ sensor := targetView sensor.
+ "not posted, if there is no sensor ..."
+ sensor notNil ifTrue:[
+ sensor dropMessage:dropType data:dropValue view:targetView position:nil handle:nil
+ ].
+
+ "Created: 4.4.1997 / 17:59:37 / cg"
+!
+
+expose:view x:x y:y width:w height:h count:count
+ "forward an expose event for some view"
+
+ self exposeX:x y:y width:w height:h view:view.
+
+
+
+
+!
+
+focusIn:view mode:mode detail:detail
+ "a view got the keyboard focus"
+
+ mode ~~ 1 "NotifyGrab" ifTrue:[
+ "mode NotifyGrab is set for pseudo-focus-changes, when a view grabs the keyboard"
+ self focusInView:view
+ ].
+!
+
+focusOut:view mode:mode detail:detail
+ "a view lost the keyboard focus"
+
+ mode ~~ 1 "NotifyGrab" ifTrue:[
+ "mode NotifyGrab is set for pseudo-focus-changes, when a view grabs the keyboard"
+ self focusOutView:view
+ ].
+!
+
+graphicsExpose:view x:x y:y width:w height:h count:count
+ "forward a graphics-expose event for some view"
+
+ self graphicsExposeX:x y:y width:w height:h final:(count==0) view:view
+
+
+
+
+!
+
+keyPress:view key:key code:keyCode state:state x:x y:y rootX:rX rootY:rY time:time
+ "forward a key-press event for some view"
+
+ |commonKey|
+
+ lastEventTime := time.
+ altDown := state bitTest:altModifierMask.
+ metaDown := state bitTest:metaModifierMask.
+ shiftDown := state bitTest:(self shiftModifierMask).
+ ctrlDown := state bitTest:(self ctrlModifierMask).
+ key isNil ifTrue:[
+ "/ happens sometimes on some systems
+ "/ (alt-graph on sun has no keysym)
+ ^ self
+ ].
+ eventRootX := rX.
+ eventRootY := rY.
+
+ "very low-level mapping of X11 event symbols to common ST/X event symbols"
+ commonKey := rawKeySymTranslation at:key ifAbsent:key.
+
+ self keyPress:commonKey x:x y:y view:view.
+!
+
+keyRelease:view key:key code:keyCode state:state x:x y:y rootX:rX rootY:rY time:time
+ "forward a key-release event for some view"
+
+ |commonKey|
+
+ lastEventTime := time.
+ altDown := state bitTest:altModifierMask.
+ metaDown := state bitTest:metaModifierMask.
+ shiftDown := state bitTest:(self shiftModifierMask).
+ ctrlDown := state bitTest:(self ctrlModifierMask).
+
+ key isNil ifTrue:[
+ "/ happens sometimes on some systems
+ "/ (alt-graph on sun has no keysym)
+ ^ self
+ ].
+ eventRootX := rX.
+ eventRootY := rY.
+
+ "very low-level mapping of X11 event symbols to common ST/X event symbols"
+ commonKey := rawKeySymTranslation at:key ifAbsent:key.
+
+ self keyRelease:commonKey x:x y:y view:view.
+!
+
+mappingNotify:view request:what event:eB
+ "One of Keyboard-, Modifier- or PointerMap has changed, probably by xmodmap.
+ Tell xlib about the fact."
+
+ (what == #mappingKeyboard or:[what == #mappingModifier]) ifTrue:[
+ self refreshKeyboardMapping:eB.
+ "Maybe some of our modifiers have been changed"
+ self initializeModifierMappings.
+ ].
+
+!
+
+pointerEnter:view x:x y:y rootX:rX rootY:rY state:state mode:mode detail:detail time:time
+ "forward a pointer enter event for some view"
+
+ lastEventTime := time.
+ altDown := state bitTest:altModifierMask.
+ metaDown := state bitTest:metaModifierMask.
+ shiftDown := state bitTest:(self shiftModifierMask).
+ ctrlDown := state bitTest:(self ctrlModifierMask).
+
+ eventRootX := rX.
+ eventRootY := rY.
+ self pointerEnter:state x:x y:y view:view
+!
+
+pointerLeave:view x:x y:y rootX:rX rootY:rY state:state mode:mode detail:detail time:time
+ "forward a pointer leave event for some view"
+
+ lastEventTime := time.
+ altDown := state bitTest:altModifierMask.
+ metaDown := state bitTest:metaModifierMask.
+ shiftDown := state bitTest:(self shiftModifierMask).
+ ctrlDown := state bitTest:(self ctrlModifierMask).
+
+ eventRootX := rX.
+ eventRootY := rY.
+ self pointerLeave:state view:view
+!
+
+propertyChange:aView property:propertyId state:aSymbol time:time
+ "sent when an X property changes.
+ This is a very X-specific mechanism."
+
+ |selectionFetcher|
+
+ lastEventTime := time.
+ aView isNil ifTrue:[
+ "event arrived, after aView has been destroyed"
+ ^ self
+ ].
+
+"/ 'propertyChange ' infoPrint. (self atomName:propertyId) print. ': ' print. aSymbol printCR.
+"/ aView propertyChange:atom state:aSymbol.
+
+ "JV@2011-01-06: Forward this event to views, they may
+ be interested (for now, only XEmbedSiteView is)"
+
+ aView sensor propertyChange:aView property:propertyId state:aSymbol time:time.
+
+ aSymbol ~~ #newValue ifTrue:[
+ "I am not interested in delete notifications"
+ ^ self.
+ ].
+ selectionFetcher := self findSelectionFetcher:aView id.
+ selectionFetcher notNil ifTrue:[
+ selectionFetcher message:thisContext message.
+ ].
+
+ "Modified: / 01-06-2011 / 13:40:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+selectionClear:aView selection:selectionID time:time
+ "sent when another X-client has created a selection.
+ This is a very X-specific mechanism."
+
+ |selectionFetcher|
+
+ lastEventTime := time.
+
+ selectionHandlers notNil ifTrue:[
+ selectionHandlers do:[:eachHandler |
+ eachHandler selectionClear:selectionID
+ ]
+ ].
+
+ aView isNil ifTrue:[
+ "event arrived, after aView has been destroyed"
+ ^ self
+ ].
+ selectionFetcher := self findSelectionFetcher:aView id.
+ selectionFetcher notNil ifTrue:[
+ selectionFetcher message:thisContext message.
+ ].
+!
+
+selectionNotify:aView selection:selectionID target:targetID property:propertyID requestor:requestorID time:time
+ "This event is sent by the selection owner as a response to our request for a selection.
+ This is a very X-specific mechanism."
+
+ |selectionFetcher|
+
+"/ Transcript show:'seletionNotify selID:'.
+"/ Transcript show:selectionID; show:' ('; show:(self atomName:selectionID); show:') '.
+"/ Transcript show:' targetID:'.
+"/ Transcript show:targetID; show:' ('; show:(self atomName:targetID); show:') '.
+"/ Transcript show:' propertyID:'.
+"/ Transcript show:propertyID; show:' ('; show:(self atomName:propertyID); show:') '.
+"/ Transcript showCR:''.
+"/ Transcript endEntry.
+
+ lastEventTime := time.
+
+ aView isNil ifTrue:[
+ "event arrived, after aView has been destroyed"
+ ^ self
+ ].
+ selectionFetcher := self findSelectionFetcher:aView id.
+ selectionFetcher notNil ifTrue:[
+ selectionFetcher message:thisContext message.
+ ].
+!
+
+selectionRequest:aView requestor:requestorID selection:selectionID target:targetID property:propertyID time:time
+ "sent by some other X-client to ask for the selection.
+ This is a very X-specific mechanism."
+
+ |selection property bufferGetSelector responseTargetID selectionTime|
+
+"/'Selection: ' print. (self atomName:selectionID) printCR. ' TargetId: ' print. (self atomName:targetID) printCR.
+"/' Property: ' print. (self atomName:propertyID) printCR. ' Requestor: ' print. requestorID printCR.
+
+ lastEventTime := time.
+
+ "JV@2012-03-27: Support both PRIMARY and CLIPBOARD selections"
+ selectionID == primaryAtom ifTrue:[
+ bufferGetSelector := #getPrimaryBuffer.
+ selectionTime := primarySelectionTime.
+ ] ifFalse:[
+ bufferGetSelector := #getCopyBuffer.
+ selectionTime := clipboardSelectionTime.
+ ].
+
+ (targetID == (self atomIDOf:#TIMESTAMP)) ifTrue:[
+ "the other view wants to know when we acquired ownership of the selection"
+ responseTargetID := self atomIDOf:#INTEGER.
+ selection := selectionTime.
+ ] ifFalse:[(targetID == (self atomIDOf:#TARGETS)) ifTrue:[
+ "the other view wants to know which targets we support"
+ responseTargetID := self atomIDOf:#ATOM.
+ selection := self supportedTargetAtoms.
+ ] ifFalse:[
+ selection := self selectionBuffer:bufferGetSelector as:targetID.
+ responseTargetID := selection key.
+ selection := selection value.
+ ]].
+
+"/'Send selection: ' print. selection printCR.
+
+ property := propertyID.
+
+ selection isNil ifTrue:[
+ "sending property None tells the client,
+ that I could not convert"
+"/ ('XWorkstation: unsupported selection target ', (self atomName:targetID)) errorPrintCR.
+ property := nil.
+ responseTargetID := targetID.
+ ] ifFalse:[
+ property == 0 ifTrue:[
+ "Support old (obsolete) clients requesting a None property.
+ Set the propertyID to the targetID"
+ property := responseTargetID.
+ ].
+ self setProperty:property
+ type:responseTargetID
+ value:selection
+ for:requestorID.
+ ].
+
+ self sendNotifySelection:selectionID
+ property:property
+ target:responseTargetID
+ time:time
+ to:requestorID.
+
+ "Modified: / 27-03-2012 / 15:22:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+visibilityNotify:aView state:how
+
+ aView notNil ifTrue:[
+ aView visibilityChange:how
+ ]
+! !
+
+!XWorkstation methodsFor:'event forwarding-ignored events'!
+
+circulateNotify:aView place:aSymbol
+ "sent, when the stacking order changes.
+ ignored for now."
+
+!
+
+circulateRequest:aView place:aSymbol
+ "sent, when the stacking order is about to change.
+ ignored for now."
+!
+
+colorMapNotify:aView state:aBoolean
+ "sent, when another colormap is installed.
+ This is a very X-specific mechanism."
+
+ aView isNil ifTrue:[
+ "/ event arrived, after I destroyed it myself
+ ^ self
+ ].
+ "/ not yet implemented
+ "/ aView colorMapChange
+!
+
+configureRequest:view x:x y:y width:w height:h above:above detail:detail
+ "ignored for now"
+
+ "/ view configureRequest
+!
+
+gravityNotify:aView x:x y:y
+ "ignored for now"
+
+ "/ aView gravityNotify
+!
+
+keymapNotify:aView
+ "ignore for now"
+
+!
+
+mapRequest:aView
+ "ignored for now"
+
+ "/ aView mapRequest
+!
+
+reparentedView:aView parentId:parentId x:x y:y
+ "ignored for now"
+
+ "/ aView reparented
+!
+
+resizeRequest:aView width:width height:height
+ "ignored for now"
+
+ "/ aView resizeRequest
+! !
+
+!XWorkstation methodsFor:'event handling'!
+
+defaultEventMask
+ "return a mask to enable some events by default."
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT( ExposureMask | StructureNotifyMask |
+ KeyPressMask | KeyReleaseMask |
+ PointerMotionMask |
+ EnterWindowMask | LeaveWindowMask |
+ ButtonPressMask | ButtonMotionMask | ButtonReleaseMask |
+ PropertyChangeMask ));
+%}
+!
+
+dispatchEvent:evArray
+ |viewId view evType arguments|
+
+ viewId := evArray at:1.
+ viewId notNil ifTrue:[
+ viewId = lastId ifTrue:[
+ view := lastView
+ ] ifFalse:[
+ view := self viewFromId:viewId
+ ].
+ ].
+
+ evType := evArray at:3.
+
+ (self respondsTo:evType) ifTrue:[
+ arguments := evArray copyFrom:3 to:(3 + evType numArgs - 1).
+ arguments at:1 put:view.
+
+ self perform:evType withArguments:arguments.
+ ^ true.
+ ].
+'********** unhandled event:' errorPrintCR.
+evType errorPrintCR. (evArray at:2) errorPrintCR.
+'********** see dispatchEvent' errorPrintCR.
+ ^ false
+!
+
+dispatchEventFor:aViewIdOrNil withMask:eventMask
+ "central event handling method:
+ get next event and send appropriate message to the sensor or view.
+ If the argument aViewIdOrNil is nil, events for any view are processed,
+ otherwise only events for the view with given id are processed.
+ If the argument aMask is nonNil, only events for this eventMask are
+ handled.
+ WARNING: this may block to wait for an event - you better check for a
+ pending event before calling this."
+
+ |eventArray|
+
+ eventArray := Array new:13.
+
+ (self getEventFor:aViewIdOrNil withMask:eventMask into:eventArray) ifTrue:[
+ AbortOperationRequest handle:[:ex |
+ ex return
+ ] do:[
+ self dispatchEvent:eventArray.
+ ]
+ ].
+
+ "Modified: 19.8.1997 / 17:10:42 / cg"
+!
+
+dispatchExposeEventFor:aViewIdOrNil
+ "get next expose event and send appropriate message to the sensor or view.
+ If the argument aViewIdOrNil is nil, events for any view are processed,
+ otherwise only events for the view with given id are processed.
+ WARNING: this may block to wait for an event - you better check for a
+ pending event before calling this."
+
+ self dispatchEventFor:aViewIdOrNil withMask:(self eventMaskFor:#expose)
+
+ "Modified: 19.8.1997 / 17:10:26 / cg"
+!
+
+dispatchLoop
+ preWaitAction := [self flush].
+ Processor addPreWaitAction:preWaitAction.
+ [
+ super dispatchLoop
+ ] ensure:[
+ Processor removePreWaitAction:preWaitAction.
+ preWaitAction := nil.
+ ].
+!
+
+dispatchPendingEvents
+ "central event handling method for modal operation.
+ (i.e. this is now only used in the modal debugger)
+ Dispatch any pending events; return when no more are pending.
+ This code is somewhat special, since X has a concept of graphic
+ expose events (which are sent after a bitblt). After such a bitblt,
+ we only handle exposes until the graphicsExpose arrives.
+ Other systems may not need such a kludge"
+
+ "interested in exposes only ?"
+
+ |eventArray|
+
+ dispatchingExpose notNil ifTrue:[
+ [self exposeEventPendingFor:dispatchingExpose withSync:false] whileTrue:[
+ self dispatchExposeEventFor:dispatchingExpose
+ ].
+ ^ self
+ ].
+
+ [self eventPendingWithSync:false] whileTrue:[
+ eventArray isNil ifTrue:[
+ eventArray := Array new:13.
+ ].
+ (self getEventFor:nil withMask:nil into:eventArray) ifTrue:[
+ AbortOperationRequest handle:[:ex |
+ ex return
+ ] do:[
+ self dispatchEvent:eventArray.
+ "/ multi-screen config: give others a chance
+ "/ (needed because we run at high (non-timesliced) prio)
+ Processor yield.
+ ]
+ ].
+ ]
+
+ "Modified: 19.8.1997 / 17:11:18 / cg"
+!
+
+disposeEventsWithMask:aMask for:aWindowIdOrNil
+ "dispose (throw away) specific events. If aWindowId is nil,
+ events matching the mask are thrown away regardless of which
+ view they are for. Otherwise, only matching events for that
+ view are flushed."
+
+ <context: #return>
+%{ /* UNLIMITEDSTACK */
+
+ XEvent ev;
+ Window win;
+
+ if (ISCONNECTED
+ && __isSmallInteger(aMask)) {
+ Display *dpy = myDpy;
+
+ ENTER_XLIB();
+ if (__isExternalAddress(aWindowIdOrNil)) {
+ win = __WindowVal(aWindowIdOrNil);
+ while (XCheckWindowEvent(dpy, win, __intVal(aMask), &ev)) ;;
+ } else {
+ while (XCheckMaskEvent(dpy, __intVal(aMask), &ev)) ;;
+ }
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+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;
+ else if (anEventSymbol == @symbol(substructureNotify)) m = SubstructureNotifyMask;
+ else if (anEventSymbol == @symbol(substructureRedirect)) m = SubstructureRedirectMask;
+ RETURN (__MKSMALLINT(m));
+%}
+!
+
+eventPending
+ "return true, if any event is pending.
+ This looks for both the internal queue and the display connection."
+
+ "/ ConservativeSync is required for some Xlib implementation,
+ "/ where eventPending returns wrong if we do not flush the buffer.
+ "/ (especially Win32 & Xlib)
+
+ ConservativeSync == true ifTrue:[self sync].
+
+ dispatchingExpose notNil ifTrue:[
+ ^ self exposeEventPendingFor:dispatchingExpose withSync:false
+ ].
+ ^ self eventPendingWithSync:false
+
+ "Modified: / 28.4.1999 / 11:08:12 / cg"
+!
+
+eventPending:anEventSymbol for:aWindowIdOrNil
+ "return true, if a specific event is pending"
+
+ ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil withSync:false
+!
+
+eventPending:anEventMask for:aWindowIdOrNil withSync:doSync
+ "return true, if any of the masked events is pending"
+
+ <context: #return>
+%{ /* UNLIMITEDSTACK */
+
+ XEvent ev;
+ Window win;
+ int thereIsOne;
+ OBJ rslt = false;
+
+ if (ISCONNECTED && __isSmallInteger(anEventMask)) {
+ Display *dpy = myDpy;
+
+ ENTER_XLIB();
+ if (doSync == true) {
+ XSync(dpy, 0); /* make certain everything is flushed */
+ }
+ if (__isExternalAddress(aWindowIdOrNil)) {
+ win = __WindowVal(aWindowIdOrNil);
+ thereIsOne = XCheckWindowEvent(dpy, win, __intVal(anEventMask), &ev);
+ } else {
+ thereIsOne = XCheckMaskEvent(dpy, __intVal(anEventMask), &ev);
+ }
+ if (thereIsOne) {
+ XPutBackEvent(dpy, &ev);
+ rslt = true;
+ }
+ LEAVE_XLIB();
+ }
+ RETURN ( rslt );
+%}
+!
+
+eventPendingWithSync:doSync
+ "return true, if any event is pending.
+ If doSync is true, do a sync output buffer (i.e. send all to the display and wait until its processed)
+ before checking."
+
+ <context: #return>
+%{ /* UNLIMITEDSTACK */
+ OBJ rslt = false;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ if (XEventsQueued(dpy, QueuedAlready)) {
+ RETURN (true);
+ }
+
+ ENTER_XLIB();
+ if (doSync == true) {
+ XSync(dpy, 0); /* make certain everything is flushed */
+ }
+ if (XPending(dpy)) {
+ rslt = true;
+ }
+ LEAVE_XLIB();
+ }
+ RETURN ( rslt );
+%}
+!
+
+eventQueued
+ "return true, if any event is queued"
+
+ dispatchingExpose notNil ifTrue:[
+ ^ self exposeEventPendingFor:dispatchingExpose withSync:false
+ ].
+ ^ self eventQueuedAlready
+
+ "Created: 12.12.1995 / 21:43:00 / stefan"
+!
+
+eventQueuedAlready
+ "return true, if any event is queued internally.
+ (i.e. in X's internal event queue, which is both filled by explicit
+ nextEvent calls AND whenever drawing is done and events are pending on
+ the display connection)."
+
+%{ /* UNLIMITEDSTACK */
+ OBJ rslt = false;
+
+ if (ISCONNECTED) {
+ /* ENTER ... LEAVE not needed; XEventsQueued will not block */
+ /* ENTER_XLIB(); */
+ if (XEventsQueued(myDpy, QueuedAlready)) {
+ rslt = true;
+ }
+ /* LEAVE_XLIB(); */
+ }
+ RETURN ( rslt );
+%}
+!
+
+exposeEventPendingFor:aWindowIdOrNil withSync:doSync
+ "return true, if any expose event is pending for a specific view,
+ or any view (if the arg is nil).
+ This is an X specific, only required after a scroll operation."
+
+ <context: #return>
+
+%{ /* UNLIMITEDSTACK */
+
+ XEvent ev;
+ Window win;
+ int thereIsOne;
+ OBJ rslt = false;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ ENTER_XLIB();
+ if (doSync == true) {
+ XSync(dpy, 0); /* make certain everything is flushed */
+ }
+ if (__isExternalAddress(aWindowIdOrNil)) {
+ win = __WindowVal(aWindowIdOrNil);
+ thereIsOne = XCheckWindowEvent(dpy, win, ExposureMask, &ev);
+ } else {
+ thereIsOne = XCheckMaskEvent(dpy, ExposureMask, &ev);
+ }
+ if (thereIsOne) {
+ XPutBackEvent(dpy, &ev);
+ rslt = true;
+ }
+ LEAVE_XLIB();
+ }
+ RETURN ( rslt );
+%}
+!
+
+getEventFor:aViewIdOrNil withMask:eventMask into:anEventArray
+ "read next event if there is one and put events data into anEventArray.
+ 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.
+
+ The event fields are placed them into anEventArray (must be at least size 13):
+ the fields are:
+ 1: windowID
+ 2: eventType-ID
+ 3: eventTypeSymbol
+
+ 4.. args
+
+ Sorry I had to split dispatch into this fetch method and a separate
+ handler method to allow UNLIMITEDSTACK here.
+ (some Xlibs do a big alloca there which cannot be done in
+ #dispatchEvent:, since it dispatches out into ST-methods).
+ "
+
+%{ /* UNLIMITEDSTACK */
+
+ Display *dpy;
+ Window win, wWanted;
+ int evMask, returnValue;
+ XEvent ev;
+ OBJ eB;
+ KeySym keySym;
+ unsigned char buffer[64];
+ int i, nchars;
+ char *keySymString;
+ OBJ arg, sym, t, windowID;
+
+ if (! ISCONNECTED) {
+ RETURN (false);
+ }
+
+ dpy = myDpy;
+
+ ev.type = 0;
+
+ if (__isSmallInteger(eventMask)) {
+ evMask = __intVal(eventMask);
+ } else {
+ evMask = ~0;
+ }
+
+ if (__isExternalAddress(aViewIdOrNil)) {
+ wWanted = __WindowVal(aViewIdOrNil);
+ returnValue = XCheckWindowEvent(dpy, wWanted, evMask, &ev);
+ } else {
+ if (evMask == ~0) {
+ XNextEvent(dpy, &ev);
+ returnValue = 1;
+ } else {
+ returnValue = XCheckMaskEvent(dpy, evMask, &ev);
+ }
+ }
+ if (!returnValue) {
+ /* there is no event */
+ RETURN (false);
+ }
+
+ if (anEventArray == nil) {
+ /* sender is not interested in the event */
+ RETURN(true);
+ }
+
+ if (!__isArray(anEventArray)) {
+ console_fprintf(stderr, "XWorkstation: bad argument [%d]\n", __LINE__);
+ RETURN (false);
+ }
+ if (__arraySize(anEventArray) < 11) {
+ console_fprintf(stderr, "XWorkstation: bad argument [%d]\n", __LINE__);
+ RETURN (false);
+ }
+
+# define ANYBUTTON (Button1MotionMask | Button2MotionMask | Button3MotionMask)
+
+# define ae ((XAnyEvent *)&ev)
+# define ee ((XExposeEvent *)&ev)
+# define ke ((XKeyPressedEvent *)&ev)
+# define be ((XButtonPressedEvent *)&ev)
+# define ce ((XConfigureEvent *)&ev)
+# define cr ((XConfigureRequestEvent *)&ev)
+# define me ((XMotionEvent *)&ev)
+# define ele ((XCrossingEvent *)&ev)
+# define de ((XDestroyWindowEvent *)&ev)
+# define ve ((XVisibilityEvent *)&ev)
+# define fe ((XFocusChangeEvent *)&ev)
+# define cre ((XCreateWindowEvent *)&ev)
+# define mape ((XMappingEvent *)&ev)
+# define gre ((XGravityEvent *)&ev)
+# define rr ((XResizeRequestEvent *)&ev)
+# define rpe ((XReparentEvent *)&ev)
+# define cie ((XCirculateEvent *)&ev)
+# define pe ((XPropertyEvent *)&ev)
+# define sce ((XSelectionClearEvent *)&ev)
+# define cme ((XColormapEvent *)&ev)
+
+ if (((t = __INST(lastId)) != nil)
+ && __isExternalAddress(t)
+ && (__WindowVal(t) == ae->window)) {
+ windowID = t;
+ } else {
+ windowID = __MKEXTERNALADDRESS(ae->window);
+ }
+
+ __ArrayInstPtr(anEventArray)->a_element[0] = windowID; __STORE(anEventArray, windowID);
+ __ArrayInstPtr(anEventArray)->a_element[1] = __MKSMALLINT(ev.type);
+
+ switch (ev.type) {
+ case KeyRelease:
+ sym = @symbol(keyRelease:key:code:state:x:y:rootX:rootY:time:);
+ goto keyPressAndRelease;
+
+ case KeyPress:
+ sym = @symbol(keyPress:key:code:state:x:y:rootX:rootY:time:);
+ /* FALL INTO */
+
+ keyPressAndRelease:
+ arg = nil;
+ nchars = XLookupString(ke, (char *)buffer, sizeof(buffer), &keySym, NULL);
+ if (nchars == 1 && (((buffer[0] >= ' ') && (buffer[0] <= '~'))
+ || (buffer[0] >= 0x80))) {
+ arg = __MKCHARACTER(buffer[0]);
+// } else if (nchars > 2) {
+// arg = __MKSTRING_L(buffer, nchars);
+ } else {
+ keySymString = XKeysymToString(keySym);
+ if (keySymString) {
+ arg = __MKSYMBOL(keySymString, 0);
+ }
+ }
+
+#ifdef IGNORE_UNKNOWN_KEYCODES
+ if (arg == nil) {
+ /* happens sometimes (alt-graph on sun has no keysym) */
+ RETURN (false);
+ }
+#endif
+ __ArrayInstPtr(anEventArray)->a_element[2] = sym;
+
+ __ArrayInstPtr(anEventArray)->a_element[3] = arg; __STORE(anEventArray, arg);
+ t = __MKUINT(ke->keycode); __ArrayInstPtr(anEventArray)->a_element[4] = t; __STORE(anEventArray, t);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ke->state);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ke->x);
+ __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ke->y);
+ __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ke->x_root);
+ __ArrayInstPtr(anEventArray)->a_element[9] = __mkSmallInteger(ke->y_root);
+ t = __MKUINT(ke->time); __ArrayInstPtr(anEventArray)->a_element[10] = t; __STORE(anEventArray, t);
+ break;
+
+ case ButtonPress:
+ sym = @symbol(buttonPress:button:state:x:y:rootX:rootY:time:);
+ goto buttonPressAndRelease;
+
+ case ButtonRelease:
+ sym = @symbol(buttonRelease:button:state:x:y:rootX:rootY:time:);
+ /* fall into */
+
+ buttonPressAndRelease:
+ __ArrayInstPtr(anEventArray)->a_element[2] = sym;
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(be->button);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ke->state);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(be->x);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(be->y);
+ __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(be->x_root);
+ __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(be->y_root);
+ t = __MKUINT(be->time); __ArrayInstPtr(anEventArray)->a_element[9] = t; __STORE(anEventArray, t);
+ break;
+
+ case MotionNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(buttonMotion:state:x:y:rootX:rootY:time:);
+
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(me->state);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(me->x);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(me->y);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(me->x_root);
+ __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(me->y_root);
+ t = __MKUINT(me->time); __ArrayInstPtr(anEventArray)->a_element[8] = t; __STORE(anEventArray, t);
+ break;
+
+ case FocusIn:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(focusIn:mode:detail:);
+ goto focusInOut;
+
+ case FocusOut:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(focusOut:mode:detail:);
+ /* fall into */
+
+ focusInOut:
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(fe->mode);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(fe->detail);
+ break;
+
+ case EnterNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(pointerEnter:x:y:rootX:rootY:state:mode:detail:time:);
+ goto enterLeave;
+
+ case LeaveNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(pointerLeave:x:y:rootX:rootY:state:mode:detail:time:);
+ /* fall into */
+
+ enterLeave:
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ele->x);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ele->y);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ele->x_root);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ele->y_root);
+ __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ele->state);
+ __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ele->mode);
+ __ArrayInstPtr(anEventArray)->a_element[9] = __mkSmallInteger(ele->detail);
+ t = __MKUINT(ele->time); __ArrayInstPtr(anEventArray)->a_element[10] = t; __STORE(anEventArray, t);
+ break;
+
+ case Expose:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(expose:x:y:width:height:count:);
+ goto expose;
+
+ case GraphicsExpose:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(graphicsExpose:x:y:width:height:count:);
+ /* fall into */
+
+ expose:
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ee->x);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ee->y);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ee->width);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ee->height);
+ __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ee->count);
+ break;
+
+ case NoExpose:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(noExposeView:);
+ break;
+
+ case VisibilityNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(visibilityNotify:state:);
+ switch (ve->state) {
+ case VisibilityUnobscured:
+ __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(unobscured);
+ break;
+ case VisibilityPartiallyObscured:
+ __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(partiallyObscured);
+ break;
+ case VisibilityFullyObscured:
+ __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(fullyObscured);
+ break;
+ default:
+ __ArrayInstPtr(anEventArray)->a_element[3] = __MKSMALLINT(ve->state);
+ break;
+ }
+ break;
+
+ case CreateNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(createWindow:x:y:width:height:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(cre->x);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(cre->y);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(cre->width);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(cre->height);
+ break;
+
+ case DestroyNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(destroyedView:);
+ break;
+
+ case UnmapNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(unmappedView:);
+ break;
+
+ case MapNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mappedView:);
+ break;
+
+ case ConfigureNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(configure:relativeTo:x:y:width:height:borderWidth:above:overrideRedirect:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = nil;
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ce->x);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ce->y);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ce->width);
+ __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ce->height);
+ __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ce->border_width);
+ __ArrayInstPtr(anEventArray)->a_element[9] = nil;
+ __ArrayInstPtr(anEventArray)->a_element[10] = ce->override_redirect ? true : false;
+ if (ce->event != None) {
+ t = __MKEXTERNALADDRESS(ce->event); __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
+ }
+ if (ce->above != None) {
+ t = __MKEXTERNALADDRESS(ce->above); __ArrayInstPtr(anEventArray)->a_element[9] = t; __STORE(anEventArray, t);
+ }
+ break;
+
+ case GravityNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(gravityNotify:x:y:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(gre->x);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(gre->y);
+ break;
+
+ case ResizeRequest:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(resizeRequest:width:height:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(rr->width);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(rr->height);
+ break;
+
+ case ConfigureRequest:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(configureRequest:x:y:width:height:above:detail:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(cr->x);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(cr->y);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(cr->width);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(cr->height);
+ __ArrayInstPtr(anEventArray)->a_element[7] = nil;
+ if (cr->above != None) {
+ t = __MKEXTERNALADDRESS(cr->above); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
+ }
+ switch (cr->detail) {
+ case Above:
+ __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(above);
+ break;
+ case Below:
+ __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(below);
+ break;
+ case TopIf:
+ __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(topIf);
+ break;
+ case BottomIf:
+ __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(bottomIf);
+ break;
+ case Opposite:
+ __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(opposite);
+ break;
+ default:
+ __ArrayInstPtr(anEventArray)->a_element[8] = __MKSMALLINT(cr->detail);
+ break;
+ }
+ break;
+
+ case CirculateNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(circulateNotify:place:);
+ goto circulate;
+
+ case CirculateRequest:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(circulateRequest:place:);
+ /* fall into */
+ circulate:
+ switch (cie->place) {
+ case PlaceOnTop:
+ __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(placeOnTop);
+ break;
+ case PlaceOnBottom:
+ __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(placeOnBottom);
+ break;
+ default:
+ __ArrayInstPtr(anEventArray)->a_element[3] = __MKSMALLINT(cie->place);
+ break;
+ }
+ break;
+
+ case PropertyNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(propertyChange:property:state:time:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(pe->atom);
+ switch (pe->state) {
+ case PropertyNewValue:
+ __ArrayInstPtr(anEventArray)->a_element[4] = @symbol(newValue);
+ break;
+ case PropertyDelete:
+ __ArrayInstPtr(anEventArray)->a_element[4] = @symbol(deleted);
+ break;
+ default:
+ __ArrayInstPtr(anEventArray)->a_element[4] = __MKSMALLINT(pe->state);
+ break;
+ }
+ t = __MKUINT(pe->time); __ArrayInstPtr(anEventArray)->a_element[5] = t; __STORE(anEventArray, t);
+ break;
+
+ case SelectionClear:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionClear:selection:time:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(sce->selection);
+ t = __MKUINT(sce->time); __ArrayInstPtr(anEventArray)->a_element[4] = t; __STORE(anEventArray, t);
+ break;
+
+ case SelectionRequest:
+ /*
+ * someone wants the selection
+ */
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionRequest:requestor:selection:target:property:time:);
+ t = __MKEXTERNALADDRESS(ev.xselectionrequest.requestor); __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __MKATOMOBJ(ev.xselectionrequest.selection);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __MKATOMOBJ(ev.xselectionrequest.target);
+ __ArrayInstPtr(anEventArray)->a_element[6] = __MKATOMOBJ(ev.xselectionrequest.property);
+ t = __MKUINT(ev.xselectionrequest.time); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
+ break;
+
+ case SelectionNotify:
+ /*
+ * returned selection value (answer from SelectionRequest)
+ */
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionNotify:selection:target:property:requestor:time:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(ev.xselection.selection);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __MKATOMOBJ(ev.xselection.target);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __MKATOMOBJ(ev.xselection.property);
+ t = __MKEXTERNALADDRESS(ev.xselection.requestor); __ArrayInstPtr(anEventArray)->a_element[6] = t; __STORE(anEventArray, t);
+ t = __MKUINT(ev.xselection.time); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
+ break;
+
+ case ColormapNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(colormapNotify:state:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = cme->state == ColormapInstalled ? true : false;
+ break;
+
+ case ClientMessage:
+ if (ev.xclient.message_type == (int) __AtomVal(__INST(protocolsAtom))) {
+ if ((ev.xclient.data.l[0] == (int) __AtomVal(__INST(quitAppAtom)))
+ || (ev.xclient.data.l[0] == (int) __AtomVal(__INST(deleteWindowAtom)))) {
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(terminateView:);
+ break;
+ }
+ if (ev.xclient.data.l[0] == (int) __AtomVal(__INST(saveYourselfAtom))) {
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(saveAndTerminateView:);
+ break;
+ }
+ }
+ /*
+ * any other client message
+ */
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(clientMessage:type:format:data:);
+ __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(ev.xclient.message_type);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __MKSMALLINT(ev.xclient.format);
+ t = __MKBYTEARRAY(&ev.xclient.data, sizeof(ev.xclient.data)); __ArrayInstPtr(anEventArray)->a_element[5] = t; __STORE(anEventArray, t);
+ break;
+
+ case MappingNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mappingNotify:request:event:);
+ switch(mape->request) {
+ case MappingModifier:
+ arg = @symbol(mappingModifier);
+ break;
+ case MappingKeyboard:
+ arg = @symbol(mappingKeyboard);
+ break;
+ case MappingPointer:
+ arg = @symbol(mappingPointer);
+ break;
+ default:
+ arg = __MKSMALLINT(mape->request);
+ break;
+ }
+ __ArrayInstPtr(anEventArray)->a_element[3] = arg;
+ t = __MKBYTEARRAY(&ev, sizeof(*mape)); __ArrayInstPtr(anEventArray)->a_element[4] = t;
+ __STORE(anEventArray, t);
+ break;
+
+ case KeymapNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(keymapNotify:);
+ break;
+
+ case MapRequest:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mapRequest:);
+ break;
+
+ case ReparentNotify:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(reparentedView:parentId:x:y:);
+ t = __MKEXTERNALADDRESS(rpe->parent);
+ __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
+ __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(rpe->x);
+ __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(rpe->y);
+ break;
+
+ default:
+ __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(unknownX11Event);
+ break;
+ }
+#undef ae
+#undef ee
+#undef ke
+#undef be
+#undef ce
+#undef cr
+#undef cre
+#undef cle
+#undef gre
+#undef me
+#undef ewe
+#undef ele
+#undef lwe
+#undef de
+#undef mape
+#undef ve
+#undef fe
+#undef rr
+#undef rpe
+#undef pe
+#undef cie
+#undef sce
+#undef cme
+
+%}.
+
+ ^ true
+!
+
+handleAllEvents
+ "from now on, handle any kind of event"
+
+ dispatchingExpose := nil
+!
+
+handleExposeOnlyFor:aView
+ "from now on, handle expose events only"
+
+ dispatchingExpose := aView id
+!
+
+registerHotKeyForWindow:aDrawableId withId:anId modifiers:aModifier virtualKeyCode:aVirtualKeyCode
+ "Defines a system-wide hot key."
+ <resource: #todo>
+
+ "no-op until implemented"
+
+ ^ false.
+!
+
+setEventMask:aMask in:aWindowId
+ "tell X that we are only interested in events from aMask, which
+ is the bitwise or of the eventMask bits (see 'eventMaskFor:')"
+
+ <context: #return>
+%{
+
+ int mask;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isSmallInteger(aMask)) {
+ mask = __intVal(aMask);
+
+#ifdef OLD
+ /* these may not be disabled */
+ mask |= ExposureMask | StructureNotifyMask |
+ KeyPressMask | KeyReleaseMask |
+ EnterWindowMask | LeaveWindowMask |
+ ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
+#endif
+
+ ENTER_XLIB();
+ XSelectInput(myDpy, __WindowVal(aWindowId), mask);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+startDispatch
+ "redefined to clear dispatchingExpose, which is a special X feature"
+
+ (dispatchProcess notNil and:[dispatchProcess isDead not]) ifTrue:[^ self].
+ dispatchingExpose := nil.
+ super startDispatch.
+!
+
+unregisterHotKeyForWindow:aDrawableId withId:anId
+ "Release a system-wide hot key."
+ <resource: #todo>
+
+ "no-op until implemented. Since we never registered anything, the unregister succeeds"
+
+ ^ true.
+!
+
+viewIsRelevantInCheckForEndOfDispatch:aView
+ aView == windowGroupWindow ifTrue:[^ false].
+ ^ super viewIsRelevantInCheckForEndOfDispatch:aView
+! !
+
+!XWorkstation methodsFor:'event handling-old dispatch'!
+
+buttonPress:button x:x y:y view:aView
+ "forward a button-press event for some view"
+
+ aView isNil ifTrue:[
+ "/ event arrived, after I destroyed it myself
+ ^ self
+ ].
+ button == 1 ifTrue:[
+ activateOnClick == true ifTrue:[
+ "/ dont raise above an active popup view.
+ (activeKeyboardGrab isNil and:[activePointerGrab isNil]) ifTrue:[
+ aView topView raise.
+"/ ] ifFalse:[
+"/ activeKeyboardGrab printCR.
+"/ activePointerGrab printCR.
+ ]
+ ].
+ ].
+ super buttonPress:button x:x y:y view:aView
+
+
+
+! !
+
+!XWorkstation methodsFor:'event sending'!
+
+sendClientEvent:msgType format:msgFormat to:targetWindowID propagate:propagate eventMask:eventMask window:windowID data1:d1 data2:d2 data3:d3 data4:d4 data5:d5
+ "send a ClientMessage to some other (possibly: non-ST/X) view.
+ The client message gets message_type and msgFormat as specified by
+ the arguments. The additional data arguments specify up to
+ 5 longWords of user data; each may be an integer or nil.
+ It is passed transparently in the events data field.
+ See XProtocol specification for more details."
+
+ "/ Event.xclient.type = ClientMessage;
+ "/ Event.xclient.display = dpy;
+ "/ Event.xclient.message_type = msgType;
+ "/ Event.xclient.format = msgFormat;
+ "/ Event.xclient.window = windowID;
+ "/ Event.xclient.data.l[0] = d1
+ "/ Event.xclient.data.l[1] = d2
+ "/ Event.xclient.data.l[2] = d3
+ "/ Event.xclient.data.l[3] = d4
+ "/ Event.xclient.data.l[4] = d5
+ "/
+ "/ XSendEvent(dpy, targetWindowID, propagate, eventMask, &Event);
+
+ <context: #return>
+%{
+ int type;
+ int state;
+ int __eventMask;
+
+ if (ISCONNECTED
+ && __isInteger(msgType)
+ && __isInteger(msgFormat)
+ && (eventMask == nil || __isInteger(eventMask))
+ && (__isExternalAddress(windowID) || __isInteger(windowID))
+ && (__isExternalAddress(targetWindowID) || __isInteger(targetWindowID))) {
+ Display *dpy = myDpy;
+ XEvent ev;
+ Status result;
+ Window targetWindow;
+
+ if (__isInteger(d1)) {
+ ev.xclient.data.l[0] = __longIntVal(d1);
+ } else {
+ if (__isExternalAddress(d1)) {
+ ev.xclient.data.l[0] = (INT)__externalAddressVal(d1);
+ } else {
+ ev.xclient.data.l[0] = 0;
+ }
+ }
+ if (__isInteger(d2)) {
+ ev.xclient.data.l[1] = __longIntVal(d2);
+ } else {
+ if (__isExternalAddress(d2)) {
+ ev.xclient.data.l[1] = (INT)__externalAddressVal(d2);
+ } else {
+ ev.xclient.data.l[1] = 0;
+ }
+ }
+ if (__isInteger(d3)) {
+ ev.xclient.data.l[2] = __longIntVal(d3);
+ } else {
+ if (__isExternalAddress(d3)) {
+ ev.xclient.data.l[2] = (INT)__externalAddressVal(d3);
+ } else {
+ ev.xclient.data.l[2] = 0;
+ }
+ }
+ if (__isInteger(d4)) {
+ ev.xclient.data.l[3] = __longIntVal(d4);
+ } else {
+ if (__isExternalAddress(d4)) {
+ ev.xclient.data.l[3] = (INT)__externalAddressVal(d4);
+ } else {
+ ev.xclient.data.l[3] = 0;
+ }
+ }
+ if (__isInteger(d5)) {
+ ev.xclient.data.l[4] = __longIntVal(d5);
+ } else {
+ if (__isExternalAddress(d5)) {
+ ev.xclient.data.l[4] = (INT)__externalAddressVal(d5);
+ } else {
+ ev.xclient.data.l[4] = 0;
+ }
+ }
+
+ if (__isExternalAddress(windowID)) {
+ ev.xclient.window = __WindowVal(windowID);
+ } else {
+ ev.xclient.window = (Window)__longIntVal(windowID);
+ }
+
+ if (__isExternalAddress(targetWindowID)) {
+ targetWindow = __WindowVal(targetWindowID);
+ } else {
+ targetWindow = (Window)__longIntVal(targetWindowID);
+ }
+
+ ev.xclient.type = ClientMessage;
+ ev.xclient.display = dpy;
+ ev.xclient.message_type = __longIntVal(msgType);
+ ev.xclient.format = __longIntVal(msgFormat);
+
+ if (eventMask == nil) {
+ __eventMask = NoEventMask;
+ } else {
+ __eventMask = __longIntVal(eventMask);
+ }
+
+ ENTER_XLIB();
+ result = XSendEvent(dpy, targetWindow, (propagate == true ? True : False), __eventMask , &ev);
+ LEAVE_XLIB();
+
+ if ((result == BadValue) || (result == BadWindow)) {
+ DPRINTF(("bad status in sendClientEvent\n"));
+ RETURN ( false )
+ }
+ RETURN (true)
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+!
+
+sendKeyOrButtonEvent:typeSymbol x:xPos y:yPos keyOrButton:keySymCodeOrButtonNr state:stateMask toViewId:targetId
+ "send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
+ TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
+ For buttonEvents, the keySymCodeOrButtonNr must be the buttons number (1, 2 ...);
+ for key events, it can be either a symbol (as listen in X's keySyms)
+ or a numeric keysym code. If state is nil, the modifier bits (shift & control)
+ are computed from the keyboardMap - if non-nil, these are passed as modifierbits.
+ The non-nil case is the lowlevel entry, where state must include any shift/ctrl information
+ (not very user friendly)"
+
+ <context: #return>
+%{
+ int type;
+ int state;
+
+ if (__isSmallInteger(stateMask)) {
+ state = __intVal(stateMask);
+ } else {
+ state = 0;
+ }
+
+ if (ISCONNECTED
+ && __isSmallInteger(xPos) && __isSmallInteger(yPos)
+ && (__isSmallInteger(keySymCodeOrButtonNr) || __isStringLike(keySymCodeOrButtonNr))
+ && (__isExternalAddress(targetId) || __isInteger(targetId))) {
+ Display *dpy = myDpy;
+
+ XEvent ev;
+ Window target;
+ Status result;
+ KeySym keySym, *syms;
+ int screen = __intVal(__INST(screen));
+ char s[2];
+ int nSyms;
+
+ if ((typeSymbol == @symbol(keyPress))
+ || (typeSymbol == @symbol(keyRelease))) {
+ if (__isStringLike(keySymCodeOrButtonNr)) {
+ keySym = XStringToKeysym(__stringVal(keySymCodeOrButtonNr));
+ } else {
+ if (__isCharacter(keySymCodeOrButtonNr)) {
+ s[0] = __intVal(__characterVal(keySymCodeOrButtonNr));
+ s[1] = '\0';
+ keySym = XStringToKeysym(s);
+ } else {
+ keySym = (KeySym) __intVal(keySymCodeOrButtonNr);
+ }
+ }
+ ev.xkey.keycode = XKeysymToKeycode(dpy, keySym);
+
+ if (stateMask == nil) {
+ /*
+ * get the modifier from the keySym
+ */
+ nSyms = 0;
+ syms = XGetKeyboardMapping(dpy, ev.xkey.keycode, 1, &nSyms);
+ if (syms) {
+ int i;
+
+ for (i=0; i<nSyms; i++) {
+ if (syms[i] == keySym) {
+#ifdef MODIFIERDEBUG
+ console_printf("modifier-index is %d\n", i);
+#endif
+ if (i) state = (1 << (i-1));
+ break;
+ }
+ }
+ XFree(syms);
+ }
+ }
+ } else {
+ if ((typeSymbol == @symbol(buttonPress))
+ || (typeSymbol == @symbol(buttonRelease))) {
+ if (__isSmallInteger(keySymCodeOrButtonNr)) {
+ ev.xbutton.button = __intVal(keySymCodeOrButtonNr);
+ } else {
+ ev.xbutton.button = 1;
+ }
+ } else {
+ DPRINTF(("invalid sendEvent typeSymbol\n"));
+ RETURN (false);
+ }
+ }
+
+ if (typeSymbol == @symbol(keyPress))
+ ev.xany.type = KeyPress;
+ else if (typeSymbol == @symbol(keyRelease))
+ ev.xany.type = KeyRelease;
+ else if (typeSymbol == @symbol(buttonPress))
+ ev.xany.type = ButtonPress;
+ else if (typeSymbol == @symbol(buttonRelease))
+ ev.xany.type = ButtonRelease;
+
+ if (__isExternalAddress(targetId)) {
+ target = __WindowVal(targetId);
+ } else {
+ target = (Window) __longIntVal(targetId);
+ }
+ ev.xkey.window = target;
+ ev.xkey.same_screen = 1;
+ ev.xkey.subwindow = 0;
+ ev.xkey.root = RootWindow(dpy, screen);
+ ev.xkey.x = __intVal(xPos);
+ ev.xkey.y = __intVal(yPos);
+ ev.xkey.state = state;
+ ev.xkey.time = CurrentTime;
+
+ ENTER_XLIB();
+ result = XSendEvent(dpy, target, False, 0 , &ev);
+ LEAVE_XLIB();
+ if ((result == BadValue) || (result == BadWindow)) {
+ DPRINTF(("bad status\n"));
+ RETURN ( false )
+ }
+ RETURN (true)
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+! !
+
+!XWorkstation methodsFor:'font stuff'!
+
+createFontFor:aFontName
+ "a basic method for X-font allocation; this method allows
+ any font to be aquired (even those not conforming to
+ standard naming conventions, such as cursor, fixed or k14)"
+
+ <context: #return>
+
+%{ /* STACK: 100000 */
+ /*** UNLIMITEDSTACK */
+
+ XFontStruct *newFont;
+
+ if (ISCONNECTED
+ && __isStringLike(aFontName)) {
+
+ ENTER_XLIB();
+ newFont = XLoadQueryFont(myDpy, (char *)__stringVal(aFontName));
+ LEAVE_XLIB();
+#ifdef COUNT_RESOURCES
+ if (newFont)
+ __cnt_font++;
+#endif
+
+ RETURN ( newFont ? __MKEXTERNALADDRESS(newFont) : nil );
+ }
+%}.
+ "/ --- disabled due to UNLIMITEDSTACK -- self primitiveFailedOrClosedConnection.
+ ^ nil
+!
+
+decomposeXFontName:aString into:aBlock
+ "extract family, face, style and size from an
+ X-font name
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ -brand-family-face-style-moreStyle- -height-size-resX-resY-??-??-registry-encoding;
+ evaluate aBlock with these"
+
+ |family face style moreStyle fheight size
+ resX resY registry encoding coding fields|
+
+ aString isNil ifTrue:[^ false].
+ fields := aString asCollectionOfSubstringsSeparatedBy:$-.
+ fields size == 3 ifTrue:[
+ "take care of old font names: family-style-size"
+ family := fields at:1.
+ style := fields at:2.
+ size := Number readFromString:(fields at:3) onError:[^ false].
+ ] ifFalse:[fields size == 2 ifTrue:[
+ "take care of old font names: family-size"
+ family := fields at:1.
+ size := Number readFromString:(fields at:2) onError:[^ false].
+ ] ifFalse:[fields size >= 15 ifTrue:[
+ family := fields at:3.
+ face := fields at:4.
+ style := fields at:5.
+ style = 'o' ifTrue:[
+ style := 'oblique'
+ ] ifFalse:[style = 'i' ifTrue:[
+ style := 'italic'
+ ] ifFalse:[style = 'r' ifTrue:[
+ style := 'roman'
+ ]]].
+ moreStyle := fields at:6.
+ (moreStyle ~= 'normal' and:[moreStyle size > 1]) ifTrue:[
+ style := style, '-', moreStyle.
+ ].
+ fheight := fields at:8.
+ size := (Number readFromString:(fields at:9) onError:[^ false]) / 10.
+ resX := fields at:10.
+ resY := fields at:11.
+ registry := fields at:14.
+ encoding := fields at:15.
+ coding := registry , '-' , encoding.
+ ] ifFalse:[
+ ^ false
+ ]]].
+ aBlock value:family value:face value:style value:size value:coding.
+ ^ true
+!
+
+encodingOf:aFontId
+ "the fonts encoding - if the font does not provide that info,
+ return nil (and assume #ascii, which is a subset of #iso8859-1)."
+
+ |props reg enc coll|
+
+ props := self fontPropertiesOf:aFontId.
+ reg := props at:#'CHARSET_REGISTRY' ifAbsent:nil.
+ enc := props at:#'CHARSET_ENCODING' ifAbsent:nil.
+ coll := props at:#'CHARSET_COLLECTIONS' ifAbsent:nil.
+
+ reg notNil ifTrue:[ reg := self atomName:reg].
+ enc notNil ifTrue:[ enc := self atomName:enc].
+ coll notNil ifTrue:[ coll := self atomName:coll].
+
+ ^ self extractEncodingFromRegistry:reg encoding:enc charSetCollections:coll
+
+ "
+ Screen current encodingOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
+ "
+!
+
+extentsOf:aString from:index1 to:index2 inFont:aFontId into:anArray
+
+ <context: #return>
+
+%{ /* UNLIMITEDSTACK */
+
+ XFontStruct *f;
+ char *cp;
+ int len, n, i1, i2, l;
+# define NLOCALBUFFER 200
+ XChar2b xlatebuffer[NLOCALBUFFER];
+ int nInstBytes;
+ int directionReturn, fontAscentReturn, fontDescentReturn;
+ XCharStruct overAllReturn;
+ OBJ *resultArray;
+
+ if (ISCONNECTED
+ && __bothSmallInteger(index1, index2)
+ && __isExternalAddress(aFontId)
+ && __isNonNilObject(aString)) {
+ int lMax = __intVal(@global(MaxStringLength));
+ f = __FontVal(aFontId);
+ if (! f) goto fail;
+
+ if (__isArray(anArray) && __arraySize(anArray) > 0) {
+ resultArray = __arrayVal(anArray);
+ } else {
+ resultArray = 0;
+ }
+
+ i1 = __intVal(index1) - 1;
+
+ if (i1 >= 0) {
+ OBJ cls;
+
+ i2 = __intVal(index2) - 1;
+ if (i2 < i1) {
+ RETURN ( __MKSMALLINT(0) );
+ }
+
+ cp = (char *) __stringVal(aString);
+ l = i2 - i1 + 1;
+
+ if (__isStringLike(aString)) {
+ n = __stringSize(aString);
+ if (i2 >= n) goto fail;
+ cp += i1;
+ len = XTextExtents(f, cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ } else {
+ cls = __qClass(aString);
+ nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ cp += nInstBytes;
+ n = __byteArraySize(aString) - nInstBytes;
+
+ if (__isBytes(aString)) {
+ if (i2 >= n) goto fail;
+
+ cp += i1;
+ len = XTextExtents(f, cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ } else if (__isWords(aString)) { /* TWOBYTESTRINGS */
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2 = (XChar2b *)0;
+ int mustFree = 0;
+
+ n = n / 2;
+ if (i2 >= n) goto fail;
+
+ cp += (i1 * 2);
+ if (l > lMax) l = lMax;
+
+ /*
+ * ST/X TwoByteStrings store the asciiValue in native byteOrder;
+ * X expects them MSB first
+ * convert as required
+ */
+
+ u.s = 0x1234;
+ if (u.b[0] != 0x12) {
+ if (l <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(l * 2));
+ mustFree = 1;
+ }
+ for (i=0; i<l; i++) {
+ cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
+ cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
+ }
+ cp = (char *) cp2;
+ }
+
+ len = XTextExtents16(f, (XChar2b *)cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+
+ if (mustFree) {
+ free(cp2);
+ }
+ } else if (__isLongs(aString)) { /* FOURBYTESTRINGS */
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2 = (XChar2b *)0;
+ int mustFree = 0;
+
+ n = n / 4;
+ if (i2 >= n) goto fail;
+
+ cp += (i1 * 4);
+ if (l > lMax) l = lMax;
+
+ /*
+ * For now: X does not support 32bit characters without the new 32Unicode extensions.
+ * For now, treat chars above 0xFFFF as 0xFFFF (should we use default-char ?).
+ */
+ if (l <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(l * 2));
+ mustFree = 1;
+ }
+ for (i=0; i<l; i++) {
+ int codePoint;
+
+ codePoint = ((unsigned int32 *)cp)[i];
+ if (codePoint > 0xFFFF) {
+ codePoint = 0xFFFF;
+ }
+ cp2[i].byte1 = codePoint & 0xFF;
+ cp2[i].byte2 = (codePoint >> 8) & 0xFF;;
+ }
+ cp = (char *) cp2;
+
+ len = XTextExtents16(f, (XChar2b *)cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ if (mustFree) {
+ free(cp2);
+ }
+ } else
+ goto fail; /*unknown string class */
+ }
+ if (resultArray) {
+ switch (__arraySize(anArray)) {
+ default:
+ case 8:
+ resultArray[7] = __MKSMALLINT(directionReturn);
+ case 7:
+ resultArray[6] = __MKSMALLINT(fontDescentReturn);
+ case 6:
+ resultArray[5] = __MKSMALLINT(fontAscentReturn);
+ case 5:
+ resultArray[4] = __MKSMALLINT(overAllReturn.descent);
+ case 4:
+ resultArray[3] = __MKSMALLINT(overAllReturn.ascent);
+ case 3:
+ resultArray[2] = __MKSMALLINT(overAllReturn.width);
+ case 2:
+ resultArray[1] = __MKSMALLINT(overAllReturn.rbearing);
+ case 1:
+ resultArray[0] = __MKSMALLINT(overAllReturn.lbearing);
+ case 0:
+ break;
+ }
+ }
+ RETURN ( __MKSMALLINT(overAllReturn.width) );
+ }
+ }
+#undef NLOCALBUFFER
+fail: ;
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ 0
+
+ "
+ |result|
+ result := Array new:8.
+ Screen current
+ extentsOf:'hello World' from:1 to:11
+ inFont:(Screen current getFontWithFoundry:'*'
+ family:'courier new'
+ weight:'medium'
+ slant:'r'
+ spacing:nil
+ pixelSize:nil
+ size:10
+ encoding:#'iso10646-1'
+ )
+ into:result.
+
+ result
+ "
+!
+
+extractEncodingFromRegistry:registry encoding:encoding charSetCollections:charSetCollections
+ "given registry and encoding as returned by X11,
+ generate a single symbol naming the ST/X encoding.
+ I.e. from registry='ISO8859' and encoding='1', generate #'iso8859-1'.
+ This is pure magic ..."
+
+ |enc charSets|
+
+ (registry size ~~ 0) ifTrue:[
+ enc := registry asLowercase.
+ encoding size ~~ 0 ifTrue:[
+ enc := enc, '-', encoding asLowercase.
+ ].
+ enc := enc asSymbol.
+ ] ifFalse:[
+ (encoding size ~~ 0) ifTrue:[
+ enc := encoding asLowercase asSymbol
+ ] ifFalse:[
+ charSets := charSetCollections.
+ (charSets notEmptyOrNil) ifTrue:[
+ charSets := charSets asUppercase asCollectionOfWords.
+ (charSets includes:'ISO8859-1') ifTrue:[
+ enc := #'iso8859-1'
+ ] ifFalse:[
+ (charSets includes:'ISO8859') ifTrue:[
+ enc := #iso8859
+ ] ifFalse:[
+ (charSets includes:'ASCII') ifTrue:[
+ enc := #ascii
+ ] ifFalse:[
+ (charSets includes:'ADOBE-STANDARD') ifTrue:[
+ enc := #iso8859
+ ]
+ ]
+ ]
+ ]
+ ]
+ ]
+ ].
+ ^ enc
+
+ "Created: 17.4.1996 / 14:57:06 / cg"
+ "Modified: 17.4.1996 / 17:22:35 / cg"
+!
+
+flushListOfAvailableFonts
+ "flush the cached list of all available fonts on this display.
+ Required if new fonts have been added on the display server."
+
+ listOfXFonts := nil.
+ XftFontDescription notNil ifTrue:[
+ XftFontDescription flushListOfAvailableFonts.
+ ].
+
+ "
+ Display flushListOfAvailableFonts.
+ Display listOfAvailableFonts
+ "
+
+ "Modified: 27.9.1995 / 10:54:47 / stefan"
+ "Created: 20.2.1996 / 22:55:52 / cg"
+!
+
+fontDescriptionFromXFontName:aFontNameString
+ "extract family, face, style and size from an
+ X-font name
+ 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
+ -brand-family-face-style-moreStyle- -pxlSize-size-resX-resY-??-??-registry-encoding;
+ evaluate aBlock with these"
+
+ |family face style moreStyle size
+ resX resY registry encoding coding fields|
+
+ aFontNameString isNil ifTrue:[^ nil].
+
+ Error handle:[:ex |
+ family := nil.
+ ] do:[
+ fields := aFontNameString asCollectionOfSubstringsSeparatedBy:$-.
+ fields size == 3 ifTrue:[
+ "take care of old font names: family-style-size"
+ family := fields at:1.
+ style := fields at:2.
+ size := Number readFromString:(fields at:3).
+ ] ifFalse:[
+ fields size == 2 ifTrue:[
+ "take care of old font names: family-size"
+ family := fields at:1.
+ size := Number readFromString:(fields at:2).
+ ] ifFalse:[
+ fields size >= 15 ifTrue:[
+ family := fields at:3.
+ face := fields at:4.
+ style := fields at:5.
+ style = 'o' ifTrue:[
+ style := 'oblique'
+ ] ifFalse:[style = 'i' ifTrue:[
+ style := 'italic'
+ ] ifFalse:[style = 'r' ifTrue:[
+ style := 'roman'
+ ]]].
+ moreStyle := fields at:6.
+ (moreStyle ~= 'normal' and:[moreStyle size > 1]) ifTrue:[
+ style := style, '-', moreStyle.
+ ].
+"/ pxlSize := (Integer readFromString:(fields at:8)).
+ size := (Number readFromString:(fields at:9)) / 10.
+ resX := fields at:10.
+ resY := fields at:11.
+ registry := fields at:14.
+ encoding := fields at:15.
+ coding := registry , '-' , encoding.
+ ] ifFalse:[
+ "/ very old name (such as cursor, 5x7 etc)
+ ]
+ ]
+ ].
+ ].
+
+ family notNil ifTrue:[
+ ^ FontDescription family:family face:face style:style size:size sizeUnit:#pt encoding:coding.
+ ].
+ ^ FontDescription name:aFontNameString
+
+ "
+ Screen current fontDescriptionFromXFontName:'-arabic-newspaper-medium-r-normal--32-246-100-100-p-137-iso10646-1'
+ "
+!
+
+fontMetricsOf:fontId
+ "return a fonts metrics info object"
+
+ <context: #return>
+
+ |info avgAscent avgDescent minCode maxCode dir
+ maxAscent maxDescent minWidth maxWidth avgWidth|
+
+%{ /* UNLIMITEDSTACK */
+ XFontStruct *f;
+ int len;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(fontId)) {
+ f = __FontVal(fontId);
+ if (f) {
+ minCode = __MKUINT((f->min_byte1<<8) + f->min_char_or_byte2);
+ maxCode = __MKUINT((f->max_byte1<<8) + f->max_char_or_byte2);
+
+ if (f->direction == FontLeftToRight) {
+ dir = @symbol(LeftToRight);
+ } else if (f->direction == FontRightToLeft) {
+ dir = @symbol(RightToLeft);
+ }
+ avgAscent = __MKSMALLINT(f->ascent);
+ avgDescent = __MKSMALLINT(f->descent);
+ maxAscent = __MKSMALLINT(f->max_bounds.ascent);
+ maxDescent = __MKSMALLINT(f->max_bounds.descent);
+ minWidth = __MKSMALLINT(f->min_bounds.width);
+ maxWidth = __MKSMALLINT(f->max_bounds.width);
+
+ ENTER_XLIB();
+ len = XTextWidth(f, "n", 1);
+ LEAVE_XLIB();
+
+ avgWidth = __MKSMALLINT( len );
+ }
+ }
+ }
+%}.
+ avgAscent == nil ifTrue:[
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+ ].
+
+ "DingBats font returns 0 for maxAscent/maxDescent"
+ maxAscent := maxAscent max:avgAscent.
+ maxDescent := maxDescent max:avgDescent.
+
+ info := DeviceWorkstation::DeviceFontMetrics new.
+ info
+ ascent:avgAscent
+ descent:avgDescent
+ maxAscent:maxAscent
+ maxDescent:maxDescent
+ minWidth:minWidth
+ maxWidth:maxWidth
+ avgWidth:avgWidth
+ minCode:minCode
+ maxCode:maxCode
+ direction:dir.
+ ^ info
+
+ "
+ Screen current fontMetricsOf:(View defaultFont onDevice:Screen current) fontId
+ CharacterSetView openOn:(View defaultFont onDevice:Screen current)
+
+ Screen current fontMetricsOf:(MenuView defaultFont onDevice:Screen current) fontId
+ CharacterSetView openOn:(MenuView defaultFont onDevice:Screen current)
+ "
+!
+
+fontProperties:propertyNames of:aFontId
+ "Answer an array with selected property values of a font.
+ This is X11-Specific.
+ PropertyNames is an array with property names (symbols or strings).
+ Nonexistant properties are returned as nil"
+
+ |props|
+
+ props := self fontPropertiesOf:aFontId.
+ ^ propertyNames collect:[:propName | props at:propName ifAbsent:nil].
+
+ "
+ Screen current
+ fontProperties:#(#'PIXEL_SIZE' #'POINT_SIZE' RESOLUTION notExistant)
+ of:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
+ "
+!
+
+fontPropertiesOf:aFontId
+ "Answer an array with all the properties of a font.
+ This is X11-Specific.
+ Odd indices contain the property name (atom)
+ Even indices contain the property value (atom)
+
+ Answer nil, if there are no properties"
+
+ |propsArray result|
+
+%{
+ XFontStruct *f;
+ XFontProp *prop;
+ int n, i;
+ OBJ x;
+
+ if (__isExternalAddress(aFontId)) {
+ f = __FontVal(aFontId);
+ if (f && (prop = f->properties) != 0) {
+ n = f->n_properties;
+ propsArray = __ARRAY_NEW_INT(n*2);
+ for (i = 0; n; n--, prop++) {
+ x = __MKUINT(prop->name); __ArrayInstPtr(propsArray)->a_element[i++] = x; __STORE(propsArray, x);
+ x = __MKUINT(prop->card32); __ArrayInstPtr(propsArray)->a_element[i++] = x; __STORE(propsArray, x);
+ }
+ }
+ }
+%}.
+ result := Dictionary new.
+ propsArray notNil ifTrue:[
+ propsArray pairWiseDo:[:n :v | result at:(self atomName:n) put:v].
+ ].
+ ^ result
+
+ "
+ Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
+ Dictionary withKeysAndValues:(Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1'))
+
+ |d|
+ d := Dictionary new.
+ (Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')) keysAndValuesDo:[:name :value|
+ d at:name put:((Screen current atomName:value) ? value)
+ ].
+ d
+ "
+!
+
+fontResolutionOf:fontId
+ "return the resolution (as dpiX @ dpiY) of the font - this is usually the displays resolution,
+ but due to errors in some XServer installations, some use 75dpi fonts on higher
+ resolution displays and vice/versa."
+
+ |props res resX resY|
+
+ props := self fontProperties:#(#'RESOLUTION_X' #'RESOLUTION_Y' RESOLUTION) of:fontId.
+ resX := props at:1.
+ resY := props at:2.
+ (resX notNil and:[resY notNil]) ifTrue:[
+ ^ resX @ resY
+ ].
+ res := props at:3.
+ res notNil ifTrue:[
+ ^ res @ res
+ ].
+ ^ self resolution
+
+ "
+ Screen current fontResolutionOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
+ "
+!
+
+fullFontNameOf:aFontId
+ "the fonts fullName - this is very device specific and should only be
+ used for user feed-back (for example: in the fontPanel).
+ If the display/font does not provide that info, return nil."
+
+ |props fullName|
+
+ props := self fontPropertiesOf:aFontId.
+ #('FONT' 'FONT_NAME' 'FULL_NAME' 'FULLNAME' ) do:[:try |
+ |fullNameID|
+
+ fullNameID := props at:try ifAbsent:nil.
+ fullNameID notNil ifTrue:[
+ fullName := self atomName:fullNameID.
+ fullName notEmptyOrNil ifTrue:[
+ ^ fullName
+ ].
+ ]
+ ].
+
+ ^ nil.
+
+ "
+ Screen current fullFontNameOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
+ "
+!
+
+getAvailableFontsMatching:pattern
+ "return an Array filled with font names matching aPattern"
+
+ <context: #return>
+
+%{ /* UNLIMITEDSTACK */
+
+ int nnames = 30000;
+ int available = nnames + 1;
+ char **fonts;
+ OBJ arr, str;
+ int i;
+
+ if (ISCONNECTED) {
+ if (__isStringLike(pattern)) {
+ for (;;) {
+ ENTER_XLIB();
+ fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
+ LEAVE_XLIB();
+ if (fonts == 0) RETURN(nil);
+ if (available < nnames) break;
+ XFreeFontNames(fonts);
+ nnames = available * 2;
+ }
+
+ /*
+ * now, that we know the number of font names,
+ * create the array ...
+ */
+ arr = __ARRAY_NEW_INT(available);
+ if (arr != nil) {
+ /*
+ * ... and fill it
+ */
+ for (i=0; i<available; i++) {
+ __PROTECT__(arr);
+ str = __MKSTRING(fonts[i]);
+ __UNPROTECT__(arr);
+ __ArrayInstPtr(arr)->a_element[i] = str; __STORE(arr, str);
+ }
+ }
+ XFreeFontNames(fonts);
+ RETURN (arr);
+ }
+ }
+%}.
+ ^ nil
+
+ "
+ Screen current getAvailableFontsMatching:'*'
+ "
+!
+
+getDefaultFontWithEncoding:encoding
+ "return a default font id - used when class Font cannot
+ find anything usable"
+
+ |id|
+
+ id := self createFontFor:'-misc-fixed-*-*-*-*-*-*-*-*-*-*-', encoding.
+ id isNil ifTrue:[
+ id := self createFontFor:'fixed'
+ ].
+ ^ id.
+
+ "
+ Screen current getDefaultFontWithEncoding:#'iso10646-1'
+ "
+!
+
+getFontWithFamily:familyString face:faceString
+ style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encoding
+
+ "try to get the specified font, if not available, try next smaller
+ font. Access to X-fonts by name is possible, by passing the X font name
+ as family and the other parameters as nil. For example, the cursor font
+ can be aquired that way."
+
+ |styleString theName theId xlatedStyle
+ id spacing encodingMatch idx roundedSize pixelSize pointSize|
+
+ styleString := styleArgString.
+
+ sizeArgOrNil notNil ifTrue:[
+ roundedSize := sizeArgOrNil rounded asInteger.
+ sizeUnit == #px ifTrue:[
+ pixelSize := roundedSize.
+ ] ifFalse:[
+ pointSize := roundedSize.
+ ].
+ ].
+
+ "special: if face is nil, allow access to X-fonts"
+ faceString isNil ifTrue:[
+ roundedSize notNil ifTrue:[
+ theName := familyString , '-' , roundedSize printString
+ ] ifFalse:[
+ theName := familyString
+ ].
+ theName notNil ifTrue:[
+ theId := self createFontFor:theName.
+ ].
+ theId isNil ifTrue:[
+ theId := self getDefaultFontWithEncoding:encoding
+ ].
+ ^ theId
+ ].
+
+ "/ spacing other than 'normal' is contained as last component
+ "/ in style
+
+ (styleString notNil
+ and:[(styleString endsWith:'-narrow')
+ or:[styleString endsWith:'-semicondensed']]) ifTrue:[
+ |i|
+ i := styleString lastIndexOf:$-.
+ spacing := styleString copyFrom:(i+1).
+ styleString := styleString copyTo:(i-1).
+ ] ifFalse:[
+ spacing := 'normal'.
+ ].
+
+ xlatedStyle := styleString.
+ xlatedStyle notNil ifTrue:[
+ xlatedStyle := xlatedStyle first asString
+ ].
+
+ encoding isNil ifTrue:[
+ encodingMatch := '*-*'.
+ ] ifFalse:[
+ idx := encoding indexOf:$-.
+ idx ~~ 0 ifTrue:[
+ encodingMatch := encoding
+ ] ifFalse:[
+ encodingMatch := encoding , '-*'.
+ ].
+ ].
+
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:pixelSize
+ size:pointSize
+ encoding:encodingMatch.
+
+ id isNil ifTrue:[
+ (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[
+ "/ too stupid: registries come in both cases
+ "/ and X does not ignore case
+ "/
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:roundedSize
+ encoding:encodingMatch asUppercase.
+ id isNil ifTrue:[
+ id := self
+ getFontWithFoundry:'*'
+ family:familyString asLowercase
+ weight:faceString
+ slant:xlatedStyle
+ spacing:spacing
+ pixelSize:nil
+ size:roundedSize
+ encoding:encodingMatch asLowercase.
+ ]
+ ]
+ ].
+ ^ id
+
+ "Modified: 4.7.1996 / 11:38:47 / stefan"
+ "Modified: 10.4.1997 / 19:20:06 / cg"
+!
+
+getFontWithFoundry:foundry family:family weight:weight
+ slant:slant spacing:spc pixelSize:pSize size:size
+ encoding:encoding
+
+ "get the specified font, if not available, return nil.
+ 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)
+ encoding: iso8859-*, iso8859-1, iso10646-1 ... '*'
+ "
+
+ |theName sizeMatch
+ foundryMatch familyMatch weightMatch slantMatch spcMatch
+ pSizeMatch encodingMatch|
+
+ "this works only on 'Release >= 3' - X-servers"
+ "name is:
+ -foundry-family -weight -slant-
+ sony helvetica bold r
+ adobe courier medium i
+ msic fixed o
+ ... ...
+ "
+
+ size isNil ifTrue:[
+ sizeMatch := '*'
+ ] ifFalse:[
+ sizeMatch := size printString , '0'
+ ].
+ foundry isNil ifTrue:[
+ foundryMatch := '*'
+ ] ifFalse:[
+ foundryMatch := foundry
+ ].
+ family isNil ifTrue:[
+ familyMatch := '*'
+ ] ifFalse:[
+ familyMatch := family
+ ].
+ weight isNil ifTrue:[
+ weightMatch := '*'
+ ] ifFalse:[
+ weightMatch := weight
+ ].
+ slant isNil ifTrue:[
+ slantMatch := '*'
+ ] ifFalse:[
+ slantMatch := slant
+ ].
+ spc isNil ifTrue:[
+ spcMatch := '*'
+ ] ifFalse:[
+ spcMatch := spc
+ ].
+ pSize isNil ifTrue:[
+ pSizeMatch := '*'
+ ] ifFalse:[
+ pSizeMatch := pSize printString
+ ].
+ encoding isNil ifTrue:[
+ encodingMatch := '*'
+ ] ifFalse:[
+ encodingMatch := encoding
+ ].
+
+ theName := ('-' , foundryMatch,
+ '-' , familyMatch,
+ '-' , weightMatch ,
+ '-' , slantMatch ,
+ '-' , spcMatch ,
+ '-*' ,
+ '-' , pSizeMatch ,
+ '-' , sizeMatch ,
+ '-*-*-*-*' ,
+ '-' , encodingMatch).
+
+"/ Transcript showCR:theName; endEntry.
+
+ ^ self createFontFor:theName.
+
+
+ "
+ Display
+ getFontWithFoundry:'*'
+ family:'courier'
+ weight:'medium'
+ slant:'r'
+ spacing:nil
+ pixelSize:nil
+ size:13
+ encoding:#'iso8859-1'.
+
+ Display
+ getFontWithFoundry:'*'
+ family:'courier'
+ weight:'medium'
+ slant:'r'
+ spacing:nil
+ pixelSize:nil
+ size:13
+ encoding:#'iso10646-1'
+ "
+
+ "Modified: 10.4.1997 / 19:15:44 / cg"
+!
+
+heightOf:aString from:index1 to:index2 inFont:aFontId
+ |resultArray|
+
+ resultArray := Array new:5.
+ self extentsOf:aString from:index1 to:index2 inFont:aFontId into:resultArray.
+ ^ (resultArray at:4) + (resultArray at:5).
+
+ "
+ Screen current
+ heightOf:'hello world' from:1 to:10
+ inFont:(Screen current getFontWithFoundry:'*'
+ family:'courier new'
+ weight:'medium'
+ slant:'r'
+ spacing:nil
+ pixelSize:nil
+ size:13
+ encoding:#'iso10646-1'
+ ).
+
+ Screen current
+ heightOf:'hello World gggÖÜ' from:1 to:15
+ inFont:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
+ "
+!
+
+listOfAvailableFonts
+ "return a list with all available fonts on this display.
+ Since this takes some time, keep the result of the query for the
+ next time. The elements of the returned collection are instances of
+ FontDescription."
+
+ |names|
+
+ listOfXFonts isNil ifTrue:[
+ names := self getAvailableFontsMatching:'*'.
+ names isNil ifTrue:[
+ "no names returned ..."
+ ^ nil
+ ].
+ listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
+ listOfXFonts := FontDescription genericFonts, listOfXFonts.
+ ].
+
+ (XftFontDescription notNil
+ and:[ XftFontDescription isLoaded
+ and:[ true "self queryXftLibrary" ]]
+ ) ifTrue:[
+ UserPreferences current useXftFontsOnly ifTrue:[
+ ^ (XftFontDescription listOfAvailableFonts)
+ ].
+ ^ listOfXFonts , (XftFontDescription listOfAvailableFonts).
+ ].
+ ^ listOfXFonts
+
+ "
+ Display flushListOfAvailableFonts.
+ Display listOfAvailableFonts.
+
+ Display getAvailableFontsMatching:'*'.
+ Display getAvailableFontsMatching:'fixed'.
+ Display fontsInFamily:'fixed' filtering:nil.
+ "
+
+ "Modified: 27.9.1995 / 10:54:47 / stefan"
+ "Modified: 17.4.1996 / 15:27:57 / cg"
+!
+
+pixelSizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
+ "return a set of all available font sizes in aFamily/aFace/aStyle
+ on this display.
+ Redefined to handle X's special case of 0-size (which stands for any)"
+
+ |sizes|
+
+ sizes := super pixelSizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
+ (sizes notNil and:[sizes isEmpty or:[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 72 96 144 192 288)
+ ].
+ ^ sizes
+
+ "
+ Display pixelSizesInFamily:'courier' face:'bold' style:'roman' filtering:nil
+ "
+
+ "Created: 27.2.1996 / 01:38:15 / cg"
+!
+
+releaseFont:aFontId
+
+ <context: #return>
+%{
+ XFontStruct *f;
+
+ /*
+ * ignore closed connection
+ */
+ if (! ISCONNECTED) {
+ RETURN ( self );
+ }
+
+ if (__isExternalAddress(aFontId)) {
+ f = __FontVal(aFontId);
+ if (f) {
+
+ ENTER_XLIB();
+ XFreeFont(myDpy, f);
+ LEAVE_XLIB();
+#ifdef COUNT_RESOURCES
+ __cnt_font--;
+#endif
+ }
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+!
+
+sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
+ "return a set of all available font sizes in aFamily/aFace/aStyle
+ on this display.
+ Redefined to handle X's special case of 0-size (which stands for any)"
+
+ |sizes|
+
+ sizes := super sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
+ (sizes notNil and:[sizes includes:0]) ifTrue:[
+ "special: in X11R5 and above, size 0 means:
+ there are scaled versions in all sizes available"
+
+ ^ #(4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 20 22 24 28 32 48 64 72 96 144 192 288)
+ ].
+ ^ sizes
+
+ "
+ Display sizesInFamily:'courier' face:'bold' style:'roman' filtering:nil
+ "
+
+ "Created: 27.2.1996 / 01:38:15 / cg"
+!
+
+widthOf:aString from:index1 to:index2 inFont:aFontId
+
+ <context: #return>
+
+%{ /* UNLIMITEDSTACK */
+
+ XFontStruct *f;
+ char *cp;
+ int len, n, i1, i2, l;
+# define NLOCALBUFFER 200
+ XChar2b xlatebuffer[NLOCALBUFFER];
+ int nInstBytes;
+ int directionReturn, fontAscentReturn, fontDescentReturn;
+ XCharStruct overAllReturn;
+
+ if (ISCONNECTED) {
+ if (__bothSmallInteger(index1, index2)
+ && __isExternalAddress(aFontId)
+ && __isNonNilObject(aString)) {
+ int lMax = __intVal(@global(MaxStringLength));
+ f = __FontVal(aFontId);
+ if (! f) goto fail;
+
+ i1 = __intVal(index1) - 1;
+
+ if (i1 >= 0) {
+ OBJ cls;
+
+ i2 = __intVal(index2) - 1;
+ if (i2 < i1) {
+ RETURN ( __MKSMALLINT(0) );
+ }
+
+ cp = (char *) __stringVal(aString);
+ l = i2 - i1 + 1;
+
+ if (__isStringLike(aString)) {
+ n = __stringSize(aString);
+ if (i2 < n) {
+ cp += i1;
+
+#if 1
+ len = XTextExtents(f, cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ //console_printf("lBear:%d rBear:%d width:%d\n", overAllReturn.lbearing, overAllReturn.rbearing, overAllReturn.width);
+ RETURN ( __MKSMALLINT(overAllReturn.width) );
+#else
+ ENTER_XLIB();
+ len = XTextWidth(f, cp, l);
+ LEAVE_XLIB();
+ RETURN ( __MKSMALLINT(len) );
+#endif
+ }
+ }
+
+ cls = __qClass(aString);
+ nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
+ cp += nInstBytes;
+
+ if (__isBytes(aString)) {
+ n = __byteArraySize(aString) - nInstBytes;
+ if (i2 < n) {
+ cp += i1;
+
+#if 1
+ len = XTextExtents(f, cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ RETURN ( __MKSMALLINT(overAllReturn.width) );
+#else
+ ENTER_XLIB();
+ len = XTextWidth(f, cp, l);
+ LEAVE_XLIB();
+ RETURN ( __MKSMALLINT(len) );
+#endif
+ }
+ }
+
+ /* TWOBYTESTRINGS */
+ if (__isWords(aString)) {
+ n = (__byteArraySize(aString) - nInstBytes) / 2;
+
+ if (i2 < n) {
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2 = (XChar2b *)0;
+ int mustFree = 0;
+
+ cp += (i1 * 2);
+ if (l > lMax) l = lMax;
+
+ /*
+ * ST/X TwoByteStrings store the asciiValue in native byteOrder;
+ * X expects them MSB first
+ * convert as required
+ */
+
+ u.s = 0x1234;
+ if (u.b[0] != 0x12) {
+ if (l <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(l * 2));
+ mustFree = 1;
+ }
+ for (i=0; i<l; i++) {
+ cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
+ cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
+ }
+ cp = (char *) cp2;
+ }
+
+#if 1
+ len = XTextExtents16(f, (XChar2b *)cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ len = overAllReturn.width;
+#else
+ ENTER_XLIB();
+ len = XTextWidth16(f, (XChar2b *)cp, l);
+ LEAVE_XLIB();
+#endif
+
+ if (mustFree) {
+ free(cp2);
+ }
+
+ RETURN ( __MKSMALLINT(len) );
+ }
+ }
+ /* FOURBYTESTRINGS */
+ if (__isLongs(aString)) {
+ int i;
+ XChar2b *cp2;
+ int mustFree = 0;
+
+ n = (__byteArraySize(aString) - nInstBytes) / 4;
+ if (i2 < n) {
+ union {
+ char b[2];
+ unsigned short s;
+ } u;
+ int i;
+ XChar2b *cp2 = (XChar2b *)0;
+ int mustFree = 0;
+
+ cp += (i1 * 4);
+ if (l > lMax) l = lMax;
+
+ /*
+ * For now: X does not support 32bit characters without the new 32Unicode extensions.
+ * For now, treat chars above 0xFFFF as 0xFFFF (should we use default-char ?).
+ */
+ if (l <= NLOCALBUFFER) {
+ cp2 = xlatebuffer;
+ } else {
+ cp2 = (XChar2b *)(malloc(l * 2));
+ mustFree = 1;
+ }
+ for (i=0; i<l; i++) {
+ int codePoint;
+
+ codePoint = ((unsigned int32 *)cp)[i];
+ if (codePoint > 0xFFFF) {
+ codePoint = 0xFFFF;
+ }
+ cp2[i].byte1 = codePoint & 0xFF;
+ cp2[i].byte2 = (codePoint >> 8) & 0xFF;;
+ }
+ cp = (char *) cp2;
+
+#if 1
+ len = XTextExtents16(f, (XChar2b *)cp, l,
+ &directionReturn, &fontAscentReturn, &fontDescentReturn,
+ &overAllReturn);
+ len = overAllReturn.width;
+#else
+ ENTER_XLIB();
+ len = XTextWidth16(f, (XChar2b *)cp, l);
+ LEAVE_XLIB();
+#endif
+
+ if (mustFree) {
+ free(cp2);
+ }
+
+ RETURN ( __MKSMALLINT(len) );
+ }
+ }
+ }
+ }
+ }
+#undef NLOCALBUFFER
+fail: ;
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ 0
+! !
+
+!XWorkstation methodsFor:'grabbing'!
+
+allowEvents:mode
+ <context: #return>
+%{
+
+ 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
+ && ISCONNECTED) {
+ ENTER_XLIB();
+ XAllowEvents(myDpy, _mode, CurrentTime);
+ LEAVE_XLIB();
+
+ RETURN (self);
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+grabKeyboardIn:aWindowId
+ "grab the keyboard"
+
+ <context: #return>
+%{
+ int result, ok;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aWindowId)) {
+
+ ENTER_XLIB();
+ result = XGrabKeyboard(myDpy,
+ __WindowVal(aWindowId),
+ True /* False */,
+ GrabModeAsync,
+ GrabModeAsync,
+ CurrentTime);
+ LEAVE_XLIB();
+
+ ok = 0;
+ switch(result) {
+ case AlreadyGrabbed:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: AlreadyGrabbed\n");
+ }
+ break;
+ case GrabNotViewable:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: GrabNotViewable\n");
+ }
+ break;
+ case GrabInvalidTime:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: InvalidTime\n");
+ }
+ break;
+ case GrabFrozen:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: Frozen\n");
+ }
+ break;
+ default:
+ ok = 1;
+ break;
+ }
+ if (! ok) {
+ ENTER_XLIB();
+ XUngrabKeyboard(myDpy, CurrentTime);
+ LEAVE_XLIB();
+ RETURN (false);
+ }
+
+ RETURN ( true );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+!
+
+grabPointerIn:aWindowId withCursor:aCursorId eventMask:eventMask pointerMode:pMode keyboardMode:kMode confineTo:confineId
+ "grap the pointer - return true if ok"
+
+ <context: #return>
+%{
+
+ int result, ok, evMask;
+ Window confineWin;
+ Cursor curs;
+ int pointer_mode, keyboard_mode;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aWindowId)) {
+ if (__isExternalAddress(confineId))
+ confineWin = __WindowVal(confineId);
+ else
+ confineWin = (Window) None;
+
+ if (__isExternalAddress(aCursorId))
+ curs = __CursorVal(aCursorId);
+ else
+ curs = (Cursor) None;
+
+ if (pMode == @symbol(sync))
+ pointer_mode = GrabModeSync;
+ else
+ pointer_mode = GrabModeAsync;
+
+ if (kMode == @symbol(sync))
+ keyboard_mode = GrabModeSync;
+ else
+ keyboard_mode = GrabModeAsync;
+
+ if (__isSmallInteger(eventMask))
+ evMask = __intVal(eventMask);
+ else
+ evMask = ButtonPressMask | ButtonMotionMask | PointerMotionMask | ButtonReleaseMask;
+
+
+/*
+ ENTER_XLIB();
+*/
+ result = XGrabPointer(myDpy,
+ __WindowVal(aWindowId),
+ False,
+ evMask,
+ pointer_mode, keyboard_mode,
+ confineWin,
+ curs,
+ CurrentTime);
+/*
+ LEAVE_XLIB();
+*/
+
+
+ ok = 0;
+ switch (result) {
+ case AlreadyGrabbed:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab pointer: AlreadyGrabbed\n");
+ }
+ break;
+ case GrabNotViewable:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab pointer: GrabNotViewable\n");
+ }
+ break;
+ case GrabInvalidTime:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab pointer: InvalidTime\n");
+ }
+ break;
+ case GrabFrozen:
+ if (@global(ErrorPrinting) == true) {
+ console_fprintf(stderr, "XWorkstation [warning]: grab pointer: Frozen\n");
+ }
+ break;
+ default:
+ ok = 1;
+ break;
+ }
+
+ if (! ok) {
+/*
+ ENTER_XLIB();
+*/
+ XUngrabPointer(myDpy, CurrentTime);
+/*
+ LEAVE_XLIB();
+*/
+ RETURN (false);
+ }
+ RETURN ( true );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+!
+
+grabPointerIn:aWindowId withCursor:aCursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
+ "grap the pointer - return true if ok"
+
+ ^ self
+ grabPointerIn:aWindowId
+ withCursor:aCursorId
+ eventMask:nil
+ pointerMode:pMode
+ keyboardMode:kMode
+ confineTo:confineId
+
+ "Modified: / 28.7.1998 / 02:47:51 / cg"
+!
+
+primUngrabKeyboard
+ "release the keyboard"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ ENTER_XLIB();
+ XUngrabKeyboard(dpy, CurrentTime);
+ XSync(dpy, 0);
+ LEAVE_XLIB();
+
+ }
+%}.
+!
+
+primUngrabPointer
+ "release the pointer"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ ENTER_XLIB();
+ XUngrabPointer(dpy, CurrentTime);
+ XSync(dpy, 0);
+ LEAVE_XLIB();
+
+ }
+%}.
+!
+
+ungrabKeyboard
+ "release the keyboard"
+
+ activeKeyboardGrab notNil ifTrue:[
+ activeKeyboardGrab := nil.
+ self primUngrabKeyboard.
+ ]
+!
+
+ungrabPointer
+ "release the pointer"
+
+ activePointerGrab notNil ifTrue:[
+ activePointerGrab := nil.
+ self primUngrabPointer.
+ ]
+! !
+
+!XWorkstation methodsFor:'graphic context stuff'!
+
+noClipIn:aDrawableId gc:aGCId
+ "disable clipping rectangle"
+
+ <context: #return>
+%{
+
+ XGCValues gcv;
+ GC gc;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)) {
+ gc = __GCVal(aGCId);
+ gcv.clip_mask = None;
+ ENTER_XLIB();
+ XChangeGC(myDpy, gc, GCClipMask, &gcv);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setBackground:bgColorIndex in:aGCId
+ "set background color to be drawn with"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)
+ && __isSmallInteger(bgColorIndex)) {
+ ENTER_XLIB();
+ XSetBackground(myDpy, __GCVal(aGCId), __intVal(bgColorIndex));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setBitmapMask:aBitmapId in:aGCId
+ "set or clear the drawing mask - a bitmap mask using current fg/bg"
+
+ <context: #return>
+%{
+
+ GC gc;
+ Pixmap bitmap;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ if (__isExternalAddress(aGCId)) {
+ gc = __GCVal(aGCId);
+ if (__isExternalAddress(aBitmapId)) {
+ bitmap = __PixmapVal(aBitmapId);
+ ENTER_XLIB();
+ XSetStipple(dpy, gc, bitmap);
+ XSetFillStyle(dpy, gc, FillOpaqueStippled);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ if (aBitmapId == nil) {
+ ENTER_XLIB();
+ XSetFillStyle(dpy, gc, FillSolid);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setClipByChildren:aBool in:aDrawableId gc:aGCId
+ "enable/disable drawing into child views"
+
+ <context: #return>
+%{
+
+ XGCValues gcv;
+ GC gc;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)) {
+ gc = __GCVal(aGCId);
+ if (aBool == true)
+ gcv.subwindow_mode = ClipByChildren;
+ else
+ gcv.subwindow_mode = IncludeInferiors;
+
+ ENTER_XLIB();
+ XChangeGC(myDpy, gc, GCSubwindowMode, &gcv);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setClipX:clipX y:clipY width:clipWidth height:clipHeight in:drawableId gc:aGCId
+ "clip to a rectangle"
+
+ <context: #return>
+%{
+
+ XRectangle r;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)
+ && __bothSmallInteger(clipX, clipY)
+ && __bothSmallInteger(clipWidth, clipHeight)) {
+ r.x = __intVal(clipX);
+ r.y = __intVal(clipY);
+ r.width = __intVal(clipWidth);
+ r.height = __intVal(clipHeight);
+ ENTER_XLIB();
+ XSetClipRectangles(myDpy, __GCVal(aGCId), 0, 0, &r, 1, Unsorted);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setDashes:dashList dashOffset:offset in:aGCId
+ "set line attributes"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)
+ && __isSmallInteger(offset)
+ && __isByteArrayLike(dashList)) {
+ ENTER_XLIB();
+ XSetDashes(myDpy, __GCVal(aGCId),
+ __intVal(offset),
+ __ByteArrayInstPtr(dashList)->ba_element,
+ __byteArraySize(dashList));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+bad: ;
+%}.
+ "
+ either aGCId is invalid,
+ and/or dashList is not a byteArray
+ and/or offset is not a smallInteger
+ "
+ self primitiveFailedOrClosedConnection
+!
+
+setFont:aFontId in:aGCId
+ "set font to be drawn in"
+
+ <context: #return>
+%{
+
+ XFontStruct *f;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aFontId)
+ && __isExternalAddress(aGCId)) {
+ f = (XFontStruct *) __FontVal(aFontId);
+ ENTER_XLIB();
+ XSetFont(myDpy, __GCVal(aGCId), f->fid);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ "
+ aGCId and/or aFontId are invalid
+ "
+ self primitiveFailedOrClosedConnection
+!
+
+setForeground:fgColorIndex background:bgColorIndex in:aGCId
+ "set foreground and background colors to be drawn with"
+
+ <context: #return>
+%{
+
+ GC gc;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+ if (__bothSmallInteger(fgColorIndex, bgColorIndex)
+ && __isExternalAddress(aGCId)) {
+ gc = __GCVal(aGCId);
+
+ ENTER_XLIB();
+ XSetForeground(dpy, gc, __intVal(fgColorIndex));
+ XSetBackground(dpy, gc, __intVal(bgColorIndex));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setForeground:fgColorIndex in:aGCId
+ "set foreground color to be drawn with"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)
+ && __isSmallInteger(fgColorIndex)) {
+ ENTER_XLIB();
+ XSetForeground(myDpy, __GCVal(aGCId), __intVal(fgColorIndex));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setFunction:aFunctionSymbol in:aGCId
+ "set alu function to be drawn with"
+
+ <context: #return>
+%{
+
+ GC gc;
+ int fun = -1;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)) {
+ gc = __GCVal(aGCId);
+ if (aFunctionSymbol == @symbol(copy)) fun = GXcopy;
+ else if (aFunctionSymbol == @symbol(copyInverted)) fun = GXcopyInverted;
+ else if (aFunctionSymbol == @symbol(xor)) fun = GXxor;
+ else if (aFunctionSymbol == @symbol(and)) fun = GXand;
+ else if (aFunctionSymbol == @symbol(andReverse)) fun = GXandReverse;
+ else if (aFunctionSymbol == @symbol(andInverted)) fun = GXandInverted;
+ else if (aFunctionSymbol == @symbol(or)) fun = GXor;
+ else if (aFunctionSymbol == @symbol(orReverse)) fun = GXorReverse;
+ else if (aFunctionSymbol == @symbol(orInverted)) fun = GXorInverted;
+ else if (aFunctionSymbol == @symbol(invert)) fun = GXinvert;
+ else if (aFunctionSymbol == @symbol(clear)) fun = GXclear;
+ else if (aFunctionSymbol == @symbol(set)) fun = GXset;
+ else if (aFunctionSymbol == @symbol(noop)) fun = GXnoop;
+ else if (aFunctionSymbol == @symbol(equiv)) fun = GXequiv;
+ else if (aFunctionSymbol == @symbol(nand)) fun = GXnand;
+ if (fun != -1) {
+ ENTER_XLIB();
+ XSetFunction(myDpy, gc, fun);
+ LEAVE_XLIB();
+ 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 primitiveFailedOrClosedConnection
+!
+
+setGraphicsExposures:aBoolean in:aGCId
+ "set or clear the graphics exposures flag"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)) {
+ ENTER_XLIB();
+ XSetGraphicsExposures(myDpy, __GCVal(aGCId), (aBoolean==true)?1:0);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
+ "set line attributes;
+ lineStyle must be one of #solid, #dashed or #doubleDashed;
+ capStyle one of: #notLast, #butt, #round or #projecting;
+ joinStyle one of: #miter, #bevel or #round."
+
+ <context: #return>
+%{
+
+ int x_style, x_cap, x_join;
+ static char dashList[2] = { 4,4 };
+ static char dotList[2] = { 1,1 };
+ static char dashDotList[4] = { 4,1 , 1,1 };
+ static char dashDotDotList[6] = { 4,1 , 1,1 , 1,1 };
+ char *x_dashes = 0;
+ int x_nDash;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aGCId)
+ && __isSmallInteger(aNumber)) {
+ Display *dpy = myDpy;
+
+ if (lineStyle == @symbol(solid)) {
+ x_dashes = (char *)0;
+ x_style = LineSolid;
+ } else if (lineStyle == @symbol(dashed)) {
+ x_dashes = dashList;
+ x_nDash = sizeof(dashList);
+ x_style = LineOnOffDash;
+ } else if (lineStyle == @symbol(doubleDashed)) {
+ x_dashes = dashList;
+ x_nDash = sizeof(dashList);
+ x_style = LineDoubleDash;
+ } else if (lineStyle == @symbol(dotted)) {
+ x_dashes = dotList;
+ x_nDash = sizeof(dotList);
+ x_style = LineOnOffDash;
+ } else if (lineStyle == @symbol(dashDot)) {
+ x_dashes = dashDotList;
+ x_nDash = sizeof(dashDotList);
+ x_style = LineOnOffDash;
+ } else if (lineStyle == @symbol(dashDotDot)) {
+ x_dashes = dashDotDotList;
+ x_nDash = sizeof(dashDotDotList);
+ x_style = LineOnOffDash;
+ } 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;
+
+ ENTER_XLIB();
+ if (x_dashes) {
+ XSetDashes(dpy, __GCVal(aGCId), 0, x_dashes, x_nDash);
+ }
+ XSetLineAttributes(dpy,
+ __GCVal(aGCId), __intVal(aNumber),
+ x_style, x_cap, x_join);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+bad: ;
+%}.
+ "
+ either aGCId is invalid,
+ and/or lineWidth is not a smallInteger,
+ and/or lineStyle is none of #solid, #dashed, #doubleDashed
+ and/or capStyle is none of #notLast, #butt, #round, #projecting
+ and/or joinStyle is none of #miter, #bevel, #round
+ "
+ self primitiveFailedOrClosedConnection
+!
+
+setMaskOriginX:orgX y:orgY in:aGCid
+ "set the mask origin"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ if (__bothSmallInteger(orgX, orgY) && __isExternalAddress(aGCid)) {
+ ENTER_XLIB();
+ XSetTSOrigin(myDpy, __GCVal(aGCid), __intVal(orgX), __intVal(orgY));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setPixmapMask:aPixmapId in:aGCId
+ "set or clear the drawing mask - a pixmap mask providing full color"
+
+ <context: #return>
+%{
+
+ GC gc;
+ Pixmap pixmap;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ if (__isExternalAddress(aGCId)) {
+ gc = __GCVal(aGCId);
+ if (__isExternalAddress(aPixmapId)) {
+ pixmap = __PixmapVal(aPixmapId);
+ ENTER_XLIB();
+ XSetTile(dpy, gc, pixmap);
+ XSetFillStyle(dpy, gc, FillTiled);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ if (aPixmapId == nil) {
+ ENTER_XLIB();
+ XSetFillStyle(dpy, gc, FillSolid);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+! !
+
+!XWorkstation methodsFor:'initialization & release'!
+
+closeConnection
+ "close down the connection to the X-server"
+
+ <context: #return>
+
+"/ 'closing' errorPrintCR.
+"/ thisContext fullPrintAll.
+
+%{ /* UNLIMITEDSTACK */ /* calls XSync()! */
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+
+ __INST(displayId) = nil;
+ ENTER_XLIB();
+ XCloseDisplay(dpy);
+ LEAVE_XLIB();
+ }
+%}
+!
+
+emergencyCloseConnection
+ "low level close of the displays connection (without sending any buffered
+ requests to the display). Only used in case of emergency (brokenConnection)"
+
+%{
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ __INST(displayId) = nil;
+ close(ConnectionNumber(dpy));
+ }
+%}
+!
+
+eventBufferSize
+%{
+ RETURN ( __MKSMALLINT(sizeof(XEvent) + 100) );
+%}
+!
+
+getWindowGroupWindow
+ "Creates a fake WindowGroup view. This window is used
+ in XWMHints & _NET_WM_LEADER properties to define
+ application window group"
+
+ windowGroupWindow isNil ifTrue:[
+ windowGroupWindow := WindowGroupWindow new create.
+ ].
+ ^ windowGroupWindow
+!
+
+initializeDefaultValues
+ activateOnClick := false.
+ maxOperationsUntilFlush := nil.
+
+ super initializeDefaultValues.
+
+ "JV@2012: On X11, mouse buttons are: left=1, middle=2, right=3
+ Even on 2-button mouse (button 2 is simply not reported).
+ Here the middle button is mapped to button #paste (which in EditTextView
+ pastes the PRIMARY selection). 128 is here to make clear that this
+ is somewhat special value.
+
+ This remapping kludge is here to have all the widget's code backward/windows
+ compatible while still having X11's middle button behavior.
+
+ Also note, that buttonTranslation is overwritten in display.rc,
+ the code is here just for a case display.rc is not read/available
+ and for documentation (symbol references does not search .rc files).
+ "
+
+ buttonTranslation := buttonTranslation copy.
+ buttonTranslation at: 2 put: #paste
+
+ "Modified (comment): / 17-04-2012 / 21:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+initializeDeviceSignals
+ super initializeDeviceSignals.
+
+ deviceIOTimeoutErrorSignal := deviceIOErrorSignal newSignal.
+ deviceIOTimeoutErrorSignal nameClass:self message:#deviceIOTimeoutErrorSignal.
+
+ ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayError.
+ ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOError.
+ ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOTimeoutError.
+!
+
+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"
+
+ displayId notNil ifTrue:[
+ "/ already connected - you bad guy try to trick me manually ?
+ ^ self
+ ].
+
+ displayId := self openConnectionTo:aDisplayName.
+ displayId isNil ifTrue:[
+ "/ could not connect.
+ DeviceOpenErrorSignal raiseWith:aDisplayName.
+ ^ nil
+ ].
+
+ xlibTimeout := xlibTimeout ? DefaultXLibTimeout.
+ xlibTimeoutForWindowCreation := xlibTimeoutForWindowCreation ? DefaultXLibTimeoutForWindowCreation.
+ hasConnectionBroken := false.
+
+ dispatching := false.
+ dispatchingExpose := false.
+ isSlow := false.
+ shiftDown := false.
+ ctrlDown := false.
+ metaDown := false.
+ altDown := false.
+ motionEventCompression := true.
+ buttonsPressed := 0.
+ displayName := aDisplayName.
+
+ listOfXFonts := nil.
+
+ atoms := nil.
+
+ "These values are initialized by primitive code in #createWindowFor:..."
+ protocolsAtom := nil.
+ deleteWindowAtom := nil.
+ saveYourselfAtom := nil.
+ quitAppAtom := nil.
+
+ self initializeDeviceResourceTables.
+ self initializeScreenProperties.
+
+ self initializeDefaultValues.
+ self initializeSpecialFlags.
+ self initializeKeyboardMap.
+ self initializeDeviceSignals.
+
+ self initializeViewStyle.
+!
+
+initializeModifierMappings
+ "initialize keyboard modifiers.
+ We assume that mod1 are the META modifiers and mod2 are the ALT modifiers,
+ but if any of them contains the Num_Lock key, it is disregarded."
+
+ |map|
+
+ super initializeModifierMappings.
+
+ rawKeySymTranslation := RawKeySymTranslation.
+
+ map := self modifierMapping.
+ map isNil ifTrue:[
+ "/
+ "/ mhmh - a crippled Xlib which does not provide modifier mappings
+ "/ setup some reasonable default. If that is not sufficient,
+ "/ you have to change things from your display.rc file.
+ "/
+ altModifierMask := self modifier1Mask.
+ metaModifierMask := self modifier2Mask.
+ ] ifFalse:[
+ | mod symbolFromKeyCode nonNilOnes |
+
+ altModifierMask := 0.
+ metaModifierMask := 0.
+
+ symbolFromKeyCode := [:key | self symbolFromKeycode:key].
+ nonNilOnes := [:str | str notNil].
+
+ mod := map at:1.
+ mod notNil ifTrue:[
+ shiftModifiers := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
+ ].
+ mod := map at:3.
+ mod notNil ifTrue:[
+ ctrlModifiers := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
+ ].
+ mod := map at:4.
+ mod notNil ifTrue:[
+ mod := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
+ (mod includes:#'Num_Lock') ifFalse:[
+ metaModifiers := mod.
+ metaModifierMask := 1 bitShift:(4-1).
+ ].
+ ].
+ mod := map at:5.
+ mod notNil ifTrue:[
+ mod := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
+ (mod includes:#'Num_Lock') ifFalse:[
+ altModifiers := mod.
+ altModifierMask := 1 bitShift:(5-1).
+ ].
+ ]
+ ].
+
+ "
+ Display initializeModifierMappings
+ "
+
+ "Modified: 1.12.1995 / 23:44:40 / stefan"
+!
+
+initializeScreenBounds
+ self isXineramaActive ifTrue:[
+ |rect|
+
+ self monitorBounds do:[:eachRect|
+ rect isNil ifTrue:[
+ rect := eachRect.
+ ] ifFalse:[
+ rect := rect merge:eachRect.
+ ]
+ ].
+ width := rect width.
+ height := rect height.
+
+ "propagate possible size changes to our rottView"
+ rootView notNil ifTrue:[
+ rootView initialize.
+ ].
+ ] ifFalse:[
+ width := self queryWidth.
+ height := self queryHeight.
+ ].
+ widthMM := self queryWidthMM.
+ heightMM := self queryHeightMM.
+
+ "
+ Display initializeScreenBounds
+ "
+!
+
+initializeScreenProperties
+ |masks|
+
+ super initializeScreenProperties.
+
+ hasShapeExtension := self queryShapeExtension.
+ hasShmExtension := self querySHMExtension.
+ hasDPSExtension := self queryDPSExtension.
+ hasXVideoExtension := self queryXVideoExtension.
+ hasMbufExtension := self queryMBUFExtension.
+ hasPEXExtension := self queryPEXExtension.
+ hasImageExtension := self queryXIEExtension.
+ hasInputExtension := self queryXIExtension.
+ hasXineramaExtension := self queryXineramaExtension.
+ hasRenderExtension := self queryRenderExtension.
+ hasXftLibrary := self queryXftLibrary.
+
+ primaryAtom := self atomIDOf:#PRIMARY.
+ stringAtom := self atomIDOf:#STRING.
+ clipboardAtom := self atomIDOf:#CLIPBOARD.
+
+ altModifierMask := self modifier2Mask.
+ metaModifierMask := self modifier1Mask.
+
+ screen := self queryDefaultScreen.
+
+ self initializeScreenBounds.
+
+ depth := self queryDepth.
+ ncells := self queryCells.
+ blackpixel := self queryBlackPixel.
+ whitepixel := self queryWhitePixel.
+
+ monitorType := #unknown.
+ visualType := self queryDefaultVisualType.
+
+ hasColors := hasGreyscales := true.
+ (visualType == #StaticGray
+ or:[ visualType == #GrayScale]) ifTrue:[
+ hasColors := false.
+ monitorType := #monochrome.
+ ].
+
+ ncells == 2 ifTrue:[
+ hasColors := hasGreyscales := false.
+ ].
+
+ masks := self queryRGBMasks.
+ redMask := masks at:1.
+ greenMask := masks at:2.
+ blueMask := masks at:3.
+ bitsPerRGB := masks at:4.
+
+ visualType == #TrueColor ifTrue:[
+ redShift := redMask lowBit - 1.
+ greenShift := greenMask lowBit - 1.
+ blueShift := blueMask lowBit - 1.
+
+ bitsRed := redMask highBit - redMask lowBit + 1.
+ bitsGreen := greenMask highBit - greenMask lowBit + 1.
+ bitsBlue := blueMask highBit - blueMask lowBit + 1.
+ ].
+
+%{
+
+ Display *dpy;
+ int scr;
+ Visual *visual;
+ XVisualInfo viproto;
+ XVisualInfo *vip; /* returned info */
+ int maxRGBDepth, maxRGBADepth;
+ int rgbRedMask, rgbGreenMask, rgbBlueMask;
+ int rgbaRedMask, rgbaGreenMask, rgbaBlueMask, rgbaAlphaMask;
+ int rgbVisualID, rgbaVisualID;
+ int nvi, i;
+ char *type, *nm;
+ int dummy;
+
+ if (ISCONNECTED) {
+ dpy = myDpy;
+
+ /*
+ * look for RGB visual with the highest depth
+ */
+ nvi = 0;
+ viproto.screen = scr;
+ vip = XGetVisualInfo (dpy, VisualScreenMask, &viproto, &nvi);
+ maxRGBDepth = maxRGBADepth = 0;
+ for (i = 0; i < nvi; i++) {
+ int thisDepth = vip[i].depth;
+
+ switch (vip[i].class) {
+ case TrueColor:
+ if (thisDepth > maxRGBDepth) {
+ if (thisDepth <= 24) {
+ maxRGBDepth = thisDepth;
+ rgbRedMask = vip[i].red_mask;
+ rgbGreenMask = vip[i].green_mask;
+ rgbBlueMask = vip[i].blue_mask;
+ rgbVisualID = vip[i].visualid;
+ } else {
+ if (thisDepth > maxRGBADepth) {
+ // printf("found rgba visual!\n");
+ maxRGBADepth = thisDepth;
+ rgbaRedMask = vip[i].red_mask;
+ rgbaGreenMask = vip[i].green_mask;
+ rgbaBlueMask = vip[i].blue_mask;
+ rgbaVisualID = vip[i].visualid;
+ }
+ }
+ }
+ break;
+ }
+ }
+ if (vip) XFree ((char *) vip);
+
+ if (maxRGBDepth) {
+ __INST(rgbVisual) = __MKEXTERNALADDRESS(rgbVisualID); __STORESELF(rgbVisual);
+ }
+ if (maxRGBADepth) {
+ __INST(rgbaVisual) = __MKEXTERNALADDRESS(rgbaVisualID); __STORESELF(rgbaVisual);
+ if (!maxRGBDepth) {
+ __INST(rgbVisual) = __INST(rgbaVisual); __STORESELF(rgbVisual);
+ }
+ }
+ }
+%}.
+!
+
+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.
+ ].
+!
+
+initializeUniqueID
+ uniqueDeviceID isNil ifTrue:[
+ uniqueDeviceID := UUID genUUID.
+ ]
+!
+
+invalidateConnection
+ super invalidateConnection.
+
+ "the new display may support a different set of fonts"
+ self flushListOfAvailableFonts
+!
+
+openConnectionTo:dpyName
+ "open a connection to some display;
+ return the displayId if ok, nil of not ok"
+
+%{ /* STACK:100000 */ /* XOpenDisplay() calls gethostbyname() */
+ Display *dpy;
+ int i;
+ char *nm;
+
+ if (__isStringLike(dpyName))
+ nm = (char *) __stringVal(dpyName);
+ else {
+ nm = NULL;
+ }
+ dpy = XOpenDisplay(nm);
+
+ if (dpy) {
+ static int firstCall = 1;
+ OBJ dpyID;
+
+ dpyID = __MKEXTERNALADDRESS(dpy);
+
+ if (firstCall) {
+ firstCall = 0;
+ XSetErrorHandler(__XErrorHandler__);
+ XSetIOErrorHandler(__XIOErrorHandler__);
+ }
+ RETURN (dpyID);
+ }
+%}.
+ ^ nil
+!
+
+queryBlackPixel
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(BlackPixel(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryBlackPixel
+ "
+!
+
+queryCells
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(DisplayCells(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryCells
+ "
+!
+
+queryDPSExtension
+%{ /* NOCONTEXT */
+
+#ifdef DPS
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, "DPSExtension", &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryDPSExtension
+ "
+!
+
+queryDefaultScreen
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+
+ dpy = myDpy;
+ RETURN ( __MKSMALLINT(DefaultScreen(dpy)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryDefaultScreen
+ "
+!
+
+queryDefaultVisualType
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ Visual *visual;
+
+ dpy = myDpy;
+ visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
+ switch (visual->class) {
+ case StaticGray:
+ RETURN ( @symbol(StaticGray) );
+ case GrayScale:
+ RETURN ( @symbol(GrayScale) );
+ case StaticColor:
+ RETURN ( @symbol(StaticColor) );
+ case PseudoColor:
+ RETURN ( @symbol(PseudoColor) );
+ case TrueColor:
+ RETURN ( @symbol(TrueColor) );
+ case DirectColor:
+ RETURN ( @symbol(DirectColor) );
+ }
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryDefaultVisualType
+ "
+!
+
+queryDepth
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(DisplayPlanes(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryDepth
+ "
+!
+
+queryHeight
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(DisplayHeight(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryHeight
+ "
+!
+
+queryHeightMM
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(DisplayHeightMM(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryHeightMM
+ "
+!
+
+queryMBUFExtension
+%{ /* NOCONTEXT */
+
+#ifdef MBUF
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, "Multi-Buffering", &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryMBUFExtension
+ "
+!
+
+queryPEXExtension
+%{ /* NOCONTEXT */
+
+#ifdef PEX5
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, PEX_NAME_STRING, &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryPEXExtension
+ "
+!
+
+queryRGBMasks
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ Visual *visual;
+ OBJ redMask, greenMask, blueMask, bprgb;
+
+ dpy = myDpy;
+ visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
+ redMask = __MKSMALLINT(visual->red_mask);
+ greenMask = __MKSMALLINT(visual->green_mask);
+ blueMask = __MKSMALLINT(visual->blue_mask);
+ bprgb = __MKSMALLINT(visual->bits_per_rgb);
+ RETURN ( __ARRAY_WITH4(redMask, greenMask, blueMask, bprgb) );
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryRGBMasks
+ "
+!
+
+queryRenderExtension
+%{ /* NOCONTEXT */
+
+#ifdef XRENDER
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XRenderQueryExtension (dpy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryRenderExtension
+ "
+!
+
+querySHMExtension
+%{ /* NOCONTEXT */
+
+#ifdef xxSHM
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, "MIT_SHM", &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display querySHMExtension
+ "
+!
+
+queryShapeExtension
+%{ /* NOCONTEXT */
+
+#ifdef SHAPE
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XShapeQueryExtension(dpy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryShapeExtension
+ "
+!
+
+queryWhitePixel
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(WhitePixel(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryWhitePixel
+ "
+!
+
+queryWidth
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(DisplayWidth(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryWidth
+ "
+!
+
+queryWidthMM
+%{ /* NOCONTEXT */
+
+ if (ISCONNECTED) {
+ Display *dpy;
+ int scr;
+
+ dpy = myDpy;
+ scr = DefaultScreen(dpy);
+ RETURN ( __MKSMALLINT(DisplayWidthMM(dpy, scr)));
+ }
+%}.
+ ^ nil
+
+ "
+ Display queryWidthMM
+ "
+!
+
+queryXIEExtension
+%{ /* NOCONTEXT */
+
+#ifdef XIE
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, xieExtName, &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryXIEExtension
+ "
+!
+
+queryXIExtension
+%{ /* NOCONTEXT */
+
+#ifdef XI
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, "XInputExtension", &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryXIExtension
+ "
+!
+
+queryXVideoExtension
+%{ /* NOCONTEXT */
+
+#ifdef XVIDEO
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XQueryExtension(dpy, "XVideo", &dummy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryXVideoExtension
+ "
+!
+
+queryXftLibrary
+%{
+#ifndef XFT
+ RETURN (false);
+#endif
+%}.
+ ^ self queryRenderExtension
+!
+
+queryXineramaExtension
+%{ /* NOCONTEXT */
+
+#ifdef XINERAMA
+ if (ISCONNECTED) {
+ Display *dpy;
+ int dummy;
+
+ dpy = myDpy;
+
+ if (XineramaQueryExtension (dpy, &dummy, &dummy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display queryXineramaExtension
+ "
+!
+
+reinitialize
+ preWaitAction notNil ifTrue:[
+ Processor removePreWaitAction:preWaitAction.
+ preWaitAction := nil.
+ ].
+ virtualRootId := rootId := nil.
+ selectionFetchers := nil.
+ dispatchingExpose := nil
+!
+
+releaseDeviceResources
+ preWaitAction notNil ifTrue:[
+ Processor removePreWaitAction:preWaitAction.
+ preWaitAction := nil.
+ ].
+ selectionFetchers := nil.
+ super releaseDeviceResources.
+! !
+
+!XWorkstation methodsFor:'keyboard mapping'!
+
+altModifierMask
+ "return the mask (in motionEvents) for the alt-key modifier.
+ Notice: ST/X may use the left ALT key as CMD/Meta key,
+ therefore return a variable here, which can be changed during startup."
+
+ ^ altModifierMask
+
+ "Created: 23.3.1996 / 12:43:22 / cg"
+ "Modified: 23.3.1996 / 12:44:56 / cg"
+!
+
+altModifierMask:aSmallInteger
+ "define which key takes the role of an alt-key.
+ By default, this is X's modifier1, which is the ALT key on
+ most keyboards. However, there may be exceptions to this,
+ and the setting can be changed with:
+ Display altModifierMask:(Display modifier2Mask)
+ Setting the mask to 0 disables the ALT key (in ST/X) altogether.
+ "
+
+ altModifierMask := aSmallInteger
+!
+
+ctrlModifierMask
+ "return the Xlib mask bit for the control modifier key"
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(ControlMask));
+%}
+!
+
+metaModifierMask
+ "return the mask (in motionEvents) for the meta-key modifier.
+ Notice: ST/X may use the left ALT key as CMD/Meta key,
+ therefore return a variable here, which can be changed during startup."
+
+ ^ metaModifierMask
+
+ "Created: 23.3.1996 / 12:43:39 / cg"
+ "Modified: 23.3.1996 / 12:45:09 / cg"
+!
+
+metaModifierMask:aSmallInteger
+ "define which key takes the role of a meta key.
+ By default, this is X's modifier2, which is the 2nd ALT key on
+ most keyboards (if present at all).
+ However, there may be exceptions to this, and the setting can
+ be changed with:
+ Display metaModifierMask:(Display modifier1Mask)
+ Setting the mask to 0 disables the META key (in ST/X) altogether.
+ As reported, some Xservers place the Meta-key onto NumLock,
+ and having NumLock enabled makes ST/X think, that meta is pressed
+ all the time. On those, you should disable the meta key by setting
+ the mask to 0.
+ "
+
+ metaModifierMask := aSmallInteger
+!
+
+modifier1Mask
+ "return the Xlib mask bit for the 1st modifier key.
+ See comment in altModifierMask: / metaModifierMask: for what
+ this could be used."
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(Mod1Mask));
+%}
+!
+
+modifier2Mask
+ "return the Xlib mask bit for the 2nd modifier key.
+ See comment in altModifierMask: / metaModifierMask: for what
+ this could be used."
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(Mod2Mask));
+%}
+!
+
+modifier3Mask
+ "return the Xlib mask bit for the 3rd modifier key.
+ See comment in altModifierMask: / metaModifierMask: for what
+ this could be used."
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(Mod3Mask));
+%}
+!
+
+modifier4Mask
+ "return the Xlib mask bit for the 4th modifier key.
+ See comment in altModifierMask: / metaModifierMask: for what
+ this could be used."
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(Mod4Mask));
+%}
+!
+
+modifier5Mask
+ "return the Xlib mask bit for the 5th modifier key.
+ See comment in altModifierMask: / metaModifierMask: for what
+ this could be used."
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(Mod5Mask));
+%}
+!
+
+modifierMapping
+ "Get the Modifier Mapping.
+ We return an array of arrays of keycodes"
+
+ |modifierKeyMap maxKeyPerMod ret nextKey|
+
+ modifierKeyMap := self rawModifierMapping.
+ modifierKeyMap isEmptyOrNil ifTrue:[^ nil].
+ maxKeyPerMod := modifierKeyMap size // 8.
+
+ 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 asArray.
+ ].
+ nextKey := nextKey+maxKeyPerMod.
+ ].
+
+ ^ ret
+
+ "
+ Display modifierMapping
+ "
+
+ "
+ |mapping|
+
+ mapping := Display modifierMapping.
+ ^ mapping collect:[:eachRow |
+ eachRow notNil ifTrue:[
+ eachRow collect:[ :key | Display stringFromKeycode:key ].
+ ] ifFalse:[
+ nil
+ ]
+ ].
+ "
+!
+
+rawKeySymTranslation
+ "Get the raw keyboard mapping (maps some special X-keySyms to STX-internal names
+ and can also be used to untranslate a stupid x-mapping (as on hpux)."
+
+ ^ rawKeySymTranslation
+
+
+ "
+ Display rawKeySymTranslation
+ "
+!
+
+rawModifierMapping
+ "Get the raw Modifier Mapping."
+
+ |modifierKeyMap|
+
+%{
+ XModifierKeymap *modmap;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ if ((modmap = XGetModifierMapping(dpy)) != 0) {
+ modifierKeyMap = __BYTEARRAY_UNINITIALIZED_NEW_INT(modmap->max_keypermod * 8);
+ if (modifierKeyMap != nil) {
+ memcpy((char *)__ByteArrayInstPtr(modifierKeyMap)->ba_element,
+ (char *)modmap->modifiermap, modmap->max_keypermod * 8);
+ }
+ XFreeModifiermap(modmap);
+ }
+ }
+%}.
+ ^ modifierKeyMap
+
+ "
+ Display rawModifierMapping
+ "
+!
+
+shiftModifierMask
+ "return the Xlib mask bit for the shift modifier key"
+
+%{ /* NOCONTEXT */
+ RETURN (__MKSMALLINT(ShiftMask));
+%}
+!
+
+superModifierMask
+ "return the Xlib mask bit for the super modifier key"
+
+ ^ self modifier4Mask
+!
+
+symbolFromKeycode:code
+ "Get a KeySymbol (a smalltalk symbol) from the keycode."
+
+ |str|
+
+%{
+ KeySym keysym;
+ char *keystring;
+
+ if (ISCONNECTED && __isSmallInteger(code)) {
+ Display *dpy = myDpy;
+
+// Our Windows Xlib does not support Xkb as of 2013-01
+// if ((keysym = XkbKeycodeToKeysym(dpy, __intVal(code), 0, 0)) != NoSymbol
+ if ((keysym = XKeycodeToKeysym(dpy, __intVal(code), 0)) != NoSymbol
+ && (keystring = XKeysymToString(keysym)) != 0)
+ str = __MKSYMBOL(keystring, 0);
+ }
+%}.
+ ^ str
+
+ "
+ Display symbolFromKeycode:50
+ "
+! !
+
+!XWorkstation methodsFor:'misc'!
+
+beep
+ "output an audible beep or bell"
+
+ UserPreferences current beepEnabled ifTrue:[
+ self beep:0 volume:50
+ ]
+
+ "Modified: / 3.12.1999 / 17:13:59 / ps"
+!
+
+beep:aSymbolOrInteger volume:volumeInPercent
+ "output an audible beep. aSymbolOrInteger determines the sound, but is ignored here
+ (kept for comaptibilty with WinWorkstation)."
+
+ <context: #return>
+%{
+ 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;
+
+ ENTER_XLIB();
+ XBell(myDpy, volume);
+ LEAVE_XLIB();
+ }
+%}
+!
+
+buffered
+ "buffer drawing - do not send it immediately to the display.
+ This is the default anyway.
+ See #unBuffered for additional info."
+
+ <context: #return>
+%{
+ if (ISCONNECTED) {
+ ENTER_XLIB();
+ XSynchronize(myDpy, 0);
+ LEAVE_XLIB();
+ }
+%}
+ "
+ Display buffered
+ "
+!
+
+flush
+ "send all buffered drawing to the display.
+ This may be required to make certain, that all previous operations
+ are really sent to the display before continuing. For example,
+ after a cursor-change with a followup long computation.
+ (otherwise, the cursor change request may still be in the output buffer)
+ See also #sync, which even waits until the request has been processed."
+
+ <context: #return>
+%{
+ if (ISCONNECTED) {
+ ENTER_XLIB();
+ XFlush(myDpy);
+ LEAVE_XLIB();
+ }
+%}.
+
+ operationsUntilFlush := maxOperationsUntilFlush.
+!
+
+flushDpsContext:aDPSContext
+ <context: #return>
+%{
+#ifdef DPS
+ if (ISCONNECTED
+ && __isExternalAddress(aDPSContext)) {
+ ENTER_XLIB();
+ DPSFlushContext(__DPSContextVal(aDPSContext));
+ LEAVE_XLIB();
+
+ RETURN ( self );
+ }
+#endif
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+flushIfAppropriate
+ "flush the device, if necessary"
+
+ operationsUntilFlush notNil ifTrue:[
+ operationsUntilFlush <= 0 ifTrue:[
+ self flush.
+ ^ true.
+ ] ifFalse:[
+ operationsUntilFlush := operationsUntilFlush - 1.
+ ].
+ ].
+ ^ false.
+!
+
+primSync
+ "send all buffered drawing to the display AND wait until the display
+ has finished drawing it.
+ This is almost never needed, except if you are about to read previously
+ drawn pixels back from the display screen, or you want to wait for a beep
+ to be finished. See also #flush."
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+
+ ENTER_XLIB();
+ XSync(myDpy, 0);
+ LEAVE_XLIB();
+
+ }
+%}.
+ operationsUntilFlush := maxOperationsUntilFlush.
+!
+
+refreshKeyboardMapping:eB
+ <context: #return>
+%{
+ XMappingEvent *ev;
+
+ if (ISCONNECTED && __isByteArrayLike(eB)) {
+ ev = (XMappingEvent *)(__ByteArrayInstPtr(eB)->ba_element);
+ ENTER_XLIB();
+ XRefreshKeyboardMapping(ev);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+roundTripTime
+ "answer the round trip time in milliSeconds.
+ May be used to detect slow X11 connections"
+
+ self sync.
+ ^ Timestamp millisecondsToRun:[ self primSync ].
+
+ "
+ Screen current roundTripTime
+ "
+!
+
+setInputFocusTo:aWindowId
+ "set the focus to the view as defined by aWindowId.
+ When released, return the focus to the root window"
+
+"/ 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."
+
+ <context: #return>
+%{
+ int arg;
+ Window focusWindow;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aWindowId)) {
+ focusWindow = __WindowVal(aWindowId);
+ } else if (aWindowId == nil) {
+ focusWindow = None;
+ } else
+ goto err;
+ if (revertSymbol == @symbol(parent))
+ arg = RevertToParent;
+ else if (revertSymbol == @symbol(root))
+ arg = RevertToPointerRoot;
+ else
+ arg = RevertToNone;
+
+
+ ENTER_XLIB();
+ XSetInputFocus(myDpy, focusWindow, arg, CurrentTime);
+ LEAVE_XLIB();
+
+ RETURN ( self );
+ }
+err:;
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+sync
+ "send all buffered drawing to the display AND wait until the display
+ has finished drawing it.
+ This is almost never needed, except if you are about to read previously
+ drawn pixels back from the display screen, or you want to wait for a beep
+ to be finished. See also #flush."
+
+ self primSync.
+ self dispatchPendingEvents.
+!
+
+unBuffered
+ "make all drawing be sent immediately to the display.
+ This makes all graphics synchronous and turns off any buffering
+ (i.e. each individual draw-request is sent immediately without
+ packing multiple requests into a larger message buffer).
+ Be prepared, that this slows down graphics considerably.
+ However, it allows display errors to be handled immediately and
+ may be useful if you get Xdisplay errors and want to find the request
+ which was responsible for it. See also #buffered."
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+
+ ENTER_XLIB();
+ XSynchronize(myDpy, 1);
+ LEAVE_XLIB();
+
+ }
+%}
+ "
+ Display unBuffered
+ "
+! !
+
+!XWorkstation methodsFor:'pointer stuff'!
+
+anyButtonStateMask
+ "return an integer for masking out any button from a
+ buttonStates value."
+
+ "/ should use ``Display buttonXMotionMask bitOr:....''
+
+ ^ 256 + 512 + 1024
+
+ "Modified: 23.3.1996 / 12:41:33 / cg"
+ "Created: 23.3.1996 / 12:46:35 / cg"
+!
+
+buttonStates
+ "return an integer representing the state of the pointer buttons;
+ a one-bit in positions 0.. represent a pressed button.
+ See the button1Mask/button2Mask/button3Mask,
+ shiftMask/controlMask and modifierMask methods for the meaning of the bits."
+
+ <context: #return>
+%{
+ Window w;
+ int screen = __intVal(__INST(screen));
+ Window rootRet, childRet;
+ int rootX, rootY, winX, winY;
+ unsigned int mask;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ w = RootWindow(dpy, screen);
+ if (w) {
+
+ ENTER_XLIB();
+ XQueryPointer(dpy, w, &rootRet, &childRet,
+ &rootX, &rootY,
+ &winX, &winY,
+ &mask);
+ LEAVE_XLIB();
+
+ RETURN (__MKSMALLINT(mask));
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+
+ "
+ Display buttonStates
+ "
+
+ "is the control-key pressed ?
+
+ Display buttonStates bitTest:(Display controlMask)
+ "
+
+ "is the alt/meta-key pressed ?
+
+ Display buttonStates bitTest:(Display altModifierMask)
+ Display buttonStates bitTest:(Display metaModifierMask)
+ "
+!
+
+leftButtonStateMask
+ "return an integer for masking out the left button from a
+ buttonStates value"
+
+ "/ should use ``Display button1MotionMask''
+
+ ^ 256
+
+ "Modified: 23.3.1996 / 12:41:33 / cg"
+!
+
+middleButtonStateMask
+ "return an integer for masking out the middle button from a
+ buttonStates value"
+
+ "/ should use ``Display button2MotionMask''
+
+ ^ 512
+
+ "Modified: 23.3.1996 / 12:41:43 / cg"
+!
+
+pointerPosition
+ "return the current pointer position in (virtual) root-window coordinates"
+
+ <context: #return>
+
+ |xpos ypos rootWindowId|
+
+ rootWindowId := self rootWindowId.
+
+%{
+ int screen = __intVal(__INST(screen));
+ Window rootRet, childRet;
+ int rootX, rootY, winX, winY;
+ unsigned int mask;
+
+ if (ISCONNECTED && rootWindowId != nil) {
+ Display *dpy = myDpy;
+ Window w = (Window)__externalAddressVal(rootWindowId);
+
+ ENTER_XLIB();
+ XQueryPointer(dpy, w, &rootRet, &childRet,
+ &rootX, &rootY,
+ &winX, &winY,
+ &mask);
+ LEAVE_XLIB();
+ xpos = __MKSMALLINT(rootX);
+ ypos = __MKSMALLINT(rootY);
+
+ }
+%}.
+ xpos isNil ifTrue:[
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+ ].
+ ^ xpos @ ypos
+!
+
+rightButtonStateMask
+ "return an integer for masking out the right button from a
+ buttonStates value"
+
+ "/ should use ``Display button3MotionMask''
+
+ ^ 1024
+
+ "Modified: 23.3.1996 / 12:41:52 / cg"
+!
+
+rootPositionOfLastEvent
+ "return the position in root-window coordinates
+ of the last button, key or pointer event"
+
+ ^ eventRootX @ eventRootY
+!
+
+setPointerPosition:newPosition in:aWindowId
+ "change the pointer position to a new position relative to the
+ given windows origin (which may be the rootWindow).
+ Be careful with this - its usually not very ergonomically
+ to change the mousePointer position.
+ This interface is provided for special applications (presentation
+ playback) and should not be used in normal applications."
+
+ <context: #return>
+
+ |xpos ypos|
+
+ xpos := newPosition x.
+ ypos := newPosition y.
+
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __bothSmallInteger(xpos, ypos)) {
+ Display *dpy = myDpy;
+ Window w = __WindowVal(aWindowId);
+
+ ENTER_XLIB();
+ XWarpPointer(dpy,
+ None, /* src window */
+ w, /* dst window */
+ 0, /* src_x */
+ 0, /* src_y */
+ 0, /* src_w */
+ 0, /* src_h */
+ __intVal(xpos), /* dst_x */
+ __intVal(ypos) /* dst_y */
+ );
+ LEAVE_XLIB();
+ }
+%}.
+ ^ self
+
+ "
+ Display setPointerPosition:1000@1000
+ "
+! !
+
+!XWorkstation methodsFor:'private'!
+
+addSelectionHandler:someone
+ "register someone to be notified when the selection changes"
+
+ selectionHandlers isNil ifTrue:[
+ selectionHandlers := IdentitySet new.
+ ].
+ selectionHandlers add:someone
+!
+
+findSelectionFetcher:aDrawableId
+ "find the SelectionFetcher that receives selection events for aDrawableId.
+ Answer nil, if there is none"
+
+ selectionFetchers isNil ifTrue:[
+ ^ nil.
+ ].
+
+ ^ selectionFetchers at:aDrawableId ifAbsent:[].
+!
+
+registerSelectionFetcher:aSelectionFetcher
+ "register a SelectionFetcher that receives selection events for aDrawableId"
+
+ selectionFetchers isNil ifTrue:[
+ selectionFetchers := Dictionary new.
+ ].
+
+ selectionFetchers at:aSelectionFetcher drawableID put:aSelectionFetcher.
+!
+
+removeSelectionHandler:someone
+ "no longer tell someone about selection changes"
+
+ selectionHandlers notNil ifTrue:[
+ selectionHandlers remove:someone ifAbsent:nil.
+ selectionHandlers := selectionHandlers asNilIfEmpty
+ ].
+!
+
+unregisterSelectionFetcher:aSelectionFetcher
+ "unregister a SelectionFetcher that received selection events for aDrawableId"
+
+ selectionFetchers removeKey:aSelectionFetcher drawableID.
+! !
+
+!XWorkstation methodsFor:'properties'!
+
+deleteProperty:propertyID for:aWindowID
+ "delete a property in the XServer"
+
+ <context: #return>
+
+%{
+ if (ISCONNECTED && __isAtomID(propertyID)) {
+ Display *dpy = myDpy;
+ Atom prop;
+ Window window;
+
+ prop = __AtomVal(propertyID);
+
+ if (__isExternalAddress(aWindowID)) {
+ window = __WindowVal(aWindowID);
+ } else if (aWindowID == nil) {
+ window = DefaultRootWindow(dpy);
+ } else if (__isInteger(aWindowID)) {
+ window = (Window)__unsignedLongIntVal(aWindowID);
+ } else {
+ goto fail;
+ }
+
+ ENTER_XLIB();
+ XDeleteProperty(dpy, window, prop);
+ LEAVE_XLIB();
+ RETURN(true);
+ }
+fail:;
+%}.
+ self primitiveFailedOrClosedConnection.
+!
+
+getProperty:propertySymbolOrAtomID from:aWindowOrWindowIDOrNil delete:doDelete
+ "get a property as an association propertyType->propertyValue"
+
+ <context: #return>
+
+ |val typeID propertyID windowID|
+
+ propertySymbolOrAtomID isString ifTrue:[
+ propertyID := self atomIDOf:propertySymbolOrAtomID create:false.
+ propertyID isNil ifTrue:[^ nil].
+ ] ifFalse:[
+ propertyID := propertySymbolOrAtomID.
+ ].
+ aWindowOrWindowIDOrNil isView ifTrue:[
+ windowID := aWindowOrWindowIDOrNil id.
+ ] ifFalse:[
+ windowID := aWindowOrWindowIDOrNil.
+ ].
+
+%{
+ Window window;
+ Atom property;
+ char *cp, *cp2;
+ Atom actual_type;
+ int actual_format;
+ unsigned long nitems, bytes_after, nread;
+ unsigned char *data;
+ int ok = 1;
+# define PROP_SIZE 2048
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ if (__isAtomID(propertyID)) {
+ property = __AtomVal(propertyID);
+
+ if (__isExternalAddress(windowID)) {
+ window = __WindowVal(windowID);
+ } else if (windowID == nil) {
+ window = DefaultRootWindow(dpy);
+ } else
+ goto fail;
+
+ nread = 0;
+ cp = 0;
+#ifdef PROPERTY_DEBUG
+ console_fprintf(stderr, "getProperty %x\n", property);
+#endif
+
+ do {
+ int retVal;
+
+ ENTER_XLIB();
+ retVal = XGetWindowProperty(dpy, window, property, nread/4, PROP_SIZE,
+ doDelete == true,
+ AnyPropertyType, &actual_type, &actual_format,
+ &nitems, &bytes_after, (unsigned char **)&data);
+ LEAVE_XLIB();
+ if (retVal != Success) {
+#ifdef PROPERTY_DEBUG
+ console_fprintf(stderr, "- no success\n");
+#endif
+ ok = 0;
+ break;
+ }
+#ifdef PROPERTY_DEBUG
+ console_fprintf(stderr, "- type:%x\n", actual_type);
+#endif
+ nitems *= (actual_format / 8);
+ typeID = __MKATOMOBJ(actual_type);
+ if (! cp) {
+ cp = cp2 = (char *)malloc(nitems+bytes_after);
+ } else {
+ cp2 = cp + nread;
+ }
+ if (! cp) {
+ XFree(data);
+ goto fail;
+ }
+
+ nread += nitems;
+ bcopy(data, cp2, nitems);
+ XFree(data);
+#ifdef PROPERTY_DEBUG
+ console_fprintf(stderr, "- <nitems:%d bytes_after:%d>\n", nitems, bytes_after);
+#endif
+ } while (bytes_after > 0);
+
+ if (ok) {
+ switch (actual_format) {
+ case 32:
+ val = __stArrayFromCUIntArray((unsigned int*)cp, nread/4);
+ break;
+ case 16:
+ val = __stArrayFromCUShortArray((unsigned short*)cp, nread/2);
+ break;
+ case 8:
+ default:
+ if (actual_type == XA_STRING) {
+ val = __MKSTRING_L(cp, nread);
+ } else {
+ val = __MKBYTEARRAY(cp, nread);
+ }
+ break;
+ }
+ }
+ if (cp)
+ free(cp);
+ }
+ }
+fail: ;
+%}.
+ (typeID isNil or:[typeID == 0]) ifTrue:[
+ "typeID == 0 (None): The property does not exist in the specified window"
+ ^ nil
+ ].
+ ^ typeID->val
+
+ "
+ Display
+ getProperty:#'_NET_WM_ICON_GEOMETRY'
+ from:nil
+ delete:false
+ "
+!
+
+propertiesOf:aWindowOrWindowIDOrNil
+ "return a collection of all properties' atomIDs of a window.
+ Returns the rootWindows props for a nil window argument."
+
+ <context: #return>
+
+ |windowID atoms|
+
+ aWindowOrWindowIDOrNil isView ifTrue:[
+ windowID := aWindowOrWindowIDOrNil id.
+ ] ifFalse:[
+ windowID := aWindowOrWindowIDOrNil.
+ ].
+
+%{
+ Window window;
+ Atom *atomListPtr;
+ int i;
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+ int numProps = 0;
+
+ if (__isExternalAddress(windowID)) {
+ window = __WindowVal(windowID);
+ } else if (windowID == nil) {
+ window = DefaultRootWindow(dpy);
+ } else if (__isInteger(windowID)) {
+ window = (Window)__unsignedLongIntVal(windowID);
+ } else {
+ goto fail;
+ }
+
+ ENTER_XLIB();
+ atomListPtr = XListProperties(dpy, window, &numProps);
+ LEAVE_XLIB();
+
+ if (atomListPtr == NULL) {
+ RETURN (nil);
+ }
+
+ atoms = __ARRAY_NEW_INT(numProps);
+
+ if (atoms == nil) {
+ goto fail;
+ }
+
+ for (i=0; i<numProps; i++) {
+ OBJ atm;
+
+ atm = __MKATOMOBJ(atomListPtr[i]);
+ __ArrayInstPtr(atoms)->a_element[i] = atm; __STORE(atoms, atm);
+ }
+ XFree(atomListPtr);
+ RETURN (atoms);
+ }
+fail: ;
+%}.
+ ^ self primitiveFailed
+
+ "
+ Display propertiesOf:nil
+ Display propertiesOf:Transcript view id
+ "
+ "
+ (Display propertiesOf:nil) do:[:atm |
+ |v prop|
+
+ Transcript show:((Display atomName:atm) printStringLeftPaddedTo:5).
+ Transcript show:': '.
+ prop := Display getProperty:atm from:nil delete:false.
+ Transcript showCR:prop value.
+ ]
+ "
+!
+
+setIcon:anIcon for:aWindowID
+ |iconAtom typeAtom buffer iWidth iHeight|
+
+ iconAtom := self atomIDOf:#'_NET_WM_ICON' create:false.
+ iconAtom isNil ifTrue:[
+ "/Hmm, no such property, not running under EWMH compliant WM?
+ ^ self
+ ].
+ typeAtom := self atomIDOf:#'CARDINAL' create:false.
+ typeAtom isNil ifTrue:[
+ "/Hmm, no such property, not running under EWMH compliant WM?
+ ^ self
+ ].
+ iWidth := anIcon width.
+ iHeight := anIcon height.
+ buffer := IntegerArray new:(iWidth*iHeight+2).
+ buffer at:1 put:iWidth.
+ buffer at:2 put:iHeight.
+
+ self setProperty:iconAtom type:typeAtom value:buffer for:aWindowID
+
+ "
+ Display setIcon:0 for:0
+ "
+!
+
+setProperty:propertyID type:typeID value:anObject for:aWindowID
+ "set a property in the XServer"
+
+ <context: #return>
+
+ |retval|
+
+ retval := false.
+
+%{ /* UNLIMITEDSTACK */
+ if (ISCONNECTED && __isAtomID(propertyID) && __isAtomID(typeID)) {
+ Display *dpy = myDpy;
+ Atom prop, type;
+ Window window;
+
+ prop = __AtomVal(propertyID);
+ type = __AtomVal(typeID);
+
+ if (__isExternalAddress(aWindowID)) {
+ window = __WindowVal(aWindowID);
+ } else if (aWindowID == nil) {
+ window = DefaultRootWindow(dpy);
+ } else if (__isInteger(aWindowID)) {
+ window = (Window)__unsignedLongIntVal(aWindowID);
+ } else {
+ RETURN(false);
+ }
+
+ retval = true;
+
+ ENTER_XLIB();
+ if (__isInteger(anObject)) {
+ unsigned INT value = __longIntVal(anObject);
+ XChangeProperty(dpy, window, prop, type, 32,
+ PropModeReplace,
+ (unsigned char *)&value, 1);
+ } else if (__isByteArrayLike(anObject)) {
+ XChangeProperty(dpy, window, prop, type, 8,
+ PropModeReplace,
+ __byteArrayVal(anObject),
+ __byteArraySize(anObject));
+ } else if (__isWords(anObject)) {
+ /* wordArray-like (16bit-string) object */
+ XChangeProperty(dpy, window, prop, type, 16,
+ PropModeReplace,
+ __stringVal(anObject),
+ __wordArraySize(anObject));
+ } else if (__isIntegerArray(anObject)) {
+ /* array of atoms */
+ XChangeProperty(dpy, window, prop, type, 32,
+ PropModeReplace,
+ (char *)__integerArrayVal(anObject),
+ __integerArraySize(anObject));
+ } else if (__isStringLike(anObject)) {
+ XChangeProperty(dpy, window, prop, type, 8,
+ PropModeReplace,
+ __stringVal(anObject),
+ __stringSize(anObject));
+ } else {
+ retval = false;
+ }
+ LEAVE_XLIB();
+
+ DPRINTF(("changeProp win=%"_lx_" prop=%"_lx_" type=%"_lx_"\n", (INT)window, (INT)prop, (INT)type));
+ }
+%}.
+ ^ retval
+! !
+
+!XWorkstation methodsFor:'queries'!
+
+defaultExtentForTopViews
+ "redefined, to define the default extent for the default monitor"
+ |extent|
+
+ "the standard monitor is the first entry in monitorBounds"
+ extent := self monitorBounds first extent.
+
+ self isPDA ifTrue:[
+ ^ extent - (16 @ 20)
+ ].
+ ^ extent * 2 // 3
+!
+
+isOpen
+ "answer true, if device can be used"
+
+ ^ displayId notNil and:[hasConnectionBroken not].
+!
+
+isXineramaActive
+%{ /* NOCONTEXT */
+
+#ifdef XINERAMA
+ if (ISCONNECTED) {
+ Display *dpy;
+ dpy = myDpy;
+
+ if (XineramaIsActive(dpy)) {
+ RETURN ( true );
+ }
+ }
+#endif
+%}.
+ ^ false
+
+ "
+ Display isXineramaActive
+ "
+!
+
+supportedClipboards
+ "answer a collection of symbols with the supported clipboards.
+ X11 additionaly supports a buffer containing the currently selected text
+ (in xterm) - the PRIMARY selection"
+
+ ^ #(clipboard selection)
+!
+
+supportsUTF8WindowLabels
+ "answer true, if window labels are to be utf-8 encoded"
+
+ ^ false
+!
+
+supportsVariableHeightFonts
+ "are fonts with variable height supported?"
+
+ ^ false
+! !
+
+!XWorkstation methodsFor:'resources'!
+
+atomIDOf:aStringOrSymbol
+ "return an X11 atoms ID.
+ This is highly X specific and only for local use (with selections).
+ The default is to create the atom, if it does not exist, in order to
+ speed up future lookups"
+
+ ^ self atomIDOf:aStringOrSymbol create:true
+
+ "
+ Display atomIDOf:#'FACE_NAME'
+ Display atomIDOf:#'FULL_NAME'
+ Display atomIDOf:#DndProtocol
+ Display atomIDOf:#DndSelection
+ "
+
+ "Modified: 4.4.1997 / 13:38:48 / cg"
+!
+
+atomIDOf:aStringOrSymbol create:create
+ "return an Atoms ID given its name.
+ If it already exists, return its ID.
+ If not and the create argument is true, it is created.
+ Otherwise, nil is returned.
+ This is highly X specific and only for local use (with selections)."
+
+ |atomSymbol atom|
+
+ atomSymbol := aStringOrSymbol asSymbol.
+ (atoms notNil and:[(atom := atoms at:atomSymbol ifAbsent:nil) notNil]) ifTrue:[
+ ^ atom.
+ ].
+
+ atom := self primAtomIDOf:atomSymbol create:create.
+ atom notNil ifTrue:[
+ atoms isNil ifTrue:[
+ atoms := IdentityDictionary new.
+ ].
+ atoms at:atomSymbol put:atom.
+ ].
+
+ ^ atom
+
+ "
+ Display atomIDOf:#'VT_SELECTION' create:false
+ Display atomIDOf:#CLIPBOARD create:false
+ Display atomIDOf:'STRING' create:false
+ Display atomIDOf:'PRIMARY' create:false
+ Display atomIDOf:'blabla' create:false
+ "
+!
+
+atomName:anAtomID
+ "given an AtomID, return its name.
+ This is highly X specific and only for local use (with selections)."
+
+ <context: #return>
+
+%{
+ OBJ str;
+ char *name;
+
+ if (ISCONNECTED && __isAtomID(anAtomID)) {
+ ENTER_XLIB();
+ name = XGetAtomName(myDpy, __AtomVal(anAtomID));
+ LEAVE_XLIB();
+ if (name == 0) {
+ RETURN (nil);
+ }
+ str = __MKSTRING(name);
+ XFree(name);
+ RETURN ( str );
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+
+ "
+ Display atomName:1 'PRIMARY'
+ Display atomName:130 '_DEC_DEVICE_FONTNAMES'
+ Display atomName:132 'FONTNAME_REGISTRY'
+ Display atomName:135 'FOUNDRY'
+ Display atomName:150 'CHARSET_REGISTRY'
+ Display atomName:151 'ISO8859'
+ Display atomName:152 'CHARSET_ENCODING'
+ Display atomName:154
+ "
+!
+
+getResource:name class:cls
+ "access the displays resource database for a default value
+ of name in a resource class.
+ This is highly X specific and currently not used.
+
+ Notice:
+ we do not plan to use X's resources for ST/X's defaults,
+ styles or resources. This would make porting of applications
+ to different platforms much more difficult (Windows has no resource
+ database). If you stay within ST/X's resource files, these can be
+ easily transported to other platforms.
+
+ This method is provided for special applications which want to access
+ existing X resources and are not planned to be ever ported to other
+ platforms."
+
+%{
+ char *rslt;
+
+ if (ISCONNECTED
+ && __isStringLike(name)
+ && __isStringLike(cls)) {
+
+ rslt = XGetDefault(myDpy, (char *) __stringVal(cls),
+ (char *) __stringVal(name));
+
+ RETURN (rslt ? __MKSTRING(rslt) : nil );
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ nil.
+
+ "if your ~/.Xdefaults contains an entry such as:
+ OpenWindows.Beep: notices
+ the following returns 'notices'.
+
+ Display getResource:'Beep' class:'OpenWindows'
+
+ if your ~/.Xdefaults contains an entry such as:
+ *.beNiceToColormap: false
+ the following return 'false'.
+
+ Display getResource:'beNiceToColormap' class:'any'
+ Display getResource:'beNiceToColormap' class:''
+ "
+!
+
+primAtomIDOf:aStringOrSymbol create:create
+ "return an Atoms ID; if create is true, create it if not already present.
+ This is highly X specific and only for local use (with selections)."
+
+ <context: #return>
+
+%{
+ Atom prop;
+
+ if (ISCONNECTED
+ && __isStringLike(aStringOrSymbol)) {
+
+ ENTER_XLIB();
+ prop = XInternAtom(myDpy, __stringVal(aStringOrSymbol),
+ (create == true) ? False : True);
+ LEAVE_XLIB();
+ if (prop == None) {
+ RETURN (nil);
+ }
+ RETURN ( __MKATOMOBJ(prop) );
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+
+ "
+ Display primAtomIDOf:'VT_SELECTION' create:false
+ Display primAtomIDOf:'CUT_BUFFER0' create:false
+ Display primAtomIDOf:'STRING' create:false
+ Display primAtomIDOf:'PRIMARY' create:false
+ "
+! !
+
+!XWorkstation methodsFor:'retrieving pixels'!
+
+getBitsFromId:aDrawableId x:srcx y:srcy width:w height:h into:imageBits
+ "get bits from a drawable into the imageBits. The storage for the bits
+ must be big enough for the data to fit. If ok, returns an array with some
+ info and the bits in imageBits. The info contains the depth, bitOrder and
+ number of bytes per scanline. The number of bytes per scanline is not known
+ in advance, since the X-server is free to return whatever it thinks is a good padding."
+
+ |rawInfo info|
+
+ ((w <= 0) or:[h <= 0]) ifTrue:[
+ self primitiveFailed.
+ ^ nil
+ ].
+
+ rawInfo := Array new:8.
+ "1 -> bit order"
+ "2 -> depth"
+ "3 -> bytes_per_line"
+ "4 -> byte_order"
+ "5 -> format"
+ "6 -> bitmap_unit"
+ "7 -> bitmap_pad"
+ "8 -> bits_per_pixel"
+
+ "/ had to extract the getPixel call into a separate method, to specify
+ "/ unlimitedStack (some implementations use alloca and require huge amounts
+ "/ of temporary stack space
+
+ (self primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:rawInfo) ifTrue:[
+ info := IdentityDictionary new.
+ info at:#bitOrder put:(rawInfo at:1).
+ info at:#depth put:(rawInfo at:2).
+ info at:#bytesPerLine put:(rawInfo at:3).
+ info at:#byteOrder put:(rawInfo at:4).
+ info at:#format put:(rawInfo at:5).
+ info at:#bitmapUnit put:(rawInfo at:6).
+ info at:#bitmapPad put:(rawInfo at:7).
+ info at:#bitsPerPixel put:(rawInfo at:8).
+ ^ info
+ ].
+ "
+ some error occured - either args are not smallintegers, imageBits is not a ByteArray
+ or is too small to hold the bits
+ "
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+!
+
+getPixelX:x y:y from:aDrawableId with:dummyGCId
+ "return the pixel value at x/y; coordinates start at 0/0 for the upper left.
+ Nil is returned for invalid coordinates or if any other problem arises."
+
+ <context: #return>
+
+%{ /* UNLIMITEDSTACK */
+
+ Window win;
+ XImage *img;
+ int ret;
+ int xpos, ypos;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aDrawableId) && __bothSmallInteger(x, y)) {
+ win = __WindowVal(aDrawableId);
+ xpos = __intVal(x);
+ ypos = __intVal(y);
+ if ((xpos < 0) || (ypos < 0)) {
+ RETURN ( __MKSMALLINT(0) );
+ }
+ ENTER_XLIB();
+ img = XGetImage(myDpy, win, xpos, ypos, 1, 1, (unsigned)~0, ZPixmap);
+ LEAVE_XLIB();
+ if (img != 0) {
+ ret = XGetPixel(img, 0, 0);
+ XDestroyImage(img);
+ RETURN ( __MKSMALLINT(ret) );
+ }
+ }
+%}.
+ ^ nil
+!
+
+primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:info
+ "since XGetImage may allocate huge amount of stack space
+ (some implementations use alloca), this must run with unlimited stack."
+
+ <context: #return>
+
+%{ /* UNLIMITEDSTACK */
+
+ Window win;
+ XImage *image = (XImage *)0;
+ int pad, bytes_per_line, numBytes;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aDrawableId)
+ && __bothSmallInteger(srcx, srcy)
+ && __bothSmallInteger(w, h)
+ && __isArray(info)
+ && __isByteArray(imageBits)) {
+ Display *dpy = myDpy;
+
+ win = __WindowVal(aDrawableId);
+ ENTER_XLIB();
+ image = XGetImage(dpy, win, __intVal(srcx), __intVal(srcy),
+ __intVal(w), __intVal(h),
+ (unsigned)AllPlanes, ZPixmap);
+ LEAVE_XLIB();
+
+ if (! image) {
+ RETURN ( false );
+ }
+
+ pad = image->bitmap_pad;
+#ifdef SUPERDEBUG
+ console_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 ? */
+ console_fprintf(stderr, "possibly unsupported depth:%d in primGetBits\n", image->depth);
+ numBytes = image->bytes_per_line * image->height;
+ break;
+ }
+
+#ifdef SUPERDEBUG
+ console_printf("bytes need:%d bytes given:%d\n", numBytes, __byteArraySize(imageBits));
+#endif
+
+ if (numBytes > __byteArraySize(imageBits)) {
+ /* imageBits too small */
+ console_fprintf(stderr, "Workstation [warning]: byteArray too small in primGetBits\n");
+ console_fprintf(stderr, " bytes need:%d given:%d\n", numBytes, (int)__byteArraySize(imageBits));
+ console_fprintf(stderr, " pad:%d depth:%d imgBytesPerLine:%d\n",
+ image->bitmap_pad, image->depth, image->bytes_per_line);
+ goto fail;
+ }
+ if (image->bitmap_bit_order == MSBFirst)
+ __ArrayInstPtr(info)->a_element[0] = @symbol(msbFirst);
+ else
+ __ArrayInstPtr(info)->a_element[0] = @symbol(lsbFirst);
+ __ArrayInstPtr(info)->a_element[1] = __MKSMALLINT(image->depth);
+ __ArrayInstPtr(info)->a_element[2] = __MKSMALLINT(image->bytes_per_line);
+ if (image->byte_order == MSBFirst)
+ __ArrayInstPtr(info)->a_element[3] = @symbol(msbFirst);
+ else
+ __ArrayInstPtr(info)->a_element[3] = @symbol(lsbFirst);
+ if (image->format == XYBitmap)
+ __ArrayInstPtr(info)->a_element[4] = @symbol(XYBitmap);
+ else if (image->format == XYPixmap)
+ __ArrayInstPtr(info)->a_element[4] = @symbol(XYPixmap);
+ else if (image->format == ZPixmap)
+ __ArrayInstPtr(info)->a_element[4] = @symbol(ZPixmap);
+
+ __ArrayInstPtr(info)->a_element[5] = __MKSMALLINT(image->bitmap_unit);
+ __ArrayInstPtr(info)->a_element[6] = __MKSMALLINT(image->bitmap_pad);
+ __ArrayInstPtr(info)->a_element[7] = __MKSMALLINT(image->bits_per_pixel);
+ bcopy(image->data, __ByteArrayInstPtr(imageBits)->ba_element, numBytes);
+ XDestroyImage(image);
+ RETURN ( true );
+ }
+fail:
+ if (image) {
+ XDestroyImage(image);
+ }
+%}.
+ ^ false
+! !
+
+!XWorkstation methodsFor:'selection fetching'!
+
+getClipboardObjectFor:drawableId
+ "get the object selection.
+ Returns nil, if no selection is available.
+
+ Smalltalk puts ST_OBJECT only into the CLIPBOARD"
+
+ |selectionOwnerWindowId selection|
+
+ selectionOwnerWindowId := self getSelectionOwnerOf:clipboardAtom.
+ selectionOwnerWindowId isNil ifTrue:[
+ "no selection. There is the possibilty that one of our (modal)
+ views has been closed. Get the selection from the copyBuffer"
+ ^ copyBuffer.
+ ].
+ selectionOwnerWindowId = selectionOwner ifTrue:[
+ "I still hold the selection, so return my locally buffered data"
+ ^ copyBuffer
+ ].
+
+ drawableId notNil ifTrue:[
+ "sorry, cannot fetch a selection, if there is no drawableId.
+ Should I borrow a drawableId from another window?"
+
+ selection := SelectionFetcher
+ requestSelection:clipboardAtom
+ type:(self atomIDOf:#'ST_OBJECT')
+ onDevice:self for:drawableId.
+
+ "/ should not happen
+false ifTrue:[
+ "/ cg: disabled the code below: I don't want any string here (when asking for an object)
+ selection isEmptyOrNil ifTrue:[
+ selection := SelectionFetcher
+ requestSelection:clipboardAtom
+ type:(self atomIDOf:#'UTF8_STRING')
+ onDevice:self for:drawableId.
+
+ selection isNil ifTrue:[
+ selection := SelectionFetcher
+ requestSelection:clipboardAtom
+ type:(self atomIDOf:#STRING)
+ onDevice:self for:drawableId.
+ ].
+ ].
+].
+ ].
+ selection isEmptyOrNil ifTrue:[ ^ copyBuffer ].
+
+ ^ selection.
+
+ "
+ Display getClipboardObjectFor:Transcript id
+ "
+!
+
+getClipboardText:selectionBufferSymbol for:drawableId
+ "get the text selection.
+ Returns nil, if no selection is available"
+
+ |selectionId selectionOwnerWindowId selection|
+
+ selectionBufferSymbol == #selection ifTrue:[
+ selectionId := primaryAtom.
+ ] ifFalse:[
+ selectionId := clipboardAtom.
+ ].
+
+ selectionOwnerWindowId := self getSelectionOwnerOf:selectionId.
+ selectionOwnerWindowId isNil ifTrue:[
+ "no selection. There is the possibilty that one of our (modal)
+ views has been closed. Get the selection from the copyBuffer"
+ ^ self copyBufferAsString.
+ ].
+
+ selectionOwnerWindowId = selectionOwner ifTrue:[
+ "I still hold the selection, so return my locally buffered data"
+ "JV@2012-04-02: Added support for PRIMARY/SELECTION buffers."
+ ^ selectionId == primaryAtom ifTrue:[
+ self primaryBufferAsString
+ ] ifFalse:[
+ self copyBufferAsString.
+ ]
+ ].
+
+ drawableId notNil ifTrue:[
+ "sorry, cannot fetch a selection, if there is no drawableId.
+ Should I borrow a drawableId from another window?"
+
+ selection := SelectionFetcher
+ requestSelection:selectionId
+ type:(self atomIDOf:#'UTF8_STRING')
+ onDevice:self for:drawableId.
+
+ selection isNil ifTrue:[
+ selection := SelectionFetcher
+ requestSelection:selectionId
+ type:(self atomIDOf:#STRING)
+ onDevice:self for:drawableId.
+ ].
+ ].
+
+ ^ selection
+
+ "
+ Display getTextSelection:#clipboard for:Transcript id
+ Display getTextSelection:#selection for:Transcript id
+ "
+
+ "Modified: / 02-04-2012 / 10:34:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+! !
+
+!XWorkstation methodsFor:'selection sending'!
+
+selectionBuffer:bufferGetSelector as:aTargetAtomID
+ "convert the current selection to the format defined by aTargetAtom.
+ Answer an association with the type of converted selection (an atomID)
+ and the converted selection"
+
+ |buffer bufferAsString|
+
+ buffer := self perform:bufferGetSelector.
+
+ (aTargetAtomID == (self atomIDOf:#'ST_OBJECT')) ifTrue:[
+ "/ 'st-object' printCR.
+ "send the selection in binaryStore format"
+ "require libboss to be loaded"
+ (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
+ 'XWorkstation: cannot use binary store for copy buffer (libboss missing)' errorPrintCR.
+ ^ nil -> nil.
+ ].
+
+ [
+ ^ aTargetAtomID -> (buffer binaryStoreBytes).
+ ] on:Error do:[:ex|
+ 'XWorkstation: error on binary store of copy buffer: ' infoPrint.
+ ex description infoPrintCR.
+ ^ nil -> nil.
+ ].
+ ].
+
+ bufferAsString := self class bufferAsString:buffer.
+
+ (aTargetAtomID == (self atomIDOf:#STRING)
+ or:[aTargetAtomID == (self atomIDOf:#'text/plain')]
+ ) ifTrue:[
+ "/ 'string' printCR.
+ "the other view wants the selection as string"
+ ^ aTargetAtomID -> (bufferAsString asSingleByteStringReplaceInvalidWith:$#).
+ ].
+
+ (aTargetAtomID == (self atomIDOf:#UTF8_STRING)
+ or:[aTargetAtomID == (self atomIDOf:#'text/plain;codeset=utf-8')]
+ ) ifTrue:[
+ "/ 'utf string' printCR.
+ "the other view wants the selection as utf8 string"
+ ^ aTargetAtomID -> (bufferAsString utf8Encoded).
+ ].
+
+ aTargetAtomID == (self atomIDOf:#LENGTH) ifTrue:[
+ "the other one wants to know the size of our selection.
+ LENGTH is deprecated, since we do not know how the selection is
+ going to be converted. The client must not rely on the length returned"
+
+ ^ (self atomIDOf:#INTEGER) -> (bufferAsString size).
+ ].
+
+ "we do not support the requestet target type"
+ ^ nil -> nil.
+
+ "Modified: / 23-08-2006 / 15:56:08 / cg"
+!
+
+setClipboardObject:anObject owner:aWindowId
+ "set the object selection, and make aWindowId be the owner.
+ This can be used by other Smalltalk(X) applications only.
+ We set only the CLIPBOARD selection"
+
+ clipboardSelectionTime := lastEventTime.
+ self setSelectionOwner:aWindowId of:clipboardAtom time:clipboardSelectionTime
+!
+
+setClipboardText:aString owner:aWindowId
+ "set the text selection, and make aWindowId be the owner.
+ This can be used by any other X application.
+
+ We set both the PRIMARY and CLIPBOARD, so that you can paste
+ into xterm."
+
+ clipboardSelectionTime := primarySelectionTime := lastEventTime.
+
+ self setSelectionOwner:aWindowId of:clipboardAtom time:clipboardSelectionTime.
+ self setSelectionOwner:aWindowId of:primaryAtom time:primarySelectionTime.
+
+ "Modified: / 17.6.1998 / 19:48:54 / cg"
+!
+
+setPrimaryText:aString owner:aWindowId
+ "set the PRIMARY selection, and make aWindowId be the owner.
+ This can be used by any other X application when middle-click
+ pasting. X Window specific."
+
+ primarySelectionTime := lastEventTime.
+
+ self setSelectionOwner:aWindowId of:primaryAtom time:primarySelectionTime.
+
+ "Created: / 27-03-2012 / 14:16:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+supportedTargetAtoms
+ "answer an integer array containing the list of supported targets
+ i.e. supported clipboard formats"
+
+ "Note: some sender code assumes that ST_OBJECT is first"
+ ^ #(ST_OBJECT STRING UTF8_STRING TIMESTAMP TARGETS LENGTH
+ #'text/plain' #'text/plain;codeset=utf-8'
+ ) collect:[:eachTargetSymbol|
+ self atomIDOf:eachTargetSymbol
+ ] as:IntegerArray.
+! !
+
+!XWorkstation methodsFor:'selections-basic'!
+
+getSelectionOwnerOf:selectionAtomSymbolOrID
+ "get the owner of a selection, aDrawableID.
+ Answer nil, if there is no owner"
+
+ <context:#return>
+
+ |selectionAtomID|
+
+ selectionAtomSymbolOrID isString ifTrue:[
+ selectionAtomID := self atomIDOf:selectionAtomSymbolOrID create:false.
+ ] ifFalse:[
+ selectionAtomID := selectionAtomSymbolOrID.
+ ].
+
+%{
+ Window window;
+
+ if (__isAtomID(selectionAtomID) && ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ ENTER_XLIB();
+ window = XGetSelectionOwner(dpy, __AtomVal(selectionAtomID));
+ LEAVE_XLIB();
+ RETURN ((window == None) ? nil : __MKEXTERNALADDRESS(window));
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+!
+
+requestSelection:selectionID type:typeID for:aWindowId intoProperty:propertyID
+ "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)."
+
+ <context:#return>
+
+ |anIntegerTimestamp|
+
+ anIntegerTimestamp := lastEventTime.
+
+%{
+
+ if (ISCONNECTED
+ && __isAtomID(typeID)
+ && __isAtomID(propertyID)
+ && __isAtomID(selectionID)) {
+ Display *dpy = myDpy;
+ Window w;
+ Time time;
+
+ if (__isExternalAddress(aWindowId)) {
+ w = __WindowVal(aWindowId);
+ } else if (aWindowId == nil) {
+ w = (Window)0;
+ } else
+ goto err;
+
+ if (anIntegerTimestamp == nil) {
+ /*
+ * the ICCCM convention says: you should set the time to the time when
+ * the selection was requested and not to CurrentTime
+ */
+ time = CurrentTime;
+ } else if (__isInteger(anIntegerTimestamp)) {
+ time = __unsignedLongIntVal(anIntegerTimestamp);
+ } else
+ goto err;
+
+ ENTER_XLIB();
+ XConvertSelection(dpy, __AtomVal(selectionID), __AtomVal(typeID),
+ __AtomVal(propertyID), w, time);
+ LEAVE_XLIB();
+
+ RETURN (true);
+err:;
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+
+ "
+ Display
+ requestSelection:(Display atomIDOf:'PRIMARY')
+ property:(Display atomIDOf:'VT_SELECTION')
+ type:(Display atomIDOf:'STRING')
+ for:Transcript id
+ "
+ "
+ Display
+ requestSelection:(Display atomIDOf:'PRIMARY')
+ property:(Display atomIDOf:'VT_SELECTION')
+ type:(Display atomIDOf:'C_STRING')
+ for:Transcript id
+ "
+!
+
+sendNotifySelection:selectionID property:propertyID target:targetID time:aTime to:requestorID
+ "send a selectionNotify back from a SelectionRequest.
+ PropertyID should be the same as requested or nil, if the selection
+ could not be converted.
+ TargetId should be the same as requested.
+ Time should be the time when the selection has been acquired"
+
+ <context: #return>
+%{
+ if (ISCONNECTED
+ && (__isAtomID(propertyID) || propertyID == nil)
+ && __isAtomID(targetID) && __isAtomID(selectionID)) {
+ Display *dpy = myDpy;
+ XEvent ev;
+ Window requestor;
+ Status result;
+
+ if (__isExternalAddress(requestorID)) {
+ requestor = __WindowVal(requestorID);
+ } else if (__isSmallInteger(requestorID)) {
+ requestor = (Window)__smallIntegerVal(requestorID);
+ } else if (requestorID == nil) {
+ requestor = DefaultRootWindow(dpy);
+ } else {
+ requestor = (Window)__unsignedLongIntVal(requestorID);
+ }
+
+ ev.xselection.type = SelectionNotify;
+ ev.xselection.display = dpy;
+ ev.xselection.selection = __AtomVal(selectionID);
+ ev.xselection.target = __AtomVal(targetID);
+ ev.xselection.requestor = requestor;
+
+ if (__isExternalAddress(aTime)) {
+ ev.xselection.time = (INT)(__externalAddressVal(aTime));
+ } else if (__isSmallInteger(aTime)) {
+ ev.xselection.time = __smallIntegerVal(aTime);
+ } else if (aTime == nil) {
+ ev.xselection.time = CurrentTime;
+ } else {
+ ev.xselection.time = (INT)__unsignedLongIntVal(aTime);
+ }
+#if 0
+ console_printf("ev.xselection.selection: %x\n", ev.xselection.selection);
+ console_printf("ev.xselection.target: %x\n", ev.xselection.target);
+ console_printf("ev.xselection.requestor: %x\n", ev.xselection.requestor);
+ console_printf("ev.xselection.time: %x\n", ev.xselection.time);
+ console_printf("requestor: %x\n", requestor);
+#endif
+
+ /* send nil property if selection cannot be converted */
+ if (propertyID == nil)
+ ev.xselection.property = None;
+ else
+ ev.xselection.property = __AtomVal(propertyID);
+
+
+ DPRINTF(("sending SelectionNotify sel=%"_lx_" prop=%"_lx_" target=%"_lx_" requestor=%"_lx_" to %"_lx_"\n",
+ (INT)ev.xselection.selection,
+ (INT)ev.xselection.property,
+ (INT)ev.xselection.target,
+ (INT)ev.xselection.requestor,
+ (INT)requestor));
+
+ ENTER_XLIB();
+ result = XSendEvent(dpy, requestor, False, 0 , &ev);
+ LEAVE_XLIB();
+
+ if ((result == BadValue) || (result == BadWindow)) {
+ DPRINTF(("bad status\n"));
+ RETURN (false);
+ }
+ ENTER_XLIB();
+ XFlush(dpy);
+ LEAVE_XLIB();
+ RETURN (true)
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+
+ "Modified: / 17.6.1998 / 20:23:20 / cg"
+!
+
+setSelectionOwner:aWindowId of:selectionAtomSymbolOrID time:anIntegerTimestamp
+ "set the owner of a selection; return false if failed"
+
+ <context: #return>
+
+ |selectionAtomID|
+
+ "store the current owner of the selection.
+ If we still own the selection on paste,
+ we can avoid the X11 overhead"
+
+ selectionOwner := aWindowId.
+
+ selectionAtomSymbolOrID isString ifTrue:[
+ selectionAtomID := self atomIDOf:selectionAtomSymbolOrID create:false.
+ ] ifFalse:[
+ selectionAtomID := selectionAtomSymbolOrID.
+ ].
+
+%{
+ Window win;
+
+ if (__isExternalAddress(aWindowId)
+ && __isAtomID(selectionAtomID)
+ && ISCONNECTED) {
+ Display *dpy = myDpy;
+ Time time;
+
+ win = __WindowVal(aWindowId);
+
+ if (anIntegerTimestamp == nil) {
+ /*
+ * the ICCCM convention says: you should set the time to the time when
+ * the selection was acquired and not to CurrentTime
+ */
+ time = CurrentTime;
+ } else if (__isInteger(anIntegerTimestamp)) {
+ time = __unsignedLongIntVal(anIntegerTimestamp);
+ } else
+ goto err;
+
+ DPRINTF(("setOwner prop=%"_lx_" win=%"_lx_"\n", (INT)__AtomVal(selectionAtomID), (INT)win));
+ ENTER_XLIB();
+ XSetSelectionOwner(dpy, __AtomVal(selectionAtomID), win, time);
+ RETURN (self);
+ LEAVE_XLIB();
+ }
+err:;
+%}.
+ self primitiveFailedOrClosedConnection.
+! !
+
+!XWorkstation methodsFor:'window queries'!
+
+allChildIdsOf:aWindowId
+ "return all children-ids of the given window.
+ Allows for all windows to be enumerated, if we start at the root."
+
+ |childIDs allChildIDs|
+
+ allChildIDs := OrderedCollection new.
+ childIDs := self childIdsOf:aWindowId.
+ childIDs notNil ifTrue:[
+ allChildIDs addAll:childIDs.
+ childIDs do:[:eachChildId |
+ allChildIDs addAll:(self allChildIdsOf:eachChildId).
+ ].
+ ].
+ ^ allChildIDs
+
+ "
+ Display allChildIdsOf:(Display rootWindowId)
+ "
+
+ "
+ |deviceIDAtom uuidAtom|
+
+ deviceIDAtom := (Display atomIDOf:#'STX_DEVICE_ID').
+ uuidAtom := (Display atomIDOf:#'UUID').
+ (Display allChildIdsOf:(Display rootWindowId))
+ select:[:id |
+ |uuid|
+
+ Display
+ getProperty:deviceIDAtom
+ from:id
+ delete:false
+ into:[:type :value |
+ type == uuidAtom ifTrue:[
+ uuid := UUID fromBytes:value.
+ ].
+ ].
+ uuid notNil.
+ ]
+ "
+!
+
+childIdsOf:aWindowId
+ "return all children-ids of the given window. Allows for all windows to be
+ enumerated, if we start at the root."
+
+ |childIdArray|
+%{
+ OBJ id;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ Display *dpy = myDpy;
+ Window win = __WindowVal(aWindowId);
+ Window rootReturn, parentReturn;
+ Window* children = (Window *)0;
+ unsigned int numChildren;
+ int i;
+ int rslt;
+
+ ENTER_XLIB();
+ rslt = XQueryTree(dpy, win,
+ &rootReturn, &parentReturn,
+ &children, &numChildren);
+ LEAVE_XLIB();
+ if (rslt) {
+ childIdArray = __ARRAY_NEW_INT(numChildren);
+ if (childIdArray != nil) {
+ for (i=0; i < numChildren; i++) {
+ if (children[i]) {
+ OBJ childId;
+
+ childId = __MKEXTERNALADDRESS(children[i]);
+ __ArrayInstPtr(childIdArray)->a_element[i] = childId;
+ __STORE(childIdArray, childId);
+ }
+ }
+ if (children) XFree(children);
+ }
+ RETURN (childIdArray);
+ }
+ }
+%}.
+ ^ nil.
+
+ "
+ Display childIdsOf:(Display rootWindowId)
+ "
+!
+
+realRootWindowId
+ "return the id of the real root window.
+ This may not be the window you see as background,
+ since some window managers install a virtual root window on top
+ of it. Except for very special cases, use #rootWindowId, which takes
+ care of any virtual root."
+
+%{
+ int screen = __intVal(__INST(screen));
+ Window root;
+ OBJ id;
+
+ if (__INST(rootId) != nil) {
+ RETURN (__INST(rootId));
+ }
+
+ if (ISCONNECTED) {
+ root = RootWindow(myDpy, screen);
+ if (! root) {
+ id = nil;
+ } else {
+ id = __MKEXTERNALADDRESS(root); __INST(rootId) = id; __STORE(self, id);
+ }
+ RETURN (id);
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+
+ "
+ Display rootWindowId
+ Display realRootWindowId
+ "
+!
+
+rootWindowId
+ "return the id of the root window.
+ This is the window you see as background,
+ however, it may or may not be the real physical root window,
+ since some window managers install a virtual root window on top
+ of the real one. If this is the case, that views id is returned here."
+
+%{
+ int screen = __intVal(__INST(screen));
+ Window rootWin, vRootWin = 0;
+ OBJ id;
+
+ if (__INST(virtualRootId) != nil) {
+ RETURN (__INST(virtualRootId));
+ }
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ rootWin = RootWindow(dpy, screen);
+#ifndef IRIS
+
+ /*
+ * on IRIS, this creates a badwindow error - why ?
+ * children contains a funny window (000034)
+ */
+
+ /*
+ * care for virtual root windows (tvtwm & friends)
+ */
+ {
+ Atom vRootAtom, kwinAtom;
+ int i;
+ Window rootReturn, parentReturn;
+ Window* children = (Window *)0;
+ unsigned int numChildren;
+ int ignoreVRoot = 0;
+
+ /*
+ * Take care of KDE 2.1.
+ * they define _SWM_ROOT but this is not the parent of
+ * the application windows.
+ * Instead it is used for background painting
+ */
+
+ kwinAtom = XInternAtom(dpy, "KWIN_RUNNING", True);
+ if (kwinAtom != None) {
+ Atom actual_type;
+ int actual_format;
+ unsigned long nitems, bytesafter;
+ unsigned char *retVal = 0;
+
+ ignoreVRoot = XGetWindowProperty(dpy, rootWin, kwinAtom,
+ 0L, 1L, False, kwinAtom,
+ &actual_type, &actual_format,
+ &nitems, &bytesafter, &retVal) == Success
+ && actual_type != 0;
+ if (retVal)
+ XFree(retVal);
+ }
+
+ if (!ignoreVRoot) {
+ vRootAtom = XInternAtom(dpy, "__SWM_VROOT", True);
+ if (vRootAtom != None) {
+ if (XQueryTree(dpy, rootWin,
+ &rootReturn, &parentReturn,
+ &children, &numChildren)) {
+ for (i=0; i < numChildren; i++) {
+ Atom actual_type;
+ int actual_format;
+ unsigned long nitems, bytesafter;
+ Window* newRoot = (Window*) 0;
+
+ if (children[i]) {
+ if (XGetWindowProperty(dpy, children[i], vRootAtom,
+ 0L, 1L, False, XA_WINDOW,
+ &actual_type, &actual_format,
+ &nitems, &bytesafter,
+ (unsigned char**) &newRoot
+ ) == Success && newRoot) {
+ vRootWin = *newRoot;
+ XFree(newRoot); /* XXX */
+ break;
+ }
+ }
+ }
+ if (children) XFree(children);
+ }
+ }
+ }
+ }
+#endif
+ }
+
+ if (! vRootWin) {
+ vRootWin = rootWin;
+ if (! vRootWin) {
+ RETURN ( nil );
+ }
+ }
+ id = __MKEXTERNALADDRESS(rootWin); __INST(rootId) = id; __STORE(self, id);
+ id = __MKEXTERNALADDRESS(vRootWin); __INST(virtualRootId) = id; __STORE(self, id);
+ RETURN ( id );
+%}
+
+ "
+ Display rootWindowId
+ "
+! !
+
+!XWorkstation methodsFor:'window stuff'!
+
+clearRectangleX:x y:y width:width height:height in:aWindowId
+ "clear a rectangular area to viewbackground"
+
+ <context: #return>
+%{
+
+ int w, h;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aWindowId)
+ && __bothSmallInteger(x, y)
+ && __bothSmallInteger(width, height)) {
+ w = __intVal(width);
+ h = __intVal(height);
+ /*
+ * need this check here: some servers simply dump core with bad args
+ */
+ if ((w >= 0) && (h >= 0)) {
+ ENTER_XLIB();
+ XClearArea(myDpy, __WindowVal(aWindowId), __intVal(x), __intVal(y), w, h, 0);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+!
+
+clearWindow:aWindowId
+ "clear a window to viewbackground"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XClearWindow(myDpy, __WindowVal(aWindowId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+configureWindow:aWindowId sibling:siblingId stackMode:modeSymbol
+ "configure stacking operation of aWindowId w.r.t siblingId"
+
+ <context: #return>
+%{
+
+ XWindowChanges chg;
+ int mask = CWSibling | CWStackMode;
+
+ if (ISCONNECTED) {
+ if (__isExternalAddress(aWindowId)
+ && __isExternalAddress(siblingId)) {
+ if (modeSymbol == @symbol(above)) {
+ chg.stack_mode = Above;
+ } else if (modeSymbol == @symbol(below)) {
+ chg.stack_mode = Below;
+ } else if (modeSymbol == @symbol(topIf)) {
+ chg.stack_mode = TopIf;
+ } else if (modeSymbol == @symbol(bottomIf)) {
+ chg.stack_mode = BottomIf;
+ } else if (modeSymbol == @symbol(opposite)) {
+ chg.stack_mode = Opposite;
+ } else {
+ mask = CWSibling;
+ }
+
+ chg.sibling = __WindowVal(siblingId);
+ ENTER_XLIB();
+ XConfigureWindow(myDpy, __WindowVal(aWindowId),
+ mask, &chg);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ }
+bad: ;
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+getGeometryOf:aWindowId
+ "get a windows geometry.
+ NOTICE: X-WindowManagers usually do wrap client topViews into their own
+ decoration views (top label, resize boundaries etc.).
+ Thus, the numbers returned here for topViews are the physical (real) dimensions
+ relative to such a wrapper.
+ In contrast, the values found in the views instance variables are virtual dimensions
+ (i.e. ST/X makes this decoration view transparent to the program."
+
+ <context: #return>
+
+ |x y width height depth borderWidth info|
+
+%{
+ int x_ret, y_ret;
+ unsigned int width_ret, height_ret,
+ border_width_ret, depth_ret;
+ Window root_ret;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XGetGeometry(myDpy, __WindowVal(aWindowId),
+ &root_ret,
+ &x_ret, &y_ret,
+ &width_ret, &height_ret, &border_width_ret,
+ &depth_ret);
+ LEAVE_XLIB();
+
+ x = __MKSMALLINT(x_ret);
+ y = __MKSMALLINT(y_ret);
+ width = __MKSMALLINT(width_ret);
+ height = __MKSMALLINT(height_ret);
+ depth = __MKSMALLINT(depth_ret);
+ borderWidth = __MKSMALLINT(border_width_ret);
+ }
+%}.
+ borderWidth isNil ifTrue:[
+ self primitiveFailedOrClosedConnection.
+ ^ nil
+ ].
+ info := Dictionary new.
+ info at:#origin put:(x @ y).
+ info at:#extent put:(width @ height).
+ info at:#depth put:depth.
+ info at:#borderWidth put:borderWidth.
+ ^ info
+
+ "
+ Transcript topView device
+ getGeometryOf:(Transcript id)
+ "
+ "
+ Transcript topView device
+ getGeometryOf:(Transcript topView id)
+ "
+ "
+ Display
+ getGeometryOf:(Display viewIdFromUser)
+ "
+ "
+ |d|
+
+ d := Transcript topView device.
+ d getGeometryOf:(d parentWindowIdOf:Transcript topView id)
+ "
+!
+
+isValidWindowId:aWindowId
+ "return true, if the given window ID is (still) valid.
+ Especially useful, if the passed windowID is
+ an alien (external) windows id."
+
+ |ret|
+
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ char *name = NULL;
+ Status ok;
+ Window root, parent, *children = NULL;
+ unsigned int nChildren;
+
+/* ENTER_XLIB(); */
+ ok = XQueryTree(myDpy, __WindowVal(aWindowId),
+ &root, &parent, &children, &nChildren);
+ if (children) {
+ XFree(children);
+ }
+/* LEAVE_XLIB(); */
+ if (ok) {
+ RETURN (true);
+ }
+ RETURN (false);
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+
+ "
+ |v aWindowId ok|
+
+ v := StandardSystemView new.
+ v label:'hello'.
+ v openAndWait.
+ aWindowId := v id.
+ ok := Display isValidWindowId:aWindowId.
+ Transcript showCR:'ok is: ' , ok printString.
+ Delay waitForSeconds:1.
+ v destroy.
+ ok := Display isValidWindowId:aWindowId.
+ Transcript showCR:'ok is: ' , ok printString.
+ "
+!
+
+lowerWindow:aWindowId
+ "bring a window to back"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XLowerWindow(myDpy, __WindowVal(aWindowId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos
+ width:w height:h minExtent:minExt maxExtent:maxExt
+
+ <context: #return>
+
+ "make a window visible - either as icon or as a real view
+ in addition, allow change of extend, position, minExtend and maxExtent.
+ Needed for restart, to allow recreating a view as iconified,
+ and to collaps/expand windows."
+
+ |wicon wiconId iconMaskId wiconView wiconViewId wlabel minW minH maxW maxH|
+
+ aBoolean ifTrue:[
+ wicon := aView icon.
+ wicon notNil ifTrue:[
+ wiconId := wicon id.
+ wicon mask notNil ifTrue:[
+ iconMaskId := wicon mask id.
+ ].
+ ].
+ wiconView := aView iconView.
+ wiconView notNil ifTrue:[
+ wiconViewId := wiconView id
+ ].
+ wlabel := aView label.
+ ].
+ minExt notNil ifTrue:[
+ minW := minExt x.
+ minH := minExt y.
+ ].
+ maxExt notNil ifTrue:[
+ maxW := maxExt x.
+ maxH := maxExt y.
+ ].
+%{
+
+ XWMHints wmhints;
+ XSizeHints szhints;
+ Window win;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ Display *dpy = myDpy;
+
+ win = __WindowVal(aWindowId);
+
+ szhints.flags = 0;
+ if (__bothSmallInteger(xPos, yPos)) {
+ szhints.x = __intVal(xPos);
+ szhints.y = __intVal(yPos);
+ szhints.flags |= USPosition;
+ }
+ if (__bothSmallInteger(w, h)) {
+ szhints.width = __intVal(w);
+ szhints.height = __intVal(h);
+ szhints.flags |= USSize;
+ }
+ if (__bothSmallInteger(minW, minH)) {
+ szhints.flags |= PMinSize;
+ szhints.min_width = __intVal(minW);
+ szhints.min_height = __intVal(minH);
+ }
+ if (__bothSmallInteger(maxW, maxH)) {
+ szhints.flags |= PMaxSize;
+ szhints.max_width = __intVal(maxW);
+ szhints.max_height = __intVal(maxH);
+ }
+
+ if (aBoolean == true) {
+ char *windowName = "";
+ Pixmap iconBitmap = (Pixmap)0;
+ Pixmap iconMask = (Pixmap)0;
+ Window iconWindow = (Window)0;
+
+ if (__isExternalAddress(wiconId))
+ iconBitmap = __PixmapVal(wiconId);
+
+ if (__isExternalAddress(iconMaskId)) {
+ iconMask = __PixmapVal(iconMaskId);
+ }
+
+ if (__isExternalAddress(wiconViewId))
+ iconWindow = __WindowVal(wiconViewId);
+
+ if (__isStringLike(wlabel))
+ windowName = (char *) __stringVal(wlabel);
+
+ if (iconBitmap || windowName) {
+ ENTER_XLIB();
+ XSetStandardProperties(dpy, win,
+ windowName, windowName,
+ iconBitmap,
+ 0, 0, &szhints);
+ LEAVE_XLIB();
+ }
+
+ wmhints.flags = 0;
+ if (iconBitmap) {
+ wmhints.flags |= IconPixmapHint;
+ wmhints.icon_pixmap = iconBitmap;
+ }
+ if (iconMask) {
+ wmhints.flags |= IconMaskHint;
+ wmhints.icon_mask = iconMask;
+ }
+ if (iconWindow) {
+ wmhints.flags |= IconWindowHint;
+ wmhints.icon_window = iconWindow;
+ }
+
+ wmhints.initial_state = IconicState;
+ wmhints.flags |= StateHint;
+ ENTER_XLIB();
+ XSetWMHints(dpy, win, &wmhints);
+ LEAVE_XLIB();
+ }
+
+ if (szhints.flags) {
+ ENTER_XLIB();
+ XSetNormalHints(dpy, win, &szhints);
+ LEAVE_XLIB();
+ }
+
+ ENTER_XLIB();
+ XMapWindow(dpy, win);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+mapWindow:aWindowId
+ "make a window visible"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XMapWindow(myDpy, __WindowVal(aWindowId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+moveResizeWindow:aWindowId x:x y:y width:w height:h
+ "move and resize a window"
+
+ <context: #return>
+%{
+
+ int newWidth, newHeight;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __bothSmallInteger(w, h)
+ && __bothSmallInteger(x, y)) {
+ newWidth = __intVal(w);
+ newHeight = __intVal(h);
+ if (newWidth < 1) newWidth = 1;
+ if (newHeight < 1) newHeight = 1;
+ ENTER_XLIB();
+ XMoveResizeWindow(myDpy, __WindowVal(aWindowId),
+ __intVal(x), __intVal(y),
+ newWidth, newHeight);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+moveWindow:aWindowId x:x y:y
+ "move a window"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId) && __bothSmallInteger(x, y)) {
+ ENTER_XLIB();
+ XMoveWindow(myDpy, __WindowVal(aWindowId), __intVal(x), __intVal(y));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+newGraphicsContextFor:aGraphicsMedium
+ "create a new graphics context.
+ The defaults is to use the inherited graphics context.
+ Subclasses may redefine this to use their own graphics context"
+
+"/ ^ aGraphicsMedium.
+ |gc|
+
+ gc := X11GraphicsContext onDevice:self.
+ gc font:aGraphicsMedium class defaultFont.
+ ^ gc.
+!
+
+parentWindowIdOf:aWindowId
+ "return a windows parent-window id.
+ Useful with getGeometryOf:, to compute information about the decoration."
+
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ Status ok;
+ Window root, parent, *children = NULL;
+ unsigned int nChildren;
+
+/* ENTER_XLIB(); */
+ ok = XQueryTree(myDpy, __WindowVal(aWindowId),
+ &root, &parent, &children, &nChildren);
+ if (children) {
+ XFree(children);
+ }
+/* LEAVE_XLIB(); */
+ if (! ok) {
+ RETURN ( nil );
+ }
+ RETURN ( __MKEXTERNALADDRESS(parent) );
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false
+
+ "
+ |id|
+
+ id := Transcript device parentWindowIdOf:(Transcript id).
+ self assert: ( Transcript container id = id ).
+ "
+!
+
+raiseWindow:aWindowId
+ "bring a window to front"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XRaiseWindow(myDpy, __WindowVal(aWindowId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+reparentWindow:windowId to:newParentWindowId
+ "change a windows parent (an optional interface)"
+
+ <context: #return>
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(windowId)
+ && __isExternalAddress(newParentWindowId)) {
+ Display *dpy = myDpy;
+ Window _child, _newParent;
+ int i;
+
+ _child = __WindowVal(windowId);
+ _newParent = __WindowVal(newParentWindowId);
+ ENTER_XLIB();
+
+#if 0
+ XWithdrawWindow (dpy, _child, DefaultScreen(dpy));
+ XSync (dpy, 0);
+#endif
+ /*
+ * Code 'stolen' from xswallow source ...
+ * ... mhmh - what is this loop for ?
+ */
+ for (i=0; i<5; i++) {
+ XReparentWindow (dpy, _child, _newParent, 0, 0);
+ XSync (dpy, 0);
+ }
+#if 0
+ XMapWindow (dpy, _child);
+ XSync (dpy, 0);
+#endif
+ LEAVE_XLIB();
+ RETURN ( true );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+resizeWindow:aWindowId width:w height:h
+ "resize a window"
+
+ <context: #return>
+%{
+
+ int newWidth, newHeight;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId) && __bothSmallInteger(w, h)) {
+ newWidth = __intVal(w);
+ newHeight = __intVal(h);
+ if (newWidth < 1) newWidth = 1;
+ if (newHeight < 1) newHeight = 1;
+ ENTER_XLIB();
+ XResizeWindow(myDpy, __WindowVal(aWindowId), newWidth, newHeight);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setBackingStore:how in:aWindowId
+ "turn on/off backing-store for a window"
+
+ <context: #return>
+%{
+
+ XSetWindowAttributes wa;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ if (__INST(ignoreBackingStore) != true) {
+ if (how == @symbol(always)) wa.backing_store = Always;
+ else if (how == @symbol(whenMapped)) wa.backing_store = WhenMapped;
+ else if (how == true) wa.backing_store = Always;
+ else wa.backing_store = 0;
+
+ ENTER_XLIB();
+ XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWBackingStore, &wa);
+ LEAVE_XLIB();
+
+ }
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setBitGravity:how in:aWindowId
+ "set bit gravity for a window"
+
+ <context: #return>
+%{
+
+ XSetWindowAttributes wa;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ if (how == @symbol(NorthWest)) {
+ wa.bit_gravity = NorthWestGravity;
+ } else if (how == @symbol(NorthEast)) {
+ wa.bit_gravity = NorthEastGravity;
+ } else if (how == @symbol(SouthWest)) {
+ wa.bit_gravity = SouthWestGravity;
+ } else if (how == @symbol(SouthEast)) {
+ wa.bit_gravity = SouthEastGravity;
+ } else if (how == @symbol(Center)) {
+ wa.bit_gravity = CenterGravity;
+ } else if (how == @symbol(North)) {
+ wa.bit_gravity = NorthGravity;
+ } else if (how == @symbol(South)) {
+ wa.bit_gravity = SouthGravity;
+ } else if (how == @symbol(West)) {
+ wa.bit_gravity = WestGravity;
+ } else if (how == @symbol(East)) {
+ wa.bit_gravity = EastGravity;
+ } else {
+ wa.bit_gravity = NorthWestGravity;
+ }
+
+
+ ENTER_XLIB();
+ XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWBitGravity, &wa);
+ LEAVE_XLIB();
+
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setCursor:aCursorId in:aWindowId
+ "define a windows cursor"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isExternalAddress(aCursorId)) {
+ Display *dpy = myDpy;
+ Window w = __WindowVal(aWindowId);
+ Cursor c = __CursorVal(aCursorId);
+
+ if (w && c) {
+ ENTER_XLIB();
+ XDefineCursor(dpy, w, c);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setForegroundWindow:aWindowId
+ "bring a window to front.
+ Send a specific message to the WindowManager"
+
+ |activeWindowAtom|
+
+"/ self raiseWindow:aWindowId.
+
+ activeWindowAtom := self atomIDOf:#'_NET_ACTIVE_WINDOW' create:false.
+ activeWindowAtom notNil ifTrue:[
+ self
+ sendClientEvent:activeWindowAtom
+ format:32
+ to:(self rootWindowId)
+ propagate:false
+ eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
+ window:aWindowId
+ data1:2 "activate request from pager. This is a trick: kwm ignores requests from applications (1)"
+ data2:nil
+ data3:nil
+ data4:nil
+ data5:nil.
+ ].
+
+ "
+ Transcript topView setForegroundWindow
+ "
+!
+
+setIconName:aString in:aWindowId
+ "define a windows iconname"
+
+ <context: #return>
+
+ |utf8StringAtom utf8String simpleString|
+
+ utf8StringAtom := self atomIDOf:#UTF8_STRING create:true.
+
+ utf8String := aString utf8Encoded.
+ aString isWideString ifTrue:[
+ "/ X does not like 2-byte labels ...
+ simpleString := aString asSingleByteStringReplaceInvalidWith:$?
+ ] ifFalse:[
+ simpleString := aString.
+ ].
+
+%{
+ XTextProperty titleProperty;
+
+ if (ISCONNECTED
+ && __isStringLike(utf8String)
+ && __isStringLike(simpleString)
+ && __isExternalAddress(aWindowId)) {
+
+ titleProperty.value = __stringVal(utf8String);
+ titleProperty.encoding = __smallIntegerVal(utf8StringAtom);
+ titleProperty.format = 8;
+ titleProperty.nitems = __stringSize(utf8String);
+
+ ENTER_XLIB();
+ XSetIconName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(simpleString));
+ /* alternative settings for UTF8-Strings */
+ XSetWMIconName(myDpy, __WindowVal(aWindowId), &titleProperty);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setSaveUnder:yesOrNo in:aWindowId
+ "turn on/off save-under for a window"
+
+ <context: #return>
+%{
+
+ XSetWindowAttributes wa;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ if (__INST(hasSaveUnder) == true) {
+ wa.save_under = (yesOrNo == true) ? 1 : 0;
+ ENTER_XLIB();
+ XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWSaveUnder, &wa);
+ LEAVE_XLIB();
+ }
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setTransient:aWindowId for:aMainWindowId
+ "set aWindowId to be a transient of aMainWindow"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ Window w;
+
+ if ((aMainWindowId == nil) || (aMainWindowId == __MKSMALLINT(0))) {
+ w = (Window) 0;
+ } else {
+ if (__isExternalAddress(aMainWindowId)) {
+ w = __WindowVal(aMainWindowId);
+ } else {
+ goto getOutOfHere;
+ }
+ }
+ ENTER_XLIB();
+ XSetTransientForHint(myDpy, __WindowVal(aWindowId), w);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+ getOutOfHere: ;
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+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."
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isSmallInteger(aColorIndex)) {
+ ENTER_XLIB();
+ XSetWindowBackground(myDpy, __WindowVal(aWindowId), __intVal(aColorIndex));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+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."
+
+ <context: #return>
+%{ /* STACK: 64000 */
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isExternalAddress(aPixmapId)) {
+ ENTER_XLIB();
+ XSetWindowBackgroundPixmap(myDpy, __WindowVal(aWindowId), __PixmapVal(aPixmapId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowBorderColor:aColorIndex in:aWindowId
+ "set the windows border color"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isSmallInteger(aColorIndex)) {
+ ENTER_XLIB();
+ XSetWindowBorder(myDpy, __WindowVal(aWindowId), __intVal(aColorIndex));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowBorderPixmap:aPixmapId in:aWindowId
+ "set the windows border pattern"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isExternalAddress(aPixmapId)) {
+ ENTER_XLIB();
+ XSetWindowBorderPixmap(myDpy, __WindowVal(aWindowId), __PixmapVal(aPixmapId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowBorderShape:aPixmapId in:aWindowId
+ "set the windows border shape"
+
+ <context: #return>
+
+ hasShapeExtension ifFalse:[^ self].
+
+%{
+
+#ifdef SHAPE
+ Pixmap shapeBitmap;
+
+ if (__isExternalAddress(aPixmapId))
+ shapeBitmap = __PixmapVal(aPixmapId);
+ else
+ shapeBitmap = (Pixmap)0;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XShapeCombineMask(myDpy, __WindowVal(aWindowId), ShapeBounding,
+ 0, 0, shapeBitmap, ShapeSet);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+#endif
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowBorderWidth:aNumber in:aWindowId
+ "set the windows border width"
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)
+ && __isSmallInteger(aNumber)) {
+ ENTER_XLIB();
+ XSetWindowBorderWidth(myDpy, __WindowVal(aWindowId), __intVal(aNumber));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowClass:wClass name:wName in:aWindowId
+ "define class and name of a window.
+ This may be used by the window manager to
+ select client specific resources."
+
+ <context: #return>
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ XClassHint classhint;
+
+ classhint.res_class = classhint.res_name = 0;
+
+ if (__isStringLike(wClass)) {
+ classhint.res_class = (char *) __stringVal(wClass);
+ } else if (wClass != nil)
+ goto error;
+
+ if (__isStringLike(wName)) {
+ classhint.res_name = (char *) __stringVal(wName);
+ } else if (wName != nil)
+ goto error;
+
+ ENTER_XLIB();
+ XSetClassHint(myDpy, __WindowVal(aWindowId), &classhint);
+ LEAVE_XLIB();
+ RETURN ( self );
+error:;
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowGravity:how in:aWindowId
+ "set window gravity for a window"
+
+ <context: #return>
+%{
+
+ XSetWindowAttributes wa;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ if (how == @symbol(NorthWest)) {
+ wa.win_gravity = NorthWestGravity;
+ } else if (how == @symbol(NorthEast)) {
+ wa.win_gravity = NorthEastGravity;
+ } else if (how == @symbol(SouthWest)) {
+ wa.win_gravity = SouthWestGravity;
+ } else if (how == @symbol(SouthEast)) {
+ wa.win_gravity = SouthEastGravity;
+ } else if (how == @symbol(Center)) {
+ wa.win_gravity = CenterGravity;
+ } else if (how == @symbol(North)) {
+ wa.win_gravity = NorthGravity;
+ } else if (how == @symbol(South)) {
+ wa.win_gravity = SouthGravity;
+ } else if (how == @symbol(West)) {
+ wa.win_gravity = WestGravity;
+ } else if (how == @symbol(East)) {
+ wa.win_gravity = EastGravity;
+ } else {
+ wa.win_gravity = NorthWestGravity;
+ }
+
+
+ ENTER_XLIB();
+ XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWWinGravity, &wa);
+ LEAVE_XLIB();
+
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowIcon:aForm in:aWindowId
+ "define a bitmap to be used as icon"
+
+ <context: #return>
+
+ |iconId|
+
+ aForm notNil ifTrue:[
+ iconId := aForm id
+ ].
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(iconId)
+ && __isExternalAddress(aWindowId)) {
+ XWMHints hints;
+
+ hints.icon_pixmap = __PixmapVal(iconId);
+ hints.flags = IconPixmapHint;
+ ENTER_XLIB();
+ XSetWMHints(myDpy, __WindowVal(aWindowId), &hints);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowIcon:aForm mask:aMaskForm in:aWindowId
+ "define a windows icon and (optional) iconMask."
+
+ <context: #return>
+
+ |iconId maskId|
+
+ aForm notNil ifTrue:[
+ iconId := aForm id
+ ].
+ aMaskForm notNil ifTrue:[
+ maskId := aMaskForm id.
+ ].
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(iconId)
+ && __isExternalAddress(aWindowId)) {
+ XWMHints hints;
+
+ hints.icon_pixmap = __PixmapVal(iconId);
+ hints.flags = IconPixmapHint;
+ if ((maskId != nil)
+ && __isExternalAddress(maskId)) {
+ hints.icon_mask = __PixmapVal(maskId);
+ hints.flags |= IconMaskHint;
+ }
+ ENTER_XLIB();
+ XSetWMHints(myDpy, __WindowVal(aWindowId), &hints);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+
+!
+
+setWindowIconWindow:aView in:aWindowId
+ "define a window to be used as icon"
+
+ <context: #return>
+
+ |iconWindowId|
+
+ aView notNil ifTrue:[
+ iconWindowId := aView id
+ ].
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(iconWindowId)
+ && __isExternalAddress(aWindowId)) {
+ XWMHints wmhints;
+
+ wmhints.icon_window = __WindowVal(iconWindowId);
+ wmhints.flags = IconWindowHint;
+ ENTER_XLIB();
+ XSetWMHints(myDpy, __WindowVal(aWindowId), &wmhints);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowMinExtentX:minW y:minH maxExtentX:maxW y:maxH in:aWindowId
+ "set a windows minimum & max extents.
+ nil arguments are ignored."
+
+ <context: #return>
+%{
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ Display *dpy = myDpy;
+ XSizeHints szhints;
+ Window win;
+
+ win = __WindowVal(aWindowId);
+
+ szhints.flags = 0;
+ if (__bothSmallInteger(minW, minH)) {
+ szhints.flags |= PMinSize;
+ szhints.min_width = __intVal(minW);
+ szhints.min_height = __intVal(minH);
+ }
+ if (__bothSmallInteger(maxW, maxH)) {
+ szhints.flags |= PMaxSize;
+ szhints.max_width = __intVal(maxW);
+ szhints.max_height = __intVal(maxH);
+ }
+
+ if (szhints.flags) {
+ ENTER_XLIB();
+ XSetNormalHints(dpy, win, &szhints);
+ LEAVE_XLIB();
+ }
+ }
+%}.
+!
+
+setWindowName:aString in:aWindowId
+ "define a windows name"
+
+ <context: #return>
+
+ |utf8StringAtom utf8String simpleString|
+
+ utf8StringAtom := self atomIDOf:#UTF8_STRING create:true.
+
+ utf8String := aString utf8Encoded.
+ aString isWideString ifTrue:[
+ "/ X does not like 2-byte labels ...
+ simpleString := aString asSingleByteStringReplaceInvalidWith:$?
+ ] ifFalse:[
+ simpleString := aString.
+ ].
+
+%{
+
+ XTextProperty titleProperty;
+
+ if (ISCONNECTED
+ && __isStringLike(utf8String)
+ && __isStringLike(simpleString)
+ && __isExternalAddress(aWindowId)) {
+
+ titleProperty.value = __stringVal(utf8String);
+ titleProperty.encoding = __smallIntegerVal(utf8StringAtom);
+ titleProperty.format = 8;
+ titleProperty.nitems = __stringSize(utf8String);
+
+ ENTER_XLIB();
+ XStoreName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(simpleString));
+ /* alternative settings for UTF8-Strings */
+ XSetWMName(myDpy, __WindowVal(aWindowId), &titleProperty);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowPid:anIntegerOrNil in:aWindowId
+ "Sets the _NET_WM_PID property for the window.
+ This may be used by the window manager to group windows.
+ If anIntegerOrNil is nil, then PID of currently running
+ Smalltalk is used"
+
+ | propertyID typeId pid |
+
+ propertyID := self atomIDOf: '_NET_WM_PID' create: false.
+ propertyID isNil ifTrue:[ ^ self ].
+ pid := anIntegerOrNil isNil ifTrue:[OperatingSystem getProcessId] ifFalse:[anIntegerOrNil].
+ typeId := self atomIDOf:#'CARDINAL' create:false.
+
+ self setProperty:propertyID type:typeId value:pid for:aWindowId
+
+ "Created: / 04-01-2013 / 16:03:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+setWindowShape:aPixmapId in:aWindowId
+ "set the windows shape.
+ Returns false, if the display does not support the
+ X shape extension."
+
+ <context: #return>
+
+ hasShapeExtension ifFalse:[^ self].
+
+%{
+
+#ifdef SHAPE
+ Pixmap shapeBitmap;
+
+ if (__isExternalAddress(aPixmapId))
+ shapeBitmap = __PixmapVal(aPixmapId);
+ else
+ shapeBitmap = (Pixmap)0;
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XShapeCombineMask(myDpy, __WindowVal(aWindowId), ShapeClip,
+ 0, 0,
+ shapeBitmap, ShapeSet);
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+#endif
+%}.
+ self primitiveFailedOrClosedConnection
+!
+
+setWindowState:aSymbol in:aWindowId
+ "tell the window type to the window manager.
+ Send a specific message to the WindowManager"
+
+ |netWmWindowStateAtom stateAtom|
+
+ netWmWindowStateAtom := self atomIDOf:#'_NET_WM_WINDOW_STATE' create:false.
+ stateAtom := self atomIDOf:aSymbol create:false.
+
+ (netWmWindowStateAtom notNil and:[stateAtom notNil]) ifTrue:[
+ self
+ sendClientEvent:netWmWindowStateAtom
+ format:32
+ to:(self rootWindowId)
+ propagate:true
+ eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
+ window:aWindowId
+ data1:(self atomIDOf:#'_NET_WM_STATE_ADD' create:false)
+ data2:stateAtom
+ data3:nil
+ data4:1
+ data5:nil.
+ ] ifFalse:[self halt.].
+
+ "
+ |v|
+
+ v := TopView new create.
+ Display setWindowState:#'_NET_WM_WINDOW_STATE_STICKY' in:v id.
+ v open.
+ "
+!
+
+setWindowType:aSymbol in:aWindowId
+ "Tell the window type to the window manager.
+ See Extended Window Manager Hints 1.3,
+ chapter 'Application Window Properties'
+ http://standards.freedesktop.org/wm-spec/1.3/
+
+ JV@2012-05-15: There was some code prior 2012-05-15,
+ but that code does not work anymore and I wonder if it
+ ever worked correctly. I changed it to be
+ EWMH compatible, as this improve UX on modern Linxu
+ machines.
+
+ It also helps to fix super-annoying problem with window autoraiser
+ on X11 in a proper way - window manager should manage top-level
+ window stacking, that's why it is called a 'window manager' :-)
+
+ "
+
+ | nameAtom typeAtom valueAtom |
+
+ self assert:(#(_NET_WM_WINDOW_TYPE_DESKTOP
+ _NET_WM_WINDOW_TYPE_DOCK
+ _NET_WM_WINDOW_TYPE_TOOLBAR
+ _NET_WM_WINDOW_TYPE_MENU
+ _NET_WM_WINDOW_TYPE_UTILITY
+ _NET_WM_WINDOW_TYPE_SPLASH
+ _NET_WM_WINDOW_TYPE_DIALOG
+ _NET_WM_WINDOW_TYPE_NORMAL) includes: aSymbol).
+
+ nameAtom := self atomIDOf:#'_NET_WM_WINDOW_TYPE' create:false.
+ nameAtom isNil ifTrue:[
+ "/Hmm, no such property, not running under EWMH compliant WM?
+ self breakPoint: #jv.
+ ^self
+ ].
+ "/ Hmm, hmm, no access to XA_ATOM, XA_INTEGER and so on...
+ typeAtom := self atomIDOf:#'ATOM' create:false.
+ typeAtom isNil ifTrue:[
+ self error:'Oops, no ATOM atom'.
+ ].
+ valueAtom := self atomIDOf: aSymbol create:false.
+ valueAtom isNil ifTrue:[
+ "/Hmm, no such property, not running under EWMH compliant WM?
+ self breakPoint: #jv.
+ ^self
+ ].
+
+ self setProperty: nameAtom type: typeAtom value: valueAtom for: aWindowId.
+
+
+"/ Original code that does not work (if ever worked)
+"/
+"/ |netWmWindowTypeAtom typeAtom|
+"/
+"/ netWmWindowTypeAtom := self atomIDOf:#'_NET_WM_WINDOW_TYPE' create:false.
+"/ typeAtom := self atomIDOf:aSymbol create:false.
+"/
+"/ (netWmWindowTypeAtom notNil and:[typeAtom notNil]) ifTrue:[
+"/ self
+"/ sendClientEvent:netWmWindowTypeAtom
+"/ format:32
+"/ to:(self rootWindowId)
+"/ propagate:true
+"/ eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
+"/ window:aWindowId
+"/ data1:typeAtom
+"/ data2:nil
+"/ data3:nil
+"/ data4:nil
+"/ data5:nil.
+"/ ].
+
+ "
+ |v|
+
+ v := TopView new create.
+ Display setWindowType:#'_NET_WM_WINDOW_TYPE_DOCK' in:v id.
+ v open.
+
+ |v|
+
+ v := TopView new create.
+ Display setWindowType:#'_NET_WM_WINDOW_TYPE_UTILITY' in:v id.
+ v open.
+ "
+
+ "Modified (comment): / 15-05-2012 / 10:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
+!
+
+unmapWindow:aWindowId
+ "make a window invisible"
+
+ <context: #return>
+%{
+ /*
+ * ignore closed connection
+ */
+ if (! ISCONNECTED) {
+ RETURN ( self );
+ }
+
+ if (__isExternalAddress(aWindowId)) {
+ ENTER_XLIB();
+ XUnmapWindow(myDpy, __WindowVal(aWindowId));
+ LEAVE_XLIB();
+ RETURN ( self );
+ }
+%}.
+ self primitiveFailed
+!
+
+windowIsIconified:aWindowId
+ "return true, if some window is iconified.
+ The passed windowID may be an alien windows id."
+
+ <context: #return>
+%{
+
+ if (ISCONNECTED
+ && __isExternalAddress(aWindowId)) {
+ Atom JunkAtom;
+ int JunkInt;
+ unsigned long WinState,JunkLong;
+ unsigned char *Property;
+ Atom WM_STATE_Atom;
+
+ if (__INST(wmStateAtom) != nil) {
+ WM_STATE_Atom = __AtomVal(__INST(wmStateAtom));
+
+ ENTER_XLIB();
+ XGetWindowProperty(myDpy, __WindowVal(aWindowId),
+ WM_STATE_Atom,
+ 0L, 2L, False, AnyPropertyType,
+ &JunkAtom,&JunkInt,&WinState,&JunkLong,
+ &Property);
+ LEAVE_XLIB();
+ WinState=(unsigned long)(*((long*)Property));
+ if (WinState==3) {
+ RETURN (true);
+ }
+ }
+ RETURN (false);
+ }
+%}.
+ self primitiveFailedOrClosedConnection.
+ ^ false "/ or true or what ?
+! !
+
+!XWorkstation::SelectionFetcher class methodsFor:'documentation'!
+
+documentation
+"
+ This class is responsible for fetching the clipboard.
+ The X11 clipboard is implemented via asynchonous messages.
+
+ For each fetch operation an instance of this class is created.
+ The asynchronous messages are queued and executed in the
+ process that requests the clipboard.
+
+ [author:]
+ Stefan Vogel (stefan@zwerg)
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+
+"
+! !
+
+!XWorkstation::SelectionFetcher class methodsFor:'selections'!
+
+requestSelection:selectionId type:aTargetId onDevice:aDisplay for:aDrawableId
+ ^ self new requestSelection:selectionId type:aTargetId onDevice:aDisplay for:aDrawableId
+! !
+
+!XWorkstation::SelectionFetcher methodsFor:'accessing'!
+
+drawableID
+ ^ drawableID
+!
+
+getSelection
+ "convert the data in buffer to a selection"
+
+ |selection|
+
+ buffer isNil ifTrue:[
+ ^ nil.
+ ].
+
+ targetID == (display atomIDOf:#STRING) ifTrue:[
+ display clipboardEncoding notNil ifTrue:[
+ selection := buffer decodeFrom:display clipboardEncoding
+ ].
+ selection := buffer.
+ ] ifFalse:[targetID == (display atomIDOf:#'UTF8_STRING') ifTrue:[
+"/ Transcript show:'UTF8: '; showCR:buffer storeString.
+ selection := CharacterArray fromUTF8Bytes:buffer
+ ] ifFalse:[targetID == (display atomIDOf:#TEXT) ifTrue:[
+"/ Transcript show:'TEXT: '; showCR:buffer storeString.
+ selection := buffer asString
+ ] ifFalse:[targetID == (display atomIDOf:#'COMPOUND_TEXT') ifTrue:[
+"/ Transcript show:'COMPOUND_TEXT: '; showCR:buffer storeString.
+ selection := buffer asString
+ ]]]].
+
+ selection notNil ifTrue:[
+ (selection endsWith:Character cr) ifTrue:[
+ selection := selection asStringCollection copyWith:''
+ ].
+ ^ selection.
+ ].
+
+ targetID == (display atomIDOf:#'TARGETS') ifTrue:[
+ ^ buffer
+ ].
+ targetID == (display atomIDOf:#'ST_OBJECT') ifTrue:[
+ "require libboss to be loaded"
+ (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
+ 'SelectionFetch: cannot decode object (libboss library missing)' errorPrintCR.
+ ^ nil
+ ].
+ ^ (Object
+ readBinaryFrom:(ReadStream on:buffer)
+ onError:[:ex |
+ ('SelectionFetch: error while decoding binary object: ',ex description) errorPrintCR.
+ nil
+ ])
+ ].
+
+ 'XWorkstation: unimplemented property targetID: ' infoPrint. (display atomName:targetID) infoPrint.
+ ' buffer:' infoPrint. buffer infoPrintCR.
+ ^ nil
+
+ "Modified: / 23-08-2006 / 15:56:04 / cg"
+! !
+
+!XWorkstation::SelectionFetcher methodsFor:'event handling'!
+
+message:aMessage
+ "got an asynchronous event from the display.
+ Save and wake up waiters"
+
+ aMessage selector == #propertyChange:property:state:time: ifTrue:[
+ (aMessage arguments at:2) ~~ propertyID ifTrue:[
+ "I am only interested in changes of the property used to
+ store the selection"
+ ^ self.
+ ].
+ message notNil ifTrue:[
+ "this should not happen - bad selection holder?"
+ 'XWorkstation(error): message overflow: ' errorPrint. display errorPrintCR.
+ ^ self.
+ ].
+ ].
+
+ "we get a propertyChange before the selectionNotify.
+ Since the propertyChange will be ignored anyway (because we are not in incremental mod,
+ a selectionNotify message may overwrite a propertyChange message"
+
+ message := aMessage.
+ sema signal.
+!
+
+propertyChange:aView property:aPropertyId state:stateSymbol time:time
+ "this is a forwarded propretyChange event from XWorkstation"
+
+ |property propertyValue|
+
+ incremental ifFalse:[
+ "ignore property changes until we are in incremental mode"
+ ^ self.
+ ].
+
+ property := display getProperty:propertyID from:drawableID delete:true.
+ propertyValue := property value.
+
+ propertyValue size == 0 ifTrue:[
+ "property with size 0 signals end of transfer"
+ done := true.
+ ] ifFalse:[
+ buffer isNil ifTrue:[
+ targetID := property key.
+ buffer := propertyValue.
+ ] ifFalse:[
+ targetID ~= property key ifTrue:[
+ 'XWorkstation(warning): targetID change in incremental select: ' errorPrint. display errorPrintCR.
+ ].
+ buffer := buffer, propertyValue.
+ ].
+ ].
+!
+
+selectionClear:aView selection:selectionId time:time
+ "sent when another X-client has created a selection.
+ This is a very X-specific mechanism."
+!
+
+selectionNotify:aView selection:aSelectionID target:aTargetID property:aPropertyID requestor:requestorID time:time
+ "this is a forwarded selectionNotify event from XWorkstation"
+
+ |property propertyKey atomName|
+
+ aSelectionID ~~ selectionID ifTrue:[
+ "ignore notification that is not for our selection"
+ ^ self.
+ ].
+
+ aPropertyID == 0 ifTrue:[
+ "the selection owner could not convert the selection to our target type"
+ done := true.
+ ^ self.
+ ].
+
+ property := display getProperty:aPropertyID from:drawableID delete:true.
+ property isNil ifTrue:[
+ "the property does not exist in the specified window"
+ done := true.
+ ^ self
+ ].
+
+ propertyKey := property key.
+ propertyKey == aTargetID ifTrue:[
+ "good, the property is consistent with our request.
+ The whole selection is in the property"
+ buffer := property value.
+ done := true.
+ ] ifFalse:[propertyKey == (display atomIDOf:#INCR) ifTrue:[
+ "this is an incremental transfer. Wait for property change"
+ incremental := true.
+ ] ifFalse:[
+ atomName := (display atomName:propertyKey) ? propertyKey.
+ 'XWorkstation(error): unexpected targetID (' errorPrint.
+ atomName errorPrint.
+ ') in selectionNotify: ' errorPrint.
+ display errorPrintCR.
+ done := true.
+ ]].
+! !
+
+!XWorkstation::SelectionFetcher methodsFor:'selection actions'!
+
+requestSelection:aSelectionId type:aTargetId onDevice:aDisplay for:aDrawableId
+ "request the selection of type targetId.
+ Wait for next asynchronous message and process it,
+ until done"
+
+ display := aDisplay.
+ drawableID := aDrawableId.
+ selectionID := aSelectionId.
+ propertyID := display atomIDOf:#'VT_SELECTION'.
+ targetID := aTargetId.
+ sema := Semaphore new name:'X11SelectionFetcher'.
+ done := false.
+ incremental := false.
+
+ [
+ |timeout|
+
+ display registerSelectionFetcher:self.
+
+ display
+ requestSelection:aSelectionId
+ type:aTargetId
+ for:drawableID
+ intoProperty:propertyID.
+
+ timeout := display xlibTimeout.
+ [
+ |currentMessage|
+
+ (sema waitWithTimeout:timeout) isNil ifTrue:[
+ "the selection owner didn't respond within reasonable time"
+ 'XWorkstation(error): selection owner does not respond:' infoPrint. display infoPrintCR.
+ ^ nil.
+ ].
+ currentMessage := message.
+ message := nil.
+ currentMessage notNil ifTrue:[currentMessage sendTo:self].
+ ] doUntil:[done].
+ ] ensure:[
+ display unregisterSelectionFetcher:self.
+ ].
+
+ ^ self getSelection
+! !
+
+!XWorkstation::SelectionFetcher methodsFor:'testing'!
+
+matchesDrawableId:aDrawableId
+ "return true, if this SelectionFetcher fetches for aDrawableId"
+
+ ^ drawableID = aDrawableId
+! !
+
+!XWorkstation::WindowGroupWindow class methodsFor:'documentation'!
+
+documentation
+"
+ A special window to serve as window group id. This window
+ is newer mapped. This window is used
+ in XWMHints & _NET_WM_LEADER properties to define
+ application window group
+
+ [author:]
+ Jan Vrany <jan.vrany@fit.cvut.cz>
+
+ [instance variables:]
+
+ [class variables:]
+
+ [see also:]
+ Inter-Client Communication Conventions Manual [http://tronche.com/gui/x/icccm/]
+
+
+"
+! !
+
+!XWorkstation::WindowGroupWindow methodsFor:'testing'!
+
+isICCCWindowGroupWindow
+ ^ true
+! !
+
+!XWorkstation::X11GraphicsContext methodsFor:'displaying'!
+
+displayString:aString x:x y:y 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."
+
+ <context: #return>
+
+ |displayId|
+
+ device flushIfAppropriate.
+ displayId := device displayIdOrErrorIfBroken.
+
+%{
+#if 0
+ GC gc;
+ Window win;
+ char *cp;
+ int n;
+ OBJ cls;
+# define NLOCALBUFFER 200
+ XChar2b xlatebuffer[NLOCALBUFFER];
+ int nInstBytes;
+
+ if (displayId != nil
+ && __isExternalAddress(__INST(gcId))
+ && __isExternalAddress(__INST(drawableId))
+ && __isNonNilObject(aString)
+ && __bothSmallInteger(x, y)) {
+ int lMax = __intVal(@global(XWorkstation:MaxStringLength));
+ Display *dpy = __DisplayVal(displayId);
+ gc = __GCVal(__INST(gcId));
+ win = __WindowVal(__INST(drawableId));
cp = (char *) __stringVal(aString);
@@ -4212,8856 +13279,19 @@
}
}
#undef NLOCALBUFFER
-%}.
- ^ super displayString:aString x:x y:y in:aDrawableId with:aGCId opaque:opaque
-!
-
-drawBits:givenBits bitsPerPixel:bitsPerPixel depth:imageDepth padding:givenPadding
- 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."
-
- |fmt padding bits wantedPadding|
-
- padding := givenPadding.
- bits := givenBits.
-
- "/ the XF86_VGA16 server seems to report an error when we pass it an
- "/ 8-bit padded image. (it wants it 32bit padded).
- "/ as a workaround, repad it here (although, the server and/or Xlib should
- "/ care for that.
-
- ((imageDepth == 4) and:[depth == 4]) ifTrue:[
- fmt := self supportedImageFormatForDepth:4.
- fmt isNil ifTrue:[
- self primitiveFailed. "/ cannot represent this image
- ^ nil
- ].
- wantedPadding := fmt at:#padding.
- wantedPadding > givenPadding ifTrue:[
- bits := self
- repadBits:givenBits
- width:imageWidth
- height:imageHeight
- depth:imageDepth
- from:givenPadding
- to:wantedPadding.
- padding := wantedPadding.
- ]
- ].
-
-
- operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
- ].
- "
- sorry; I had to separate it into 2 methods, since XPutImage needs
- an unlimited stack, and thus cannot send primitiveFailed
- "
- (self
- primDrawBits:bits
- bitsPerPixel:bitsPerPixel
- depth:imageDepth
- msb:true
- padding:padding
- 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 primitiveFailedOrClosedConnection
- ].
-!
-
-fillArcX:x y:y width:width height:height from:startAngle angle:angle
- in:aDrawableId with:aGCId
- "fill an arc. If any coordinate is not integer, an error is triggered.
- The angles may be floats or integer - they are given in degrees."
-
- <context: #return>
-
- operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
- ].
-%{
-
- GC gc;
- Window win;
- int w, h, angle1, angle2;
- double f;
-
- if (__isSmallInteger(startAngle))
- angle1 = __intVal(startAngle) * 64;
- else if (__isFloat(startAngle)) {
- f = __floatVal(startAngle);
- angle1 = f * 64;
- } else if (__isShortFloat(startAngle)) {
- f = __shortFloatVal(startAngle);
- angle1 = f * 64;
- } else goto bad;
-
- if (__isSmallInteger(angle))
- angle2 = __intVal(angle) * 64;
- else if (__isFloat(angle)) {
- f = __floatVal(angle);
- angle2 = f * 64;
- } else if (__isShortFloat(angle)) {
- f = __shortFloatVal(angle);
- angle2 = f * 64;
- } else goto bad;
-
- if (ISCONNECTED
- && __isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(x, y)
- && __bothSmallInteger(width, height)) {
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- w = __intVal(width);
- h = __intVal(height);
- /*
- * need this check here: some servers simply dump core with bad args
- */
- if ((w >= 0) && (h >= 0) && (angle1 >= 0) && (angle2 >= 0)) {
- ENTER_XLIB();
- XFillArc(myDpy, win, gc, __intVal(x), __intVal(y),
- w, h, angle1, angle2);
- LEAVE_XLIB();
- }
- RETURN ( self );
- }
- bad: ;
-%}.
- "badGC, badDrawable or coordinates not integer
- or non float angle(s)"
-
- self primitiveFailedOrClosedConnection
-!
-
-fillPolygon:aPolygon in:aDrawableId with:aGCId
- "fill a polygon given by its points.
- If any coordinate is not integer, an error is triggered."
-
- <context: #return>
-
- |numberOfPoints|
-
- operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
- ].
- numberOfPoints := aPolygon size.
-%{
- GC gc;
- Window win;
- OBJ point, x, y;
- int i, num;
- XPoint *points;
- XPoint qPoints[100];
- int mustFree = 0;
-
- if (ISCONNECTED
- && __isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __isSmallInteger(numberOfPoints)) {
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- num = __intVal(numberOfPoints);
- if (num < 3) {
- RETURN ( self );
- }
- /*
- * avoid (slow) malloc, if not many points
- */
- if (num > 100) {
- points = (XPoint *) malloc(sizeof(XPoint) * num);
- if (! points) goto fail;
- mustFree = 1;
- } else
- points = qPoints;
- for (i=0; i<num; i++) {
- point = __AT_(aPolygon, __MKSMALLINT(i+1));
- if (! __isPoint(point)) goto fail;
- x = _point_X(point);
- y = _point_Y(point);
- if (! __bothSmallInteger(x, y))
- goto fail;
- points[i].x = __intVal(x);
- points[i].y = __intVal(y);
- }
- ENTER_XLIB();
- XFillPolygon(myDpy, win, gc, points, num, Complex, CoordModeOrigin);
- LEAVE_XLIB();
- if (mustFree)
- free(points);
- RETURN ( self );
-
-fail: ;
- if (mustFree)
- free(points);
- }
-%}.
- "badGC, badDrawable or coordinates not integer"
- self primitiveFailedOrClosedConnection
-!
-
-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."
-
- <context: #return>
-
- operationsUntilFlush notNil ifTrue:[
- operationsUntilFlush <= 0 ifTrue:[
- self flush.
- ] ifFalse:[
- operationsUntilFlush := operationsUntilFlush - 1.
- ].
- ].
-%{
-
- int w, h;
-
- if (ISCONNECTED
- && __isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(x, y)
- && __bothSmallInteger(width, height)) {
- w = __intVal(width);
- h = __intVal(height);
- /*
- * need this check here: some servers simply dump core with bad args
- */
- if ((w >= 0) && (h >= 0)) {
- ENTER_XLIB();
- XFillRectangle(myDpy,
- __DrawableVal(aDrawableId), __GCVal(aGCId),
- __intVal(x), __intVal(y), w, h);
- LEAVE_XLIB();
- }
- RETURN ( self );
- }
-%}.
- "badGC, badDrawable or coordinates not integer"
- self primitiveFailedOrClosedConnection
-!
-
-primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth msb:msb masks:maskArray padding:bitPadding
- extent:imageExtent sourceOrigin:srcOrg
- into:aDrawableId
- destinationOrigin:dstOrg extent:dstExtent
- with:aGCId
-
- <context: #return>
-
- |imageWidth imageHeight rm gm bm srcx srcy dstx dsty w h|
-
- imageWidth := imageExtent x.
- imageHeight := imageExtent y.
- rm := maskArray at:1.
- gm := maskArray at:2.
- bm := maskArray at:3.
- srcx := srcOrg x.
- srcy := srcOrg y.
- dstx := dstOrg x.
- dsty := dstOrg y.
- w := dstExtent x.
- h := dstExtent y.
-
- "since XPutImage may allocate huge amount of stack space
- (some implementations use alloca), this must run with unlimited stack."
-
-%{ /* UNLIMITEDSTACK */
-
- /*
- * need unlimited stack, since some Xlibs do a huge alloca in
- * XPutImage
- */
- GC gc;
- Window win;
- XImage image;
- int imgWdth;
-
- if (ISCONNECTED
- && __isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(srcx, srcy)
- && __bothSmallInteger(dstx, dsty)
- && __bothSmallInteger(w, h)
- && __bothSmallInteger(imageWidth, imageHeight)
- && __bothSmallInteger(imageDepth, bitsPerPixel)
- && __isSmallInteger(bitPadding)
- && __bothSmallInteger(rm, gm)
- && __isSmallInteger(bm)
- && __isByteArrayLike(imageBits)) {
- Display *dpy = myDpy;
- int pad = __intVal(bitPadding);
-
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- if (! gc || !win)
- goto fail;
-#ifdef ARGDEBUG
- console_printf("args ok\n");
-#endif
- image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
- image.width = imgWdth = __intVal(imageWidth);
- image.height = __intVal(imageHeight);
- image.xoffset = 0;
- image.format = ZPixmap;
- image.byte_order = (msb == true) ? MSBFirst : LSBFirst;
- image.bitmap_unit = 8;
- image.bitmap_bit_order = MSBFirst;
- image.bitmap_pad = pad;
- image.depth = __intVal(imageDepth);
- image.bits_per_pixel = __intVal(bitsPerPixel);
- image.red_mask = __intVal(rm);
- image.green_mask = __intVal(gm);
- image.blue_mask = __intVal(bm);
-
- image.bytes_per_line = ((((imgWdth * image.bits_per_pixel) + (pad-1)) / pad) * pad) / 8;
-
- switch (image.bits_per_pixel) {
- case 1:
- case 2:
- case 4:
- case 8:
- case 16:
- case 24:
- case 32:
- break;
-
- default:
-#ifdef ARGDEBUG
- console_printf("bits_per_pixel=%d\n",image.bits_per_pixel);
-#endif
- goto fail;
- }
-
- /* ENTER_XLIB(); */
- XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
- __intVal(dstx), __intVal(dsty),
- __intVal(w), __intVal(h));
- /* LEAVE_XLIB(); */
-
- RETURN ( true );
- }
-#ifdef ARGDEBUG
- if (!! __isExternalAddress(aGCId)) console_printf("GC\n");
- if (!! __isExternalAddress(aDrawableId)) console_printf("aDrawableId\n");
- if (!! __isSmallInteger(srcx)) console_printf("srcx\n");
- if (!! __isSmallInteger(srcy)) console_printf("srcy\n");
- if (!! __isSmallInteger(dstx)) console_printf("dstx\n");
- if (!! __isSmallInteger(dsty)) console_printf("dsty\n");
- if (!! __isSmallInteger(w)) console_printf("w\n");
- if (!! __isSmallInteger(h)) console_printf("h\n");
- if (!! __isSmallInteger(imageWidth)) console_printf("imageWidth\n");
- if (!! __isSmallInteger(imageHeight)) console_printf("imageHeight\n");
- if (!! __isSmallInteger(imageDepth)) console_printf("imageDepth\n");
- if (!! __isSmallInteger(bitsPerPixel)) console_printf("bitsPerPixel\n");
- if (!! __isByteArrayLike(imageBits)) console_printf("imageBits\n");
-#endif
-
-fail: ;
-%}
-.
- ^ false
-!
-
-primDrawBits:imageBits bitsPerPixel:bitsPerPixel depth:imageDepth msb:msb padding:bitPadding
- width:imageWidth height:imageHeight
- x:srcx y:srcy
- into:aDrawableId
- x:dstx y:dsty
- width:w height:h
- with:aGCId
-
- <context: #return>
-
- "since XPutImage may allocate huge amount of stack space
- (some implementations use alloca), this must run with unlimited stack."
-
-%{ /* UNLIMITEDSTACK */
-
- /*
- * need unlimited stack, since some Xlibs do a huge alloca in
- * XPutImage
- */
- GC gc;
- Window win;
- XImage image;
- int imgWdth;
-
- if (ISCONNECTED
- && __isExternalAddress(aGCId)
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(srcx, srcy)
- && __bothSmallInteger(dstx, dsty)
- && __bothSmallInteger(w, h)
- && __bothSmallInteger(imageWidth, imageHeight)
- && __bothSmallInteger(imageDepth, bitsPerPixel)
- && __isSmallInteger(bitPadding)
- && __isByteArrayLike(imageBits)) {
- Display *dpy = myDpy;
- int pad = __intVal(bitPadding);
-
- gc = __GCVal(aGCId);
- win = __WindowVal(aDrawableId);
- if (! gc || !win)
- goto fail;
-#ifdef ARGDEBUG
- console_printf("args ok\n");
-#endif
- image.data = (char *)__ByteArrayInstPtr(imageBits)->ba_element;
- image.width = imgWdth = __intVal(imageWidth);
- image.height = __intVal(imageHeight);
- image.xoffset = 0;
- image.format = ZPixmap;
- image.byte_order = (msb == true) ? MSBFirst : LSBFirst;
- image.bitmap_unit = 8;
- image.bitmap_bit_order = MSBFirst;
- image.bitmap_pad = pad;
- image.depth = __intVal(imageDepth);
- image.bits_per_pixel = __intVal(bitsPerPixel);
-
- /*
- image.bytes_per_line = ((((imgWdth * image.depth) + (pad-1)) / pad) * pad) / 8;
- */
- image.bytes_per_line = ((((imgWdth * image.bits_per_pixel) + (pad-1)) / pad) * pad) / 8;
-
- switch (image.bits_per_pixel) {
- case 1:
- case 2:
- case 4:
- case 8:
- case 16:
- case 24:
- case 32:
- break;
-
- default:
-#ifdef ARGDEBUG
- console_printf("bits_per_pixel=%d\n",image.bits_per_pixel);
-#endif
- goto fail;
- }
-
- image.red_mask = 0xFFFF;
- image.green_mask = 0xFFFF;
- image.blue_mask = 0xFFFF;
-
- /* ENTER_XLIB(); */
- XPutImage(dpy, win, gc, &image, __intVal(srcx), __intVal(srcy),
- __intVal(dstx), __intVal(dsty),
- __intVal(w), __intVal(h));
- /* LEAVE_XLIB(); */
-
- RETURN ( true );
- }
-#ifdef ARGDEBUG
- if (!! __isExternalAddress(aGCId)) console_printf("GC\n");
- if (!! __isExternalAddress(aDrawableId)) console_printf("aDrawableId\n");
- if (!! __isSmallInteger(srcx)) console_printf("srcx\n");
- if (!! __isSmallInteger(srcy)) console_printf("srcy\n");
- if (!! __isSmallInteger(dstx)) console_printf("dstx\n");
- if (!! __isSmallInteger(dsty)) console_printf("dsty\n");
- if (!! __isSmallInteger(w)) console_printf("w\n");
- if (!! __isSmallInteger(h)) console_printf("h\n");
- if (!! __isSmallInteger(imageWidth)) console_printf("imageWidth\n");
- if (!! __isSmallInteger(imageHeight)) console_printf("imageHeight\n");
- if (!! __isSmallInteger(imageDepth)) console_printf("imageDepth\n");
- if (!! __isSmallInteger(bitsPerPixel)) console_printf("bitsPerPixel\n");
- if (!! __isByteArrayLike(imageBits)) console_printf("imageBits\n");
-#endif
-
-fail: ;
-%}
-.
- ^ false
-! !
-
-!XWorkstation methodsFor:'event forwarding'!
-
-buttonMotion:view state:state x:x y:y rootX:rX rootY:rY time:time
- "forward a buttonMotion event for some view"
-
- lastEventTime := time.
- self buttonMotion:state x:x y:y view:view
-!
-
-buttonPress:view button:button state:state x:x y:y rootX:rX rootY:rY time:time
- "forward a buttonPress event for some view"
-
- |logicalButton|
-
- lastEventTime := time.
- altDown := state bitTest:altModifierMask.
- metaDown := state bitTest:metaModifierMask.
- shiftDown := state bitTest:(self shiftModifierMask).
- ctrlDown := state bitTest:(self ctrlModifierMask).
-
- eventRootX := rX.
- eventRootY := rY.
-
- "/ physical to logical button translation
- logicalButton := buttonTranslation at:button ifAbsent:button.
-
- "/ special for mouse-wheel implementation
- (logicalButton == #wheelFwd or:[logicalButton == #wheelBwd]) ifTrue:[
- self mouseWheelMotion:state x:x y:y amount:(logicalButton == #wheelFwd ifTrue:[10] ifFalse:[-10]) deltaTime:10 view:view.
- ^ self.
- ].
-
- logicalButton isInteger ifTrue:[
- buttonsPressed := buttonsPressed bitOr:(1 bitShift:logicalButton-1).
- ].
-
- (multiClickTimeDelta notNil and:[lastButtonPressTime notNil]) ifTrue:[
- time < (lastButtonPressTime + multiClickTimeDelta) ifTrue:[
- lastButtonPressTime := time.
- self buttonMultiPress:logicalButton x:x y:y view:view.
- ^ self.
- ].
- ].
- lastButtonPressTime := time.
-
- view isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
- ].
- logicalButton == 1 ifTrue:[
- activateOnClick == true ifTrue:[
- "/ dont raise above an active popup view.
- (activeKeyboardGrab isNil and:[activePointerGrab isNil]) ifTrue:[
- view topView raise.
- ]
- ].
- ].
- super buttonPress:logicalButton x:x y:y view:view
-!
-
-buttonRelease:view button:button state:state x:x y:y rootX:rX rootY:rY time:time
- "forward a buttonPress event for some view"
-
- |logicalButton|
-
- lastEventTime := time.
- altDown := state bitTest:altModifierMask.
- metaDown := state bitTest:metaModifierMask.
- shiftDown := state bitTest:(self shiftModifierMask).
- ctrlDown := state bitTest:(self ctrlModifierMask).
-
- eventRootX := rX.
- eventRootY := rY.
-
- "/ physical to logical button translation
- logicalButton := buttonTranslation at:button ifAbsent:button.
-
- "/ special for HPs mouse-wheel implementation
- (logicalButton == #wheelFwd or:[logicalButton == #wheelBwd]) ifTrue:[
- ^ self
- ].
-
- logicalButton isInteger ifTrue:[
- buttonsPressed := buttonsPressed bitClear:(1 bitShift:logicalButton-1).
- ].
- self buttonRelease:logicalButton x:x y:y view:view
-!
-
-clientMessage:targetView type:typeAtom format:format data:data
- |sensor|
-
- targetView isNil ifTrue:[
- "targetView is gone? Anyway, cannot do anything with this event..."
- ^ self.
- ].
-
- "DND drag&drop protocol"
- (format == 32 and:[typeAtom == (self atomIDOf:#DndProtocol)]) ifTrue:[
- self dndMessage:nil data:data view:targetView.
- ^ self.
- ].
-
- sensor := targetView sensor.
- "not posted, if there is no sensor ..."
- sensor notNil ifTrue:[
- sensor clientMessage:typeAtom format:format eventData:data view:targetView
- ].
-
- "Created: 4.4.1997 / 17:49:26 / cg"
-!
-
-configure:view x:x y:y width:w height:h above:above
- "forward a size-change event for some view"
-
- self configureX:x y:y width:w height:h view:view.
- above notNil ifTrue:[
- |aboveView|
- aboveView := self viewFromId:above.
- aboveView notNil ifTrue:[
- "view is now on the top of the window stack"
- self coveredBy:view view:aboveView.
- ].
- ].
-!
-
-createWindow:view x:x y:y width:w height:h
-
- view isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
- ].
- view sensor createWindow:view x:x y:y width:w height:h
-
- "Created: / 30-05-2011 / 16:05:47 / Jan Vrany <jan.vrany@fit.cvut.cz>"
- "Modified: / 30-05-2011 / 19:00:40 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-dndMessage:event data:data view:targetView
- "handle a drag&drop protocol message"
-
- |sensor property dropType dropValue names i1 i2 propertyType|
-
- dropType := data doubleWordAt:1.
-
- "/ see def's in DragAndDropTypes.h
- dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
-
- property := self
- getProperty:(self atomIDOf:#DndSelection)
- from:rootId
- delete:false.
-
- propertyType := property key.
- dropValue := property value.
-
- "/ preconvert into a collection
- "/ of fileNames, string or byteArray
- "/ Notice: we do not yet convert into dropObjects
- "/ here, to allow arbitrary data to be handled by
- "/ redefined dropMessage methods in applications.
- "/ Conversion is done for some well known types
- "/ in the default dropMessage handling of SimpleView.
-
- dropType == #DndFiles ifTrue:[
- "/ actually, a list of fileNames
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
-
- names := OrderedCollection new.
- i1 := 1.
- [i1 ~~ 0] whileTrue:[
- i2 := dropValue indexOf:(Character value:0) startingAt:i1.
- i2 ~~ 0 ifTrue:[
- names add:(dropValue copyFrom:i1 to:(i2-1)).
- i1 := i2 + 1.
- ] ifFalse:[
- i1 := i2
- ].
- ].
- dropValue := names.
- dropValue := dropValue collect:[:nm | nm asFilename].
- dropType := #files.
- ] ifFalse:[ (dropType == #DndFile) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropValue := dropValue asFilename.
- dropType := #file.
- ] ifFalse:[ (dropType == #DndDir) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropValue := dropValue asFilename.
- dropType := #directory.
- ] ifFalse:[ (dropType == #DndText) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropType := #text.
- ] ifFalse:[ (dropType == #DndExe) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropType := #executable.
- ] ifFalse:[ (dropType == #DndLink) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropType := #link.
- ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
- dropType := #rawData.
- ] ifFalse:[
- 'XWorkstation [info]: unsupported dropType: ' infoPrint. dropType infoPrintCR.
- 'XWorkstation [info]: data: ' infoPrint. dropValue infoPrintCR.
- dropType := #unknown.
- ]]]]]]].
-
- sensor := targetView sensor.
- "not posted, if there is no sensor ..."
- sensor notNil ifTrue:[
- sensor dropMessage:dropType data:dropValue view:targetView position:nil handle:nil
- ].
-
- "Created: 4.4.1997 / 17:59:37 / cg"
-!
-
-expose:view x:x y:y width:w height:h count:count
- "forward an expose event for some view"
-
- self exposeX:x y:y width:w height:h view:view.
-
-
-
-
-!
-
-focusIn:view mode:mode detail:detail
- "a view got the keyboard focus"
-
- mode ~~ 1 "NotifyGrab" ifTrue:[
- "mode NotifyGrab is set for pseudo-focus-changes, when a view grabs the keyboard"
- self focusInView:view
- ].
-!
-
-focusOut:view mode:mode detail:detail
- "a view lost the keyboard focus"
-
- mode ~~ 1 "NotifyGrab" ifTrue:[
- "mode NotifyGrab is set for pseudo-focus-changes, when a view grabs the keyboard"
- self focusOutView:view
- ].
-!
-
-graphicsExpose:view x:x y:y width:w height:h count:count
- "forward a graphics-expose event for some view"
-
- self graphicsExposeX:x y:y width:w height:h final:(count==0) view:view
-
-
-
-
-!
-
-keyPress:view key:key code:keyCode state:state x:x y:y rootX:rX rootY:rY time:time
- "forward a key-press event for some view"
-
- |commonKey|
-
- lastEventTime := time.
- altDown := state bitTest:altModifierMask.
- metaDown := state bitTest:metaModifierMask.
- shiftDown := state bitTest:(self shiftModifierMask).
- ctrlDown := state bitTest:(self ctrlModifierMask).
- key isNil ifTrue:[
- "/ happens sometimes on some systems
- "/ (alt-graph on sun has no keysym)
- ^ self
- ].
- eventRootX := rX.
- eventRootY := rY.
-
- "very low-level mapping of X11 event symbols to common ST/X event symbols"
- commonKey := rawKeySymTranslation at:key ifAbsent:key.
-
- self keyPress:commonKey x:x y:y view:view.
-!
-
-keyRelease:view key:key code:keyCode state:state x:x y:y rootX:rX rootY:rY time:time
- "forward a key-release event for some view"
-
- |commonKey|
-
- lastEventTime := time.
- altDown := state bitTest:altModifierMask.
- metaDown := state bitTest:metaModifierMask.
- shiftDown := state bitTest:(self shiftModifierMask).
- ctrlDown := state bitTest:(self ctrlModifierMask).
-
- key isNil ifTrue:[
- "/ happens sometimes on some systems
- "/ (alt-graph on sun has no keysym)
- ^ self
- ].
- eventRootX := rX.
- eventRootY := rY.
-
- "very low-level mapping of X11 event symbols to common ST/X event symbols"
- commonKey := rawKeySymTranslation at:key ifAbsent:key.
-
- self keyRelease:commonKey x:x y:y view:view.
-!
-
-mappingNotify:view request:what event:eB
- "One of Keyboard-, Modifier- or PointerMap has changed, probably by xmodmap.
- Tell xlib about the fact."
-
- (what == #mappingKeyboard or:[what == #mappingModifier]) ifTrue:[
- self refreshKeyboardMapping:eB.
- "Maybe some of our modifiers have been changed"
- self initializeModifierMappings.
- ].
-
-!
-
-pointerEnter:view x:x y:y rootX:rX rootY:rY state:state mode:mode detail:detail time:time
- "forward a pointer enter event for some view"
-
- lastEventTime := time.
- altDown := state bitTest:altModifierMask.
- metaDown := state bitTest:metaModifierMask.
- shiftDown := state bitTest:(self shiftModifierMask).
- ctrlDown := state bitTest:(self ctrlModifierMask).
-
- eventRootX := rX.
- eventRootY := rY.
- self pointerEnter:state x:x y:y view:view
-!
-
-pointerLeave:view x:x y:y rootX:rX rootY:rY state:state mode:mode detail:detail time:time
- "forward a pointer leave event for some view"
-
- lastEventTime := time.
- altDown := state bitTest:altModifierMask.
- metaDown := state bitTest:metaModifierMask.
- shiftDown := state bitTest:(self shiftModifierMask).
- ctrlDown := state bitTest:(self ctrlModifierMask).
-
- eventRootX := rX.
- eventRootY := rY.
- self pointerLeave:state view:view
-!
-
-propertyChange:aView property:propertyId state:aSymbol time:time
- "sent when an X property changes.
- This is a very X-specific mechanism."
-
- |selectionFetcher|
-
- lastEventTime := time.
- aView isNil ifTrue:[
- "event arrived, after aView has been destroyed"
- ^ self
- ].
-
-"/ 'propertyChange ' infoPrint. (self atomName:propertyId) print. ': ' print. aSymbol printCR.
-"/ aView propertyChange:atom state:aSymbol.
-
- "JV@2011-01-06: Forward this event to views, they may
- be interested (for now, only XEmbedSiteView is)"
-
- aView sensor propertyChange:aView property:propertyId state:aSymbol time:time.
-
- aSymbol ~~ #newValue ifTrue:[
- "I am not interested in delete notifications"
- ^ self.
- ].
- selectionFetcher := self findSelectionFetcher:aView id.
- selectionFetcher notNil ifTrue:[
- selectionFetcher message:thisContext message.
- ].
-
- "Modified: / 01-06-2011 / 13:40:01 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-selectionClear:aView selection:selectionID time:time
- "sent when another X-client has created a selection.
- This is a very X-specific mechanism."
-
- |selectionFetcher|
-
- lastEventTime := time.
-
- selectionHandlers notNil ifTrue:[
- selectionHandlers do:[:eachHandler |
- eachHandler selectionClear:selectionID
- ]
- ].
-
- aView isNil ifTrue:[
- "event arrived, after aView has been destroyed"
- ^ self
- ].
- selectionFetcher := self findSelectionFetcher:aView id.
- selectionFetcher notNil ifTrue:[
- selectionFetcher message:thisContext message.
- ].
-!
-
-selectionNotify:aView selection:selectionID target:targetID property:propertyID requestor:requestorID time:time
- "This event is sent by the selection owner as a response to our request for a selection.
- This is a very X-specific mechanism."
-
- |selectionFetcher|
-
-"/ Transcript show:'seletionNotify selID:'.
-"/ Transcript show:selectionID; show:' ('; show:(self atomName:selectionID); show:') '.
-"/ Transcript show:' targetID:'.
-"/ Transcript show:targetID; show:' ('; show:(self atomName:targetID); show:') '.
-"/ Transcript show:' propertyID:'.
-"/ Transcript show:propertyID; show:' ('; show:(self atomName:propertyID); show:') '.
-"/ Transcript showCR:''.
-"/ Transcript endEntry.
-
- lastEventTime := time.
-
- aView isNil ifTrue:[
- "event arrived, after aView has been destroyed"
- ^ self
- ].
- selectionFetcher := self findSelectionFetcher:aView id.
- selectionFetcher notNil ifTrue:[
- selectionFetcher message:thisContext message.
- ].
-!
-
-selectionRequest:aView requestor:requestorID selection:selectionID target:targetID property:propertyID time:time
- "sent by some other X-client to ask for the selection.
- This is a very X-specific mechanism."
-
- |selection property bufferGetSelector responseTargetID selectionTime|
-
-"/'Selection: ' print. (self atomName:selectionID) printCR. ' TargetId: ' print. (self atomName:targetID) printCR.
-"/' Property: ' print. (self atomName:propertyID) printCR. ' Requestor: ' print. requestorID printCR.
-
- lastEventTime := time.
-
- "JV@2012-03-27: Support both PRIMARY and CLIPBOARD selections"
- selectionID == primaryAtom ifTrue:[
- bufferGetSelector := #getPrimaryBuffer.
- selectionTime := primarySelectionTime.
- ] ifFalse:[
- bufferGetSelector := #getCopyBuffer.
- selectionTime := clipboardSelectionTime.
- ].
-
- (targetID == (self atomIDOf:#TIMESTAMP)) ifTrue:[
- "the other view wants to know when we acquired ownership of the selection"
- responseTargetID := self atomIDOf:#INTEGER.
- selection := selectionTime.
- ] ifFalse:[(targetID == (self atomIDOf:#TARGETS)) ifTrue:[
- "the other view wants to know which targets we support"
- responseTargetID := self atomIDOf:#ATOM.
- selection := self supportedTargetAtoms.
- ] ifFalse:[
- selection := self selectionBuffer:bufferGetSelector as:targetID.
- responseTargetID := selection key.
- selection := selection value.
- ]].
-
-"/'Send selection: ' print. selection printCR.
-
- property := propertyID.
-
- selection isNil ifTrue:[
- "sending property None tells the client,
- that I could not convert"
-"/ ('XWorkstation: unsupported selection target ', (self atomName:targetID)) errorPrintCR.
- property := nil.
- responseTargetID := targetID.
- ] ifFalse:[
- property == 0 ifTrue:[
- "Support old (obsolete) clients requesting a None property.
- Set the propertyID to the targetID"
- property := responseTargetID.
- ].
- self setProperty:property
- type:responseTargetID
- value:selection
- for:requestorID.
- ].
-
- self sendNotifySelection:selectionID
- property:property
- target:responseTargetID
- time:time
- to:requestorID.
-
- "Modified: / 27-03-2012 / 15:22:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-visibilityNotify:aView state:how
-
- aView notNil ifTrue:[
- aView visibilityChange:how
- ]
-! !
-
-!XWorkstation methodsFor:'event forwarding-ignored events'!
-
-circulateNotify:aView place:aSymbol
- "sent, when the stacking order changes.
- ignored for now."
-
-!
-
-circulateRequest:aView place:aSymbol
- "sent, when the stacking order is about to change.
- ignored for now."
-!
-
-colorMapNotify:aView state:aBoolean
- "sent, when another colormap is installed.
- This is a very X-specific mechanism."
-
- aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
- ].
- "/ not yet implemented
- "/ aView colorMapChange
-!
-
-configureRequest:view x:x y:y width:w height:h above:above detail:detail
- "ignored for now"
-
- "/ view configureRequest
-!
-
-gravityNotify:aView x:x y:y
- "ignored for now"
-
- "/ aView gravityNotify
-!
-
-keymapNotify:aView
- "ignore for now"
-
-!
-
-mapRequest:aView
- "ignored for now"
-
- "/ aView mapRequest
-!
-
-reparentedView:aView parentId:parentId x:x y:y
- "ignored for now"
-
- "/ aView reparented
-!
-
-resizeRequest:aView width:width height:height
- "ignored for now"
-
- "/ aView resizeRequest
-! !
-
-!XWorkstation methodsFor:'event handling'!
-
-defaultEventMask
- "return a mask to enable some events by default."
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT( ExposureMask | StructureNotifyMask |
- KeyPressMask | KeyReleaseMask |
- PointerMotionMask |
- EnterWindowMask | LeaveWindowMask |
- ButtonPressMask | ButtonMotionMask | ButtonReleaseMask |
- PropertyChangeMask ));
-%}
-!
-
-dispatchEvent:evArray
- |viewId view evType arguments|
-
- viewId := evArray at:1.
- viewId notNil ifTrue:[
- viewId = lastId ifTrue:[
- view := lastView
- ] ifFalse:[
- view := self viewFromId:viewId
- ].
- ].
-
- evType := evArray at:3.
-
- (self respondsTo:evType) ifTrue:[
- arguments := evArray copyFrom:3 to:(3 + evType numArgs - 1).
- arguments at:1 put:view.
-
- self perform:evType withArguments:arguments.
- ^ true.
- ].
-'********** unhandled event:' errorPrintCR.
-evType errorPrintCR. (evArray at:2) errorPrintCR.
-'********** see dispatchEvent' errorPrintCR.
- ^ false
-!
-
-dispatchEventFor:aViewIdOrNil withMask:eventMask
- "central event handling method:
- get next event and send appropriate message to the sensor or view.
- If the argument aViewIdOrNil is nil, events for any view are processed,
- otherwise only events for the view with given id are processed.
- If the argument aMask is nonNil, only events for this eventMask are
- handled.
- WARNING: this may block to wait for an event - you better check for a
- pending event before calling this."
-
- |eventArray|
-
- eventArray := Array new:13.
-
- (self getEventFor:aViewIdOrNil withMask:eventMask into:eventArray) ifTrue:[
- AbortOperationRequest handle:[:ex |
- ex return
- ] do:[
- self dispatchEvent:eventArray.
- ]
- ].
-
- "Modified: 19.8.1997 / 17:10:42 / cg"
-!
-
-dispatchExposeEventFor:aViewIdOrNil
- "get next expose event and send appropriate message to the sensor or view.
- If the argument aViewIdOrNil is nil, events for any view are processed,
- otherwise only events for the view with given id are processed.
- WARNING: this may block to wait for an event - you better check for a
- pending event before calling this."
-
- self dispatchEventFor:aViewIdOrNil withMask:(self eventMaskFor:#expose)
-
- "Modified: 19.8.1997 / 17:10:26 / cg"
-!
-
-dispatchLoop
- preWaitAction := [self flush].
- Processor addPreWaitAction:preWaitAction.
- [
- super dispatchLoop
- ] ensure:[
- Processor removePreWaitAction:preWaitAction.
- preWaitAction := nil.
- ].
-!
-
-dispatchPendingEvents
- "central event handling method for modal operation.
- (i.e. this is now only used in the modal debugger)
- Dispatch any pending events; return when no more are pending.
- This code is somewhat special, since X has a concept of graphic
- expose events (which are sent after a bitblt). After such a bitblt,
- we only handle exposes until the graphicsExpose arrives.
- Other systems may not need such a kludge"
-
- "interested in exposes only ?"
-
- |eventArray|
-
- dispatchingExpose notNil ifTrue:[
- [self exposeEventPendingFor:dispatchingExpose withSync:false] whileTrue:[
- self dispatchExposeEventFor:dispatchingExpose
- ].
- ^ self
- ].
-
- [self eventPendingWithSync:false] whileTrue:[
- eventArray isNil ifTrue:[
- eventArray := Array new:13.
- ].
- (self getEventFor:nil withMask:nil into:eventArray) ifTrue:[
- AbortOperationRequest handle:[:ex |
- ex return
- ] do:[
- self dispatchEvent:eventArray.
- "/ multi-screen config: give others a chance
- "/ (needed because we run at high (non-timesliced) prio)
- Processor yield.
- ]
- ].
- ]
-
- "Modified: 19.8.1997 / 17:11:18 / cg"
-!
-
-disposeEventsWithMask:aMask for:aWindowIdOrNil
- "dispose (throw away) specific events. If aWindowId is nil,
- events matching the mask are thrown away regardless of which
- view they are for. Otherwise, only matching events for that
- view are flushed."
-
- <context: #return>
-%{ /* UNLIMITEDSTACK */
-
- XEvent ev;
- Window win;
-
- if (ISCONNECTED
- && __isSmallInteger(aMask)) {
- Display *dpy = myDpy;
-
- ENTER_XLIB();
- if (__isExternalAddress(aWindowIdOrNil)) {
- win = __WindowVal(aWindowIdOrNil);
- while (XCheckWindowEvent(dpy, win, __intVal(aMask), &ev)) ;;
- } else {
- while (XCheckMaskEvent(dpy, __intVal(aMask), &ev)) ;;
- }
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-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;
- else if (anEventSymbol == @symbol(substructureNotify)) m = SubstructureNotifyMask;
- else if (anEventSymbol == @symbol(substructureRedirect)) m = SubstructureRedirectMask;
- RETURN (__MKSMALLINT(m));
-%}
-!
-
-eventPending
- "return true, if any event is pending.
- This looks for both the internal queue and the display connection."
-
- "/ ConservativeSync is required for some Xlib implementation,
- "/ where eventPending returns wrong if we do not flush the buffer.
- "/ (especially Win32 & Xlib)
-
- ConservativeSync == true ifTrue:[self sync].
-
- dispatchingExpose notNil ifTrue:[
- ^ self exposeEventPendingFor:dispatchingExpose withSync:false
- ].
- ^ self eventPendingWithSync:false
-
- "Modified: / 28.4.1999 / 11:08:12 / cg"
-!
-
-eventPending:anEventSymbol for:aWindowIdOrNil
- "return true, if a specific event is pending"
-
- ^ self eventsPending:(self eventMaskFor:anEventSymbol) for:aWindowIdOrNil withSync:false
-!
-
-eventPending:anEventMask for:aWindowIdOrNil withSync:doSync
- "return true, if any of the masked events is pending"
-
- <context: #return>
-%{ /* UNLIMITEDSTACK */
-
- XEvent ev;
- Window win;
- int thereIsOne;
- OBJ rslt = false;
-
- if (ISCONNECTED && __isSmallInteger(anEventMask)) {
- Display *dpy = myDpy;
-
- ENTER_XLIB();
- if (doSync == true) {
- XSync(dpy, 0); /* make certain everything is flushed */
- }
- if (__isExternalAddress(aWindowIdOrNil)) {
- win = __WindowVal(aWindowIdOrNil);
- thereIsOne = XCheckWindowEvent(dpy, win, __intVal(anEventMask), &ev);
- } else {
- thereIsOne = XCheckMaskEvent(dpy, __intVal(anEventMask), &ev);
- }
- if (thereIsOne) {
- XPutBackEvent(dpy, &ev);
- rslt = true;
- }
- LEAVE_XLIB();
- }
- RETURN ( rslt );
-%}
-!
-
-eventPendingWithSync:doSync
- "return true, if any event is pending.
- If doSync is true, do a sync output buffer (i.e. send all to the display and wait until its processed)
- before checking."
-
- <context: #return>
-%{ /* UNLIMITEDSTACK */
- OBJ rslt = false;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- if (XEventsQueued(dpy, QueuedAlready)) {
- RETURN (true);
- }
-
- ENTER_XLIB();
- if (doSync == true) {
- XSync(dpy, 0); /* make certain everything is flushed */
- }
- if (XPending(dpy)) {
- rslt = true;
- }
- LEAVE_XLIB();
- }
- RETURN ( rslt );
-%}
-!
-
-eventQueued
- "return true, if any event is queued"
-
- dispatchingExpose notNil ifTrue:[
- ^ self exposeEventPendingFor:dispatchingExpose withSync:false
- ].
- ^ self eventQueuedAlready
-
- "Created: 12.12.1995 / 21:43:00 / stefan"
-!
-
-eventQueuedAlready
- "return true, if any event is queued internally.
- (i.e. in X's internal event queue, which is both filled by explicit
- nextEvent calls AND whenever drawing is done and events are pending on
- the display connection)."
-
-%{ /* UNLIMITEDSTACK */
- OBJ rslt = false;
-
- if (ISCONNECTED) {
- /* ENTER ... LEAVE not needed; XEventsQueued will not block */
- /* ENTER_XLIB(); */
- if (XEventsQueued(myDpy, QueuedAlready)) {
- rslt = true;
- }
- /* LEAVE_XLIB(); */
- }
- RETURN ( rslt );
-%}
-!
-
-exposeEventPendingFor:aWindowIdOrNil withSync:doSync
- "return true, if any expose event is pending for a specific view,
- or any view (if the arg is nil).
- This is an X specific, only required after a scroll operation."
-
- <context: #return>
-
-%{ /* UNLIMITEDSTACK */
-
- XEvent ev;
- Window win;
- int thereIsOne;
- OBJ rslt = false;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- ENTER_XLIB();
- if (doSync == true) {
- XSync(dpy, 0); /* make certain everything is flushed */
- }
- if (__isExternalAddress(aWindowIdOrNil)) {
- win = __WindowVal(aWindowIdOrNil);
- thereIsOne = XCheckWindowEvent(dpy, win, ExposureMask, &ev);
- } else {
- thereIsOne = XCheckMaskEvent(dpy, ExposureMask, &ev);
- }
- if (thereIsOne) {
- XPutBackEvent(dpy, &ev);
- rslt = true;
- }
- LEAVE_XLIB();
- }
- RETURN ( rslt );
-%}
-!
-
-getEventFor:aViewIdOrNil withMask:eventMask into:anEventArray
- "read next event if there is one and put events data into anEventArray.
- 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.
-
- The event fields are placed them into anEventArray (must be at least size 13):
- the fields are:
- 1: windowID
- 2: eventType-ID
- 3: eventTypeSymbol
-
- 4.. args
-
- Sorry I had to split dispatch into this fetch method and a separate
- handler method to allow UNLIMITEDSTACK here.
- (some Xlibs do a big alloca there which cannot be done in
- #dispatchEvent:, since it dispatches out into ST-methods).
- "
-
-%{ /* UNLIMITEDSTACK */
-
- Display *dpy;
- Window win, wWanted;
- int evMask, returnValue;
- XEvent ev;
- OBJ eB;
- KeySym keySym;
- unsigned char buffer[64];
- int i, nchars;
- char *keySymString;
- OBJ arg, sym, t, windowID;
-
- if (! ISCONNECTED) {
- RETURN (false);
- }
-
- dpy = myDpy;
-
- ev.type = 0;
-
- if (__isSmallInteger(eventMask)) {
- evMask = __intVal(eventMask);
- } else {
- evMask = ~0;
- }
-
- if (__isExternalAddress(aViewIdOrNil)) {
- wWanted = __WindowVal(aViewIdOrNil);
- returnValue = XCheckWindowEvent(dpy, wWanted, evMask, &ev);
- } else {
- if (evMask == ~0) {
- XNextEvent(dpy, &ev);
- returnValue = 1;
- } else {
- returnValue = XCheckMaskEvent(dpy, evMask, &ev);
- }
- }
- if (!returnValue) {
- /* there is no event */
- RETURN (false);
- }
-
- if (anEventArray == nil) {
- /* sender is not interested in the event */
- RETURN(true);
- }
-
- if (!__isArray(anEventArray)) {
- console_fprintf(stderr, "XWorkstation: bad argument [%d]\n", __LINE__);
- RETURN (false);
- }
- if (__arraySize(anEventArray) < 11) {
- console_fprintf(stderr, "XWorkstation: bad argument [%d]\n", __LINE__);
- RETURN (false);
- }
-
-# define ANYBUTTON (Button1MotionMask | Button2MotionMask | Button3MotionMask)
-
-# define ae ((XAnyEvent *)&ev)
-# define ee ((XExposeEvent *)&ev)
-# define ke ((XKeyPressedEvent *)&ev)
-# define be ((XButtonPressedEvent *)&ev)
-# define ce ((XConfigureEvent *)&ev)
-# define cr ((XConfigureRequestEvent *)&ev)
-# define me ((XMotionEvent *)&ev)
-# define ele ((XCrossingEvent *)&ev)
-# define de ((XDestroyWindowEvent *)&ev)
-# define ve ((XVisibilityEvent *)&ev)
-# define fe ((XFocusChangeEvent *)&ev)
-# define cre ((XCreateWindowEvent *)&ev)
-# define mape ((XMappingEvent *)&ev)
-# define gre ((XGravityEvent *)&ev)
-# define rr ((XResizeRequestEvent *)&ev)
-# define rpe ((XReparentEvent *)&ev)
-# define cie ((XCirculateEvent *)&ev)
-# define pe ((XPropertyEvent *)&ev)
-# define sce ((XSelectionClearEvent *)&ev)
-# define cme ((XColormapEvent *)&ev)
-
- if (((t = __INST(lastId)) != nil)
- && __isExternalAddress(t)
- && (__WindowVal(t) == ae->window)) {
- windowID = t;
- } else {
- windowID = __MKEXTERNALADDRESS(ae->window);
- }
-
- __ArrayInstPtr(anEventArray)->a_element[0] = windowID; __STORE(anEventArray, windowID);
- __ArrayInstPtr(anEventArray)->a_element[1] = __MKSMALLINT(ev.type);
-
- switch (ev.type) {
- case KeyRelease:
- sym = @symbol(keyRelease:key:code:state:x:y:rootX:rootY:time:);
- goto keyPressAndRelease;
-
- case KeyPress:
- sym = @symbol(keyPress:key:code:state:x:y:rootX:rootY:time:);
- /* FALL INTO */
-
- keyPressAndRelease:
- arg = nil;
- nchars = XLookupString(ke, (char *)buffer, sizeof(buffer), &keySym, NULL);
- if (nchars == 1 && (((buffer[0] >= ' ') && (buffer[0] <= '~'))
- || (buffer[0] >= 0x80))) {
- arg = __MKCHARACTER(buffer[0]);
-// } else if (nchars > 2) {
-// arg = __MKSTRING_L(buffer, nchars);
- } else {
- keySymString = XKeysymToString(keySym);
- if (keySymString) {
- arg = __MKSYMBOL(keySymString, 0);
- }
- }
-
-#ifdef IGNORE_UNKNOWN_KEYCODES
- if (arg == nil) {
- /* happens sometimes (alt-graph on sun has no keysym) */
- RETURN (false);
- }
-#endif
- __ArrayInstPtr(anEventArray)->a_element[2] = sym;
-
- __ArrayInstPtr(anEventArray)->a_element[3] = arg; __STORE(anEventArray, arg);
- t = __MKUINT(ke->keycode); __ArrayInstPtr(anEventArray)->a_element[4] = t; __STORE(anEventArray, t);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ke->state);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ke->x);
- __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ke->y);
- __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ke->x_root);
- __ArrayInstPtr(anEventArray)->a_element[9] = __mkSmallInteger(ke->y_root);
- t = __MKUINT(ke->time); __ArrayInstPtr(anEventArray)->a_element[10] = t; __STORE(anEventArray, t);
- break;
-
- case ButtonPress:
- sym = @symbol(buttonPress:button:state:x:y:rootX:rootY:time:);
- goto buttonPressAndRelease;
-
- case ButtonRelease:
- sym = @symbol(buttonRelease:button:state:x:y:rootX:rootY:time:);
- /* fall into */
-
- buttonPressAndRelease:
- __ArrayInstPtr(anEventArray)->a_element[2] = sym;
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(be->button);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ke->state);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(be->x);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(be->y);
- __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(be->x_root);
- __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(be->y_root);
- t = __MKUINT(be->time); __ArrayInstPtr(anEventArray)->a_element[9] = t; __STORE(anEventArray, t);
- break;
-
- case MotionNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(buttonMotion:state:x:y:rootX:rootY:time:);
-
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(me->state);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(me->x);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(me->y);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(me->x_root);
- __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(me->y_root);
- t = __MKUINT(me->time); __ArrayInstPtr(anEventArray)->a_element[8] = t; __STORE(anEventArray, t);
- break;
-
- case FocusIn:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(focusIn:mode:detail:);
- goto focusInOut;
-
- case FocusOut:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(focusOut:mode:detail:);
- /* fall into */
-
- focusInOut:
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(fe->mode);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(fe->detail);
- break;
-
- case EnterNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(pointerEnter:x:y:rootX:rootY:state:mode:detail:time:);
- goto enterLeave;
-
- case LeaveNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(pointerLeave:x:y:rootX:rootY:state:mode:detail:time:);
- /* fall into */
-
- enterLeave:
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ele->x);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ele->y);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ele->x_root);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ele->y_root);
- __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ele->state);
- __ArrayInstPtr(anEventArray)->a_element[8] = __mkSmallInteger(ele->mode);
- __ArrayInstPtr(anEventArray)->a_element[9] = __mkSmallInteger(ele->detail);
- t = __MKUINT(ele->time); __ArrayInstPtr(anEventArray)->a_element[10] = t; __STORE(anEventArray, t);
- break;
-
- case Expose:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(expose:x:y:width:height:count:);
- goto expose;
-
- case GraphicsExpose:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(graphicsExpose:x:y:width:height:count:);
- /* fall into */
-
- expose:
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ee->x);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ee->y);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ee->width);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ee->height);
- __ArrayInstPtr(anEventArray)->a_element[7] = __mkSmallInteger(ee->count);
- break;
-
- case NoExpose:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(noExposeView:);
- break;
-
- case VisibilityNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(visibilityNotify:state:);
- switch (ve->state) {
- case VisibilityUnobscured:
- __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(unobscured);
- break;
- case VisibilityPartiallyObscured:
- __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(partiallyObscured);
- break;
- case VisibilityFullyObscured:
- __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(fullyObscured);
- break;
- default:
- __ArrayInstPtr(anEventArray)->a_element[3] = __MKSMALLINT(ve->state);
- break;
- }
- break;
-
- case CreateNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(createWindow:x:y:width:height:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(cre->x);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(cre->y);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(cre->width);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(cre->height);
- break;
-
- case DestroyNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(destroyedView:);
- break;
-
- case UnmapNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(unmappedView:);
- break;
-
- case MapNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mappedView:);
- break;
-
- case ConfigureNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(configure:x:y:width:height:above:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(ce->x);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(ce->y);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(ce->width);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(ce->height);
- __ArrayInstPtr(anEventArray)->a_element[7] = nil;
- if (ce->above != None) {
- t = __MKEXTERNALADDRESS(ce->above); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
- }
- break;
-
- case GravityNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(gravityNotify:x:y:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(gre->x);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(gre->y);
- break;
-
- case ResizeRequest:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(resizeRequest:width:height:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(rr->width);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(rr->height);
- break;
-
- case ConfigureRequest:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(configureRequest:x:y:width:height:above:detail:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __mkSmallInteger(cr->x);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(cr->y);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(cr->width);
- __ArrayInstPtr(anEventArray)->a_element[6] = __mkSmallInteger(cr->height);
- __ArrayInstPtr(anEventArray)->a_element[7] = nil;
- if (cr->above != None) {
- t = __MKEXTERNALADDRESS(cr->above); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
- }
- switch (cr->detail) {
- case Above:
- __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(above);
- break;
- case Below:
- __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(below);
- break;
- case TopIf:
- __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(topIf);
- break;
- case BottomIf:
- __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(bottomIf);
- break;
- case Opposite:
- __ArrayInstPtr(anEventArray)->a_element[8] = @symbol(opposite);
- break;
- default:
- __ArrayInstPtr(anEventArray)->a_element[8] = __MKSMALLINT(cr->detail);
- break;
- }
- break;
-
- case CirculateNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(circulateNotify:place:);
- goto circulate;
-
- case CirculateRequest:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(circulateRequest:place:);
- /* fall into */
- circulate:
- switch (cie->place) {
- case PlaceOnTop:
- __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(placeOnTop);
- break;
- case PlaceOnBottom:
- __ArrayInstPtr(anEventArray)->a_element[3] = @symbol(placeOnBottom);
- break;
- default:
- __ArrayInstPtr(anEventArray)->a_element[3] = __MKSMALLINT(cie->place);
- break;
- }
- break;
-
- case PropertyNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(propertyChange:property:state:time:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(pe->atom);
- switch (pe->state) {
- case PropertyNewValue:
- __ArrayInstPtr(anEventArray)->a_element[4] = @symbol(newValue);
- break;
- case PropertyDelete:
- __ArrayInstPtr(anEventArray)->a_element[4] = @symbol(deleted);
- break;
- default:
- __ArrayInstPtr(anEventArray)->a_element[4] = __MKSMALLINT(pe->state);
- break;
- }
- t = __MKUINT(pe->time); __ArrayInstPtr(anEventArray)->a_element[5] = t; __STORE(anEventArray, t);
- break;
-
- case SelectionClear:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionClear:selection:time:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(sce->selection);
- t = __MKUINT(sce->time); __ArrayInstPtr(anEventArray)->a_element[4] = t; __STORE(anEventArray, t);
- break;
-
- case SelectionRequest:
- /*
- * someone wants the selection
- */
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionRequest:requestor:selection:target:property:time:);
- t = __MKEXTERNALADDRESS(ev.xselectionrequest.requestor); __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
- __ArrayInstPtr(anEventArray)->a_element[4] = __MKATOMOBJ(ev.xselectionrequest.selection);
- __ArrayInstPtr(anEventArray)->a_element[5] = __MKATOMOBJ(ev.xselectionrequest.target);
- __ArrayInstPtr(anEventArray)->a_element[6] = __MKATOMOBJ(ev.xselectionrequest.property);
- t = __MKUINT(ev.xselectionrequest.time); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
- break;
-
- case SelectionNotify:
- /*
- * returned selection value (answer from SelectionRequest)
- */
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(selectionNotify:selection:target:property:requestor:time:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(ev.xselection.selection);
- __ArrayInstPtr(anEventArray)->a_element[4] = __MKATOMOBJ(ev.xselection.target);
- __ArrayInstPtr(anEventArray)->a_element[5] = __MKATOMOBJ(ev.xselection.property);
- t = __MKEXTERNALADDRESS(ev.xselection.requestor); __ArrayInstPtr(anEventArray)->a_element[6] = t; __STORE(anEventArray, t);
- t = __MKUINT(ev.xselection.time); __ArrayInstPtr(anEventArray)->a_element[7] = t; __STORE(anEventArray, t);
- break;
-
- case ColormapNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(colormapNotify:state:);
- __ArrayInstPtr(anEventArray)->a_element[3] = cme->state == ColormapInstalled ? true : false;
- break;
-
- case ClientMessage:
- if (ev.xclient.message_type == (int) __AtomVal(__INST(protocolsAtom))) {
- if ((ev.xclient.data.l[0] == (int) __AtomVal(__INST(quitAppAtom)))
- || (ev.xclient.data.l[0] == (int) __AtomVal(__INST(deleteWindowAtom)))) {
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(terminateView:);
- break;
- }
- if (ev.xclient.data.l[0] == (int) __AtomVal(__INST(saveYourselfAtom))) {
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(saveAndTerminateView:);
- break;
- }
- }
- /*
- * any other client message
- */
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(clientMessage:type:format:data:);
- __ArrayInstPtr(anEventArray)->a_element[3] = __MKATOMOBJ(ev.xclient.message_type);
- __ArrayInstPtr(anEventArray)->a_element[4] = __MKSMALLINT(ev.xclient.format);
- t = __MKBYTEARRAY(&ev.xclient.data, sizeof(ev.xclient.data)); __ArrayInstPtr(anEventArray)->a_element[5] = t; __STORE(anEventArray, t);
- break;
-
- case MappingNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mappingNotify:request:event:);
- switch(mape->request) {
- case MappingModifier:
- arg = @symbol(mappingModifier);
- break;
- case MappingKeyboard:
- arg = @symbol(mappingKeyboard);
- break;
- case MappingPointer:
- arg = @symbol(mappingPointer);
- break;
- default:
- arg = __MKSMALLINT(mape->request);
- break;
- }
- __ArrayInstPtr(anEventArray)->a_element[3] = arg;
- t = __MKBYTEARRAY(&ev, sizeof(*mape)); __ArrayInstPtr(anEventArray)->a_element[4] = t;
- __STORE(anEventArray, t);
- break;
-
- case KeymapNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(keymapNotify:);
- break;
-
- case MapRequest:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(mapRequest:);
- break;
-
- case ReparentNotify:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(reparentedView:parentId:x:y:);
- t = __MKEXTERNALADDRESS(rpe->parent);
- __ArrayInstPtr(anEventArray)->a_element[3] = t; __STORE(anEventArray, t);
- __ArrayInstPtr(anEventArray)->a_element[4] = __mkSmallInteger(rpe->x);
- __ArrayInstPtr(anEventArray)->a_element[5] = __mkSmallInteger(rpe->y);
- break;
-
- default:
- __ArrayInstPtr(anEventArray)->a_element[2] = @symbol(unknownX11Event);
- break;
- }
-#undef ae
-#undef ee
-#undef ke
-#undef be
-#undef ce
-#undef cr
-#undef cre
-#undef cle
-#undef gre
-#undef me
-#undef ewe
-#undef ele
-#undef lwe
-#undef de
-#undef mape
-#undef ve
-#undef fe
-#undef rr
-#undef rpe
-#undef pe
-#undef cie
-#undef sce
-#undef cme
-
-%}.
-
- ^ true
-!
-
-handleAllEvents
- "from now on, handle any kind of event"
-
- dispatchingExpose := nil
-!
-
-handleExposeOnlyFor:aView
- "from now on, handle expose events only"
-
- dispatchingExpose := aView id
-!
-
-registerHotKeyForWindow:aDrawableId withId:anId modifiers:aModifier virtualKeyCode:aVirtualKeyCode
- "Defines a system-wide hot key."
- <resource: #todo>
-
- "no-op until implemented"
-
- ^ false.
-!
-
-setEventMask:aMask in:aWindowId
- "tell X that we are only interested in events from aMask, which
- is the bitwise or of the eventMask bits (see 'eventMaskFor:')"
-
- <context: #return>
-%{
-
- int mask;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isSmallInteger(aMask)) {
- mask = __intVal(aMask);
-
-#ifdef OLD
- /* these may not be disabled */
- mask |= ExposureMask | StructureNotifyMask |
- KeyPressMask | KeyReleaseMask |
- EnterWindowMask | LeaveWindowMask |
- ButtonPressMask | ButtonMotionMask | ButtonReleaseMask;
-#endif
-
- ENTER_XLIB();
- XSelectInput(myDpy, __WindowVal(aWindowId), mask);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-startDispatch
- "redefined to clear dispatchingExpose, which is a special X feature"
-
- dispatching ifTrue:[^ self].
- dispatchingExpose := nil.
- super startDispatch.
-!
-
-unregisterHotKeyForWindow:aDrawableId withId:anId
- "Release a system-wide hot key."
- <resource: #todo>
-
- "no-op until implemented. Since we never registered anything, the unregister succeeds"
-
- ^ true.
-! !
-
-!XWorkstation methodsFor:'event handling-old dispatch'!
-
-buttonPress:button x:x y:y view:aView
- "forward a button-press event for some view"
-
- aView isNil ifTrue:[
- "/ event arrived, after I destroyed it myself
- ^ self
- ].
- button == 1 ifTrue:[
- activateOnClick == true ifTrue:[
- "/ dont raise above an active popup view.
- (activeKeyboardGrab isNil and:[activePointerGrab isNil]) ifTrue:[
- aView topView raise.
-"/ ] ifFalse:[
-"/ activeKeyboardGrab printCR.
-"/ activePointerGrab printCR.
- ]
- ].
- ].
- super buttonPress:button x:x y:y view:aView
-
-
-
-! !
-
-!XWorkstation methodsFor:'event sending'!
-
-sendClientEvent:msgType format:msgFormat to:targetWindowID propagate:propagate eventMask:eventMask window:windowID data1:d1 data2:d2 data3:d3 data4:d4 data5:d5
- "send a ClientMessage to some other (possibly: non-ST/X) view.
- The client message gets message_type and msgFormat as specified by
- the arguments. The additional data arguments specify up to
- 5 longWords of user data; each may be an integer or nil.
- It is passed transparently in the events data field.
- See XProtocol specification for more details."
-
- "/ Event.xclient.type = ClientMessage;
- "/ Event.xclient.display = dpy;
- "/ Event.xclient.message_type = msgType;
- "/ Event.xclient.format = msgFormat;
- "/ Event.xclient.window = windowID;
- "/ Event.xclient.data.l[0] = d1
- "/ Event.xclient.data.l[1] = d2
- "/ Event.xclient.data.l[2] = d3
- "/ Event.xclient.data.l[3] = d4
- "/ Event.xclient.data.l[4] = d5
- "/
- "/ XSendEvent(dpy, targetWindowID, propagate, eventMask, &Event);
-
- <context: #return>
-%{
- int type;
- int state;
- int __eventMask;
-
- if (ISCONNECTED
- && __isInteger(msgType)
- && __isInteger(msgFormat)
- && (eventMask == nil || __isInteger(eventMask))
- && (__isExternalAddress(windowID) || __isInteger(windowID))
- && (__isExternalAddress(targetWindowID) || __isInteger(targetWindowID))) {
- Display *dpy = myDpy;
- XEvent ev;
- Status result;
- Window targetWindow;
-
- if (__isInteger(d1)) {
- ev.xclient.data.l[0] = __longIntVal(d1);
- } else {
- if (__isExternalAddress(d1)) {
- ev.xclient.data.l[0] = (INT)__externalAddressVal(d1);
- } else {
- ev.xclient.data.l[0] = 0;
- }
- }
- if (__isInteger(d2)) {
- ev.xclient.data.l[1] = __longIntVal(d2);
- } else {
- if (__isExternalAddress(d2)) {
- ev.xclient.data.l[1] = (INT)__externalAddressVal(d2);
- } else {
- ev.xclient.data.l[1] = 0;
- }
- }
- if (__isInteger(d3)) {
- ev.xclient.data.l[2] = __longIntVal(d3);
- } else {
- if (__isExternalAddress(d3)) {
- ev.xclient.data.l[2] = (INT)__externalAddressVal(d3);
- } else {
- ev.xclient.data.l[2] = 0;
- }
- }
- if (__isInteger(d4)) {
- ev.xclient.data.l[3] = __longIntVal(d4);
- } else {
- if (__isExternalAddress(d4)) {
- ev.xclient.data.l[3] = (INT)__externalAddressVal(d4);
- } else {
- ev.xclient.data.l[3] = 0;
- }
- }
- if (__isInteger(d5)) {
- ev.xclient.data.l[4] = __longIntVal(d5);
- } else {
- if (__isExternalAddress(d5)) {
- ev.xclient.data.l[4] = (INT)__externalAddressVal(d5);
- } else {
- ev.xclient.data.l[4] = 0;
- }
- }
-
- if (__isExternalAddress(windowID)) {
- ev.xclient.window = __WindowVal(windowID);
- } else {
- ev.xclient.window = (Window)__longIntVal(windowID);
- }
-
- if (__isExternalAddress(targetWindowID)) {
- targetWindow = __WindowVal(targetWindowID);
- } else {
- targetWindow = (Window)__longIntVal(targetWindowID);
- }
-
- ev.xclient.type = ClientMessage;
- ev.xclient.display = dpy;
- ev.xclient.message_type = __longIntVal(msgType);
- ev.xclient.format = __longIntVal(msgFormat);
-
- if (eventMask == nil) {
- __eventMask = NoEventMask;
- } else {
- __eventMask = __longIntVal(eventMask);
- }
-
- ENTER_XLIB();
- result = XSendEvent(dpy, targetWindow, (propagate == true ? True : False), __eventMask , &ev);
- LEAVE_XLIB();
-
- if ((result == BadValue) || (result == BadWindow)) {
- DPRINTF(("bad status in sendClientEvent\n"));
- RETURN ( false )
- }
- RETURN (true)
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-!
-
-sendKeyOrButtonEvent:typeSymbol x:xPos y:yPos keyOrButton:keySymCodeOrButtonNr state:stateMask toViewId:targetId
- "send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
- TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
- For buttonEvents, the keySymCodeOrButtonNr must be the buttons number (1, 2 ...);
- for key events, it can be either a symbol (as listen in X's keySyms)
- or a numeric keysym code. If state is nil, the modifier bits (shift & control)
- are computed from the keyboardMap - if non-nil, these are passed as modifierbits.
- The non-nil case is the lowlevel entry, where state must include any shift/ctrl information
- (not very user friendly)"
-
- <context: #return>
-%{
- int type;
- int state;
-
- if (__isSmallInteger(stateMask)) {
- state = __intVal(stateMask);
- } else {
- state = 0;
- }
-
- if (ISCONNECTED
- && __isSmallInteger(xPos) && __isSmallInteger(yPos)
- && (__isSmallInteger(keySymCodeOrButtonNr) || __isStringLike(keySymCodeOrButtonNr))
- && (__isExternalAddress(targetId) || __isInteger(targetId))) {
- Display *dpy = myDpy;
-
- XEvent ev;
- Window target;
- Status result;
- KeySym keySym, *syms;
- int screen = __intVal(__INST(screen));
- char s[2];
- int nSyms;
-
- if ((typeSymbol == @symbol(keyPress))
- || (typeSymbol == @symbol(keyRelease))) {
- if (__isStringLike(keySymCodeOrButtonNr)) {
- keySym = XStringToKeysym(__stringVal(keySymCodeOrButtonNr));
- } else {
- if (__isCharacter(keySymCodeOrButtonNr)) {
- s[0] = __intVal(__characterVal(keySymCodeOrButtonNr));
- s[1] = '\0';
- keySym = XStringToKeysym(s);
- } else {
- keySym = (KeySym) __intVal(keySymCodeOrButtonNr);
- }
- }
- ev.xkey.keycode = XKeysymToKeycode(dpy, keySym);
-
- if (stateMask == nil) {
- /*
- * get the modifier from the keySym
- */
- nSyms = 0;
- syms = XGetKeyboardMapping(dpy, ev.xkey.keycode, 1, &nSyms);
- if (syms) {
- int i;
-
- for (i=0; i<nSyms; i++) {
- if (syms[i] == keySym) {
-#ifdef MODIFIERDEBUG
- console_printf("modifier-index is %d\n", i);
-#endif
- if (i) state = (1 << (i-1));
- break;
- }
- }
- XFree(syms);
- }
- }
- } else {
- if ((typeSymbol == @symbol(buttonPress))
- || (typeSymbol == @symbol(buttonRelease))) {
- if (__isSmallInteger(keySymCodeOrButtonNr)) {
- ev.xbutton.button = __intVal(keySymCodeOrButtonNr);
- } else {
- ev.xbutton.button = 1;
- }
- } else {
- DPRINTF(("invalid sendEvent typeSymbol\n"));
- RETURN (false);
- }
- }
-
- if (typeSymbol == @symbol(keyPress))
- ev.xany.type = KeyPress;
- else if (typeSymbol == @symbol(keyRelease))
- ev.xany.type = KeyRelease;
- else if (typeSymbol == @symbol(buttonPress))
- ev.xany.type = ButtonPress;
- else if (typeSymbol == @symbol(buttonRelease))
- ev.xany.type = ButtonRelease;
-
- if (__isExternalAddress(targetId)) {
- target = __WindowVal(targetId);
- } else {
- target = (Window) __longIntVal(targetId);
- }
- ev.xkey.window = target;
- ev.xkey.same_screen = 1;
- ev.xkey.subwindow = 0;
- ev.xkey.root = RootWindow(dpy, screen);
- ev.xkey.x = __intVal(xPos);
- ev.xkey.y = __intVal(yPos);
- ev.xkey.state = state;
- ev.xkey.time = CurrentTime;
-
- ENTER_XLIB();
- result = XSendEvent(dpy, target, False, 0 , &ev);
- LEAVE_XLIB();
- if ((result == BadValue) || (result == BadWindow)) {
- DPRINTF(("bad status\n"));
- RETURN ( false )
- }
- RETURN (true)
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-! !
-
-!XWorkstation methodsFor:'font stuff'!
-
-createFontFor:aFontName
- "a basic method for X-font allocation; this method allows
- any font to be aquired (even those not conforming to
- standard naming conventions, such as cursor, fixed or k14)"
-
- <context: #return>
-
-%{ /* STACK: 100000 */
- /*** UNLIMITEDSTACK */
-
- XFontStruct *newFont;
-
- if (ISCONNECTED
- && __isStringLike(aFontName)) {
-
- ENTER_XLIB();
- newFont = XLoadQueryFont(myDpy, (char *)__stringVal(aFontName));
- LEAVE_XLIB();
-#ifdef COUNT_RESOURCES
- if (newFont)
- __cnt_font++;
-#endif
-
- RETURN ( newFont ? __MKEXTERNALADDRESS(newFont) : nil );
- }
-%}.
- "/ --- disabled due to UNLIMITEDSTACK -- self primitiveFailedOrClosedConnection.
- ^ nil
-!
-
-decomposeXFontName:aString into:aBlock
- "extract family, face, style and size from an
- X-font name
- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- -brand-family-face-style-moreStyle- -height-size-resX-resY-??-??-registry-encoding;
- evaluate aBlock with these"
-
- |family face style moreStyle fheight size
- resX resY registry encoding coding fields|
-
- aString isNil ifTrue:[^ false].
- fields := aString asCollectionOfSubstringsSeparatedBy:$-.
- fields size == 3 ifTrue:[
- "take care of old font names: family-style-size"
- family := fields at:1.
- style := fields at:2.
- size := Number readFromString:(fields at:3) onError:[^ false].
- ] ifFalse:[fields size == 2 ifTrue:[
- "take care of old font names: family-size"
- family := fields at:1.
- size := Number readFromString:(fields at:2) onError:[^ false].
- ] ifFalse:[fields size >= 15 ifTrue:[
- family := fields at:3.
- face := fields at:4.
- style := fields at:5.
- style = 'o' ifTrue:[
- style := 'oblique'
- ] ifFalse:[style = 'i' ifTrue:[
- style := 'italic'
- ] ifFalse:[style = 'r' ifTrue:[
- style := 'roman'
- ]]].
- moreStyle := fields at:6.
- (moreStyle ~= 'normal' and:[moreStyle size > 1]) ifTrue:[
- style := style, '-', moreStyle.
- ].
- fheight := fields at:8.
- size := (Number readFromString:(fields at:9) onError:[^ false]) / 10.
- resX := fields at:10.
- resY := fields at:11.
- registry := fields at:14.
- encoding := fields at:15.
- coding := registry , '-' , encoding.
- ] ifFalse:[
- ^ false
- ]]].
- aBlock value:family value:face value:style value:size value:coding.
- ^ true
-!
-
-encodingOf:aFontId
- "the fonts encoding - if the font does not provide that info,
- return nil (and assume #ascii, which is a subset of #iso8859-1)."
-
- |props reg enc coll|
-
- props := self fontPropertiesOf:aFontId.
- reg := props at:#'CHARSET_REGISTRY' ifAbsent:nil.
- enc := props at:#'CHARSET_ENCODING' ifAbsent:nil.
- coll := props at:#'CHARSET_COLLECTIONS' ifAbsent:nil.
-
- reg notNil ifTrue:[ reg := self atomName:reg].
- enc notNil ifTrue:[ enc := self atomName:enc].
- coll notNil ifTrue:[ coll := self atomName:coll].
-
- ^ self extractEncodingFromRegistry:reg encoding:enc charSetCollections:coll
-
- "
- Screen current encodingOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
- "
-!
-
-extentsOf:aString from:index1 to:index2 inFont:aFontId into:anArray
-
- <context: #return>
-
-%{ /* UNLIMITEDSTACK */
-
- XFontStruct *f;
- char *cp;
- int len, n, i1, i2, l;
-# define NLOCALBUFFER 200
- XChar2b xlatebuffer[NLOCALBUFFER];
- int nInstBytes;
- int directionReturn, fontAscentReturn, fontDescentReturn;
- XCharStruct overAllReturn;
- OBJ *resultArray;
-
- if (ISCONNECTED
- && __bothSmallInteger(index1, index2)
- && __isExternalAddress(aFontId)
- && __isNonNilObject(aString)) {
- int lMax = __intVal(@global(MaxStringLength));
- f = __FontVal(aFontId);
- if (! f) goto fail;
-
- if (__isArray(anArray) && __arraySize(anArray) > 0) {
- resultArray = __arrayVal(anArray);
- } else {
- resultArray = 0;
- }
-
- i1 = __intVal(index1) - 1;
-
- if (i1 >= 0) {
- OBJ cls;
-
- i2 = __intVal(index2) - 1;
- if (i2 < i1) {
- RETURN ( __MKSMALLINT(0) );
- }
-
- cp = (char *) __stringVal(aString);
- l = i2 - i1 + 1;
-
- if (__isStringLike(aString)) {
- n = __stringSize(aString);
- if (i2 >= n) goto fail;
- cp += i1;
- len = XTextExtents(f, cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- } else {
- cls = __qClass(aString);
- nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- cp += nInstBytes;
- n = __byteArraySize(aString) - nInstBytes;
-
- if (__isBytes(aString)) {
- if (i2 >= n) goto fail;
-
- cp += i1;
- len = XTextExtents(f, cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- } else if (__isWords(aString)) { /* TWOBYTESTRINGS */
- union {
- char b[2];
- unsigned short s;
- } u;
- int i;
- XChar2b *cp2 = (XChar2b *)0;
- int mustFree = 0;
-
- n = n / 2;
- if (i2 >= n) goto fail;
-
- cp += (i1 * 2);
- if (l > lMax) l = lMax;
-
- /*
- * ST/X TwoByteStrings store the asciiValue in native byteOrder;
- * X expects them MSB first
- * convert as required
- */
-
- u.s = 0x1234;
- if (u.b[0] != 0x12) {
- if (l <= NLOCALBUFFER) {
- cp2 = xlatebuffer;
- } else {
- cp2 = (XChar2b *)(malloc(l * 2));
- mustFree = 1;
- }
- for (i=0; i<l; i++) {
- cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
- cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
- }
- cp = (char *) cp2;
- }
-
- len = XTextExtents16(f, (XChar2b *)cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
-
- if (mustFree) {
- free(cp2);
- }
- } else if (__isLongs(aString)) { /* FOURBYTESTRINGS */
- union {
- char b[2];
- unsigned short s;
- } u;
- int i;
- XChar2b *cp2 = (XChar2b *)0;
- int mustFree = 0;
-
- n = n / 4;
- if (i2 >= n) goto fail;
-
- cp += (i1 * 4);
- if (l > lMax) l = lMax;
-
- /*
- * For now: X does not support 32bit characters without the new 32Unicode extensions.
- * For now, treat chars above 0xFFFF as 0xFFFF (should we use default-char ?).
- */
- if (l <= NLOCALBUFFER) {
- cp2 = xlatebuffer;
- } else {
- cp2 = (XChar2b *)(malloc(l * 2));
- mustFree = 1;
- }
- for (i=0; i<l; i++) {
- int codePoint;
-
- codePoint = ((unsigned int32 *)cp)[i];
- if (codePoint > 0xFFFF) {
- codePoint = 0xFFFF;
- }
- cp2[i].byte1 = codePoint & 0xFF;
- cp2[i].byte2 = (codePoint >> 8) & 0xFF;;
- }
- cp = (char *) cp2;
-
- len = XTextExtents16(f, (XChar2b *)cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- if (mustFree) {
- free(cp2);
- }
- } else
- goto fail; /*unknown string class */
- }
- if (resultArray) {
- switch (__arraySize(anArray)) {
- default:
- case 8:
- resultArray[7] = __MKSMALLINT(directionReturn);
- case 7:
- resultArray[6] = __MKSMALLINT(fontDescentReturn);
- case 6:
- resultArray[5] = __MKSMALLINT(fontAscentReturn);
- case 5:
- resultArray[4] = __MKSMALLINT(overAllReturn.descent);
- case 4:
- resultArray[3] = __MKSMALLINT(overAllReturn.ascent);
- case 3:
- resultArray[2] = __MKSMALLINT(overAllReturn.width);
- case 2:
- resultArray[1] = __MKSMALLINT(overAllReturn.rbearing);
- case 1:
- resultArray[0] = __MKSMALLINT(overAllReturn.lbearing);
- case 0:
- break;
- }
- }
- RETURN ( __MKSMALLINT(overAllReturn.width) );
- }
- }
-#undef NLOCALBUFFER
-fail: ;
-%}.
- self primitiveFailedOrClosedConnection.
- ^ 0
-
- "
- |result|
- result := Array new:8.
- Screen current
- extentsOf:'hello World' from:1 to:11
- inFont:(Screen current getFontWithFoundry:'*'
- family:'courier new'
- weight:'medium'
- slant:'r'
- spacing:nil
- pixelSize:nil
- size:10
- encoding:#'iso10646-1'
- )
- into:result.
-
- result
- "
-!
-
-extractEncodingFromRegistry:registry encoding:encoding charSetCollections:charSetCollections
- "given registry and encoding as returned by X11,
- generate a single symbol naming the ST/X encoding.
- I.e. from registry='ISO8859' and encoding='1', generate #'iso8859-1'.
- This is pure magic ..."
-
- |enc charSets|
-
- (registry size ~~ 0) ifTrue:[
- enc := registry asLowercase.
- encoding size ~~ 0 ifTrue:[
- enc := enc, '-', encoding asLowercase.
- ].
- enc := enc asSymbol.
- ] ifFalse:[
- (encoding size ~~ 0) ifTrue:[
- enc := encoding asLowercase asSymbol
- ] ifFalse:[
- charSets := charSetCollections.
- (charSets notEmptyOrNil) ifTrue:[
- charSets := charSets asUppercase asCollectionOfWords.
- (charSets includes:'ISO8859-1') ifTrue:[
- enc := #'iso8859-1'
- ] ifFalse:[
- (charSets includes:'ISO8859') ifTrue:[
- enc := #iso8859
- ] ifFalse:[
- (charSets includes:'ASCII') ifTrue:[
- enc := #ascii
- ] ifFalse:[
- (charSets includes:'ADOBE-STANDARD') ifTrue:[
- enc := #iso8859
- ]
- ]
- ]
- ]
- ]
- ]
- ].
- ^ enc
-
- "Created: 17.4.1996 / 14:57:06 / cg"
- "Modified: 17.4.1996 / 17:22:35 / cg"
-!
-
-flushListOfAvailableFonts
- "flush the cached list of all available fonts on this display.
- Required if new fonts have been added on the display server."
-
- listOfXFonts := nil
-
- "
- Display flushListOfAvailableFonts.
- Display listOfAvailableFonts
- "
-
- "Modified: 27.9.1995 / 10:54:47 / stefan"
- "Created: 20.2.1996 / 22:55:52 / cg"
-!
-
-fontDescriptionFromXFontName:aFontNameString
- "extract family, face, style and size from an
- X-font name
- 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- -brand-family-face-style-moreStyle- -pxlSize-size-resX-resY-??-??-registry-encoding;
- evaluate aBlock with these"
-
- |family face style moreStyle size
- resX resY registry encoding coding fields|
-
- aFontNameString isNil ifTrue:[^ nil].
-
- Error handle:[:ex |
- family := nil.
- ] do:[
- fields := aFontNameString asCollectionOfSubstringsSeparatedBy:$-.
- fields size == 3 ifTrue:[
- "take care of old font names: family-style-size"
- family := fields at:1.
- style := fields at:2.
- size := Number readFromString:(fields at:3).
- ] ifFalse:[
- fields size == 2 ifTrue:[
- "take care of old font names: family-size"
- family := fields at:1.
- size := Number readFromString:(fields at:2).
- ] ifFalse:[
- fields size >= 15 ifTrue:[
- family := fields at:3.
- face := fields at:4.
- style := fields at:5.
- style = 'o' ifTrue:[
- style := 'oblique'
- ] ifFalse:[style = 'i' ifTrue:[
- style := 'italic'
- ] ifFalse:[style = 'r' ifTrue:[
- style := 'roman'
- ]]].
- moreStyle := fields at:6.
- (moreStyle ~= 'normal' and:[moreStyle size > 1]) ifTrue:[
- style := style, '-', moreStyle.
- ].
-"/ pxlSize := (Integer readFromString:(fields at:8)).
- size := (Number readFromString:(fields at:9)) / 10.
- resX := fields at:10.
- resY := fields at:11.
- registry := fields at:14.
- encoding := fields at:15.
- coding := registry , '-' , encoding.
- ] ifFalse:[
- "/ very old name (such as cursor, 5x7 etc)
- ]
- ]
- ].
- ].
-
- family notNil ifTrue:[
- ^ FontDescription family:family face:face style:style size:size sizeUnit:#pt encoding:coding.
- ].
- ^ FontDescription name:aFontNameString
-
- "
- Screen current fontDescriptionFromXFontName:'-arabic-newspaper-medium-r-normal--32-246-100-100-p-137-iso10646-1'
- "
-!
-
-fontMetricsOf:fontId
- "return a fonts metrics info object"
-
- <context: #return>
-
- |info avgAscent avgDescent minCode maxCode dir
- maxAscent maxDescent minWidth maxWidth avgWidth|
-
-%{ /* UNLIMITEDSTACK */
- XFontStruct *f;
- int len;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(fontId)) {
- f = __FontVal(fontId);
- if (f) {
- minCode = __MKUINT((f->min_byte1<<8) + f->min_char_or_byte2);
- maxCode = __MKUINT((f->max_byte1<<8) + f->max_char_or_byte2);
-
- if (f->direction == FontLeftToRight) {
- dir = @symbol(LeftToRight);
- } else if (f->direction == FontRightToLeft) {
- dir = @symbol(RightToLeft);
- }
- avgAscent = __MKSMALLINT(f->ascent);
- avgDescent = __MKSMALLINT(f->descent);
- maxAscent = __MKSMALLINT(f->max_bounds.ascent);
- maxDescent = __MKSMALLINT(f->max_bounds.descent);
- minWidth = __MKSMALLINT(f->min_bounds.width);
- maxWidth = __MKSMALLINT(f->max_bounds.width);
-
- ENTER_XLIB();
- len = XTextWidth(f, "n", 1);
- LEAVE_XLIB();
-
- avgWidth = __MKSMALLINT( len );
- }
- }
- }
-%}.
- avgAscent == nil ifTrue:[
- self primitiveFailedOrClosedConnection.
- ^ nil
- ].
-
- "DingBats font returns 0 for maxAscent/maxDescent"
- maxAscent := maxAscent max:avgAscent.
- maxDescent := maxDescent max:avgDescent.
-
- info := DeviceWorkstation::DeviceFontMetrics new.
- info
- ascent:avgAscent
- descent:avgDescent
- maxAscent:maxAscent
- maxDescent:maxDescent
- minWidth:minWidth
- maxWidth:maxWidth
- avgWidth:avgWidth
- minCode:minCode
- maxCode:maxCode
- direction:dir.
- ^ info
-
- "
- Screen current fontMetricsOf:(View defaultFont onDevice:Screen current) fontId
- CharacterSetView openOn:(View defaultFont onDevice:Screen current)
-
- Screen current fontMetricsOf:(MenuView defaultFont onDevice:Screen current) fontId
- CharacterSetView openOn:(MenuView defaultFont onDevice:Screen current)
- "
-!
-
-fontProperties:propertyNames of:aFontId
- "Answer an array with selected property values of a font.
- This is X11-Specific.
- PropertyNames is an array with property names (symbols or strings).
- Nonexistant properties are returned as nil"
-
- |props|
-
- props := self fontPropertiesOf:aFontId.
- ^ propertyNames collect:[:propName | props at:propName ifAbsent:nil].
-
- "
- Screen current
- fontProperties:#(#'PIXEL_SIZE' #'POINT_SIZE' RESOLUTION notExistant)
- of:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
- "
-!
-
-fontPropertiesOf:aFontId
- "Answer an array with all the properties of a font.
- This is X11-Specific.
- Odd indices contain the property name (atom)
- Even indices contain the property value (atom)
-
- Answer nil, if there are no properties"
-
- |propsArray result|
-
-%{
- XFontStruct *f;
- XFontProp *prop;
- int n, i;
- OBJ x;
-
- if (__isExternalAddress(aFontId)) {
- f = __FontVal(aFontId);
- if (f && (prop = f->properties) != 0) {
- n = f->n_properties;
- propsArray = __ARRAY_NEW_INT(n*2);
- for (i = 0; n; n--, prop++) {
- x = __MKUINT(prop->name); __ArrayInstPtr(propsArray)->a_element[i++] = x; __STORE(propsArray, x);
- x = __MKUINT(prop->card32); __ArrayInstPtr(propsArray)->a_element[i++] = x; __STORE(propsArray, x);
- }
- }
- }
-%}.
- result := Dictionary new.
- propsArray notNil ifTrue:[
- propsArray pairWiseDo:[:n :v | result at:(self atomName:n) put:v].
- ].
- ^ result
-
- "
- Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
- Dictionary withKeysAndValues:(Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1'))
-
- |d|
- d := Dictionary new.
- (Screen current fontPropertiesOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')) keysAndValuesDo:[:name :value|
- d at:name put:((Screen current atomName:value) ? value)
- ].
- d
- "
-!
-
-fontResolutionOf:fontId
- "return the resolution (as dpiX @ dpiY) of the font - this is usually the displays resolution,
- but due to errors in some XServer installations, some use 75dpi fonts on higher
- resolution displays and vice/versa."
-
- |props res resX resY|
-
- props := self fontProperties:#(#'RESOLUTION_X' #'RESOLUTION_Y' RESOLUTION) of:fontId.
- resX := props at:1.
- resY := props at:2.
- (resX notNil and:[resY notNil]) ifTrue:[
- ^ resX @ resY
- ].
- res := props at:3.
- res notNil ifTrue:[
- ^ res @ res
- ].
- ^ self resolution
-
- "
- Screen current fontResolutionOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
- "
-!
-
-fullFontNameOf:aFontId
- "the fonts fullName - this is very device specific and should only be
- used for user feed-back (for example: in the fontPanel).
- If the display/font does not provide that info, return nil."
-
- |props fullName|
-
- props := self fontPropertiesOf:aFontId.
- #('FONT' 'FONT_NAME' 'FULL_NAME' 'FULLNAME' ) do:[:try |
- |fullNameID|
-
- fullNameID := props at:try ifAbsent:nil.
- fullNameID notNil ifTrue:[
- fullName := self atomName:fullNameID.
- fullName notEmptyOrNil ifTrue:[
- ^ fullName
- ].
- ]
- ].
-
- ^ nil.
-
- "
- Screen current fullFontNameOf:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
- "
-!
-
-getAvailableFontsMatching:pattern
- "return an Array filled with font names matching aPattern"
-
- <context: #return>
-
-%{ /* UNLIMITEDSTACK */
-
- int nnames = 30000;
- int available = nnames + 1;
- char **fonts;
- OBJ arr, str;
- int i;
-
- if (ISCONNECTED) {
- if (__isStringLike(pattern)) {
- for (;;) {
- ENTER_XLIB();
- fonts = XListFonts(myDpy, __stringVal(pattern), nnames, &available);
- LEAVE_XLIB();
- if (fonts == 0) RETURN(nil);
- if (available < nnames) break;
- XFreeFontNames(fonts);
- nnames = available * 2;
- }
-
- /*
- * now, that we know the number of font names,
- * create the array ...
- */
- arr = __ARRAY_NEW_INT(available);
- if (arr != nil) {
- /*
- * ... and fill it
- */
- for (i=0; i<available; i++) {
- __PROTECT__(arr);
- str = __MKSTRING(fonts[i]);
- __UNPROTECT__(arr);
- __ArrayInstPtr(arr)->a_element[i] = str; __STORE(arr, str);
- }
- }
- XFreeFontNames(fonts);
- RETURN (arr);
- }
- }
-%}.
- ^ nil
-
- "
- Screen current getAvailableFontsMatching:'*'
- "
-!
-
-getDefaultFontWithEncoding:encoding
- "return a default font id - used when class Font cannot
- find anything usable"
-
- |id|
-
- id := self createFontFor:'-misc-fixed-*-*-*-*-*-*-*-*-*-*-', encoding.
- id isNil ifTrue:[
- id := self createFontFor:'fixed'
- ].
- ^ id.
-
- "
- Screen current getDefaultFontWithEncoding:#'iso10646-1'
- "
-!
-
-getFontWithFamily:familyString face:faceString
- style:styleArgString size:sizeArgOrNil sizeUnit:sizeUnit encoding:encoding
-
- "try to get the specified font, if not available, try next smaller
- font. Access to X-fonts by name is possible, by passing the X font name
- as family and the other parameters as nil. For example, the cursor font
- can be aquired that way."
-
- |styleString theName theId xlatedStyle
- id spacing encodingMatch idx roundedSize pixelSize pointSize|
-
- styleString := styleArgString.
-
- sizeArgOrNil notNil ifTrue:[
- roundedSize := sizeArgOrNil rounded asInteger.
- sizeUnit == #px ifTrue:[
- pixelSize := roundedSize.
- ] ifFalse:[
- pointSize := roundedSize.
- ].
- ].
-
- "special: if face is nil, allow access to X-fonts"
- faceString isNil ifTrue:[
- roundedSize notNil ifTrue:[
- theName := familyString , '-' , roundedSize printString
- ] ifFalse:[
- theName := familyString
- ].
- theName notNil ifTrue:[
- theId := self createFontFor:theName.
- ].
- theId isNil ifTrue:[
- theId := self getDefaultFontWithEncoding:encoding
- ].
- ^ theId
- ].
-
- "/ spacing other than 'normal' is contained as last component
- "/ in style
-
- (styleString notNil
- and:[(styleString endsWith:'-narrow')
- or:[styleString endsWith:'-semicondensed']]) ifTrue:[
- |i|
- i := styleString lastIndexOf:$-.
- spacing := styleString copyFrom:(i+1).
- styleString := styleString copyTo:(i-1).
- ] ifFalse:[
- spacing := 'normal'.
- ].
-
- xlatedStyle := styleString.
- xlatedStyle notNil ifTrue:[
- xlatedStyle := xlatedStyle first asString
- ].
-
- encoding isNil ifTrue:[
- encodingMatch := '*-*'.
- ] ifFalse:[
- idx := encoding indexOf:$-.
- idx ~~ 0 ifTrue:[
- encodingMatch := encoding
- ] ifFalse:[
- encodingMatch := encoding , '-*'.
- ].
- ].
-
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:spacing
- pixelSize:pixelSize
- size:pointSize
- encoding:encodingMatch.
-
- id isNil ifTrue:[
- (encodingMatch notNil and:[encodingMatch ~= '*']) ifTrue:[
- "/ too stupid: registries come in both cases
- "/ and X does not ignore case
- "/
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:spacing
- pixelSize:nil
- size:roundedSize
- encoding:encodingMatch asUppercase.
- id isNil ifTrue:[
- id := self
- getFontWithFoundry:'*'
- family:familyString asLowercase
- weight:faceString
- slant:xlatedStyle
- spacing:spacing
- pixelSize:nil
- size:roundedSize
- encoding:encodingMatch asLowercase.
- ]
- ]
- ].
- ^ id
-
- "Modified: 4.7.1996 / 11:38:47 / stefan"
- "Modified: 10.4.1997 / 19:20:06 / cg"
-!
-
-getFontWithFoundry:foundry family:family weight:weight
- slant:slant spacing:spc pixelSize:pSize size:size
- 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)
- encoding: iso8859-*, iso8859-1, iso10646-1 ... '*'
- "
-
- |theName sizeMatch
- foundryMatch familyMatch weightMatch slantMatch spcMatch
- pSizeMatch encodingMatch|
-
- "this works only on 'Release >= 3' - X-servers"
- "name is:
- -foundry-family -weight -slant-
- sony helvetica bold r
- adobe courier medium i
- msic fixed o
- ... ...
- "
-
- size isNil ifTrue:[
- sizeMatch := '*'
- ] ifFalse:[
- sizeMatch := size printString , '0'
- ].
- foundry isNil ifTrue:[
- foundryMatch := '*'
- ] ifFalse:[
- foundryMatch := foundry
- ].
- family isNil ifTrue:[
- familyMatch := '*'
- ] ifFalse:[
- familyMatch := family
- ].
- weight isNil ifTrue:[
- weightMatch := '*'
- ] ifFalse:[
- weightMatch := weight
- ].
- slant isNil ifTrue:[
- slantMatch := '*'
- ] ifFalse:[
- slantMatch := slant
- ].
- spc isNil ifTrue:[
- spcMatch := '*'
- ] ifFalse:[
- spcMatch := spc
- ].
- pSize isNil ifTrue:[
- pSizeMatch := '*'
- ] ifFalse:[
- pSizeMatch := pSize printString
- ].
- encoding isNil ifTrue:[
- encodingMatch := '*'
- ] ifFalse:[
- encodingMatch := encoding
- ].
-
- theName := ('-' , foundryMatch,
- '-' , familyMatch,
- '-' , weightMatch ,
- '-' , slantMatch ,
- '-' , spcMatch ,
- '-*' ,
- '-' , pSizeMatch ,
- '-' , sizeMatch ,
- '-*-*-*-*' ,
- '-' , encodingMatch).
-
-"/ Transcript showCR:theName; endEntry.
-
- ^ self createFontFor:theName.
-
-
- "
- Display
- getFontWithFoundry:'*'
- family:'courier'
- weight:'medium'
- slant:'r'
- spacing:nil
- pixelSize:nil
- size:13
- encoding:#'iso8859-1'.
-
- Display
- getFontWithFoundry:'*'
- family:'courier'
- weight:'medium'
- slant:'r'
- spacing:nil
- pixelSize:nil
- size:13
- encoding:#'iso10646-1'
- "
-
- "Modified: 10.4.1997 / 19:15:44 / cg"
-!
-
-heightOf:aString from:index1 to:index2 inFont:aFontId
- |resultArray|
-
- resultArray := Array new:5.
- self extentsOf:aString from:index1 to:index2 inFont:aFontId into:resultArray.
- ^ (resultArray at:4) + (resultArray at:5).
-
- "
- Screen current
- heightOf:'hello world' from:1 to:10
- inFont:(Screen current getFontWithFoundry:'*'
- family:'courier new'
- weight:'medium'
- slant:'r'
- spacing:nil
- pixelSize:nil
- size:13
- encoding:#'iso10646-1'
- ).
-
- Screen current
- heightOf:'hello World gggÖÜ' from:1 to:15
- inFont:(Screen current getDefaultFontWithEncoding:#'iso10646-1')
- "
-!
-
-listOfAvailableFonts
- "return a list with all available fonts on this display.
- Since this takes some time, keep the result of the query for the
- next time. The elements of the returned collection are instances of
- FontDescription."
-
- |names|
-
- listOfXFonts isNil ifTrue:[
- names := self getAvailableFontsMatching:'*'.
- names isNil ifTrue:[
- "no names returned ..."
- ^ nil
- ].
- listOfXFonts := names collect:[:aName | self fontDescriptionFromXFontName:aName].
- listOfXFonts := FontDescription genericFonts, listOfXFonts.
- ].
- ^ listOfXFonts
-
- "
- Display flushListOfAvailableFonts.
- Display listOfAvailableFonts.
-
- Display getAvailableFontsMatching:'*'.
- Display getAvailableFontsMatching:'fixed'.
- Display fontsInFamily:'fixed' filtering:nil.
- "
-
- "Modified: 27.9.1995 / 10:54:47 / stefan"
- "Modified: 17.4.1996 / 15:27:57 / cg"
-!
-
-pixelSizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
- "return a set of all available font sizes in aFamily/aFace/aStyle
- on this display.
- Redefined to handle X's special case of 0-size (which stands for any)"
-
- |sizes|
-
- sizes := super pixelSizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
- (sizes notNil and:[sizes isEmpty or:[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 72 96 144 192 288)
- ].
- ^ sizes
-
- "
- Display pixelSizesInFamily:'courier' face:'bold' style:'roman' filtering:nil
- "
-
- "Created: 27.2.1996 / 01:38:15 / cg"
-!
-
-releaseFont:aFontId
-
- <context: #return>
-%{
- XFontStruct *f;
-
- /*
- * ignore closed connection
- */
- if (! ISCONNECTED) {
- RETURN ( self );
- }
-
- if (__isExternalAddress(aFontId)) {
- f = __FontVal(aFontId);
- if (f) {
-
- ENTER_XLIB();
- XFreeFont(myDpy, f);
- LEAVE_XLIB();
-#ifdef COUNT_RESOURCES
- __cnt_font--;
-#endif
- }
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter
- "return a set of all available font sizes in aFamily/aFace/aStyle
- on this display.
- Redefined to handle X's special case of 0-size (which stands for any)"
-
- |sizes|
-
- sizes := super sizesInFamily:aFamilyName face:aFaceName style:aStyleName filtering:filter.
- (sizes notNil and:[sizes includes:0]) ifTrue:[
- "special: in X11R5 and above, size 0 means:
- there are scaled versions in all sizes available"
-
- ^ #(4 5 6 7 8 9 10 11 12 14 16 18 20 22 24 28 32 48 64 72 96 144 192 288)
- ].
- ^ sizes
-
- "
- Display sizesInFamily:'courier' face:'bold' style:'roman' filtering:nil
- "
-
- "Created: 27.2.1996 / 01:38:15 / cg"
-!
-
-widthOf:aString from:index1 to:index2 inFont:aFontId
-
- <context: #return>
-
-%{ /* UNLIMITEDSTACK */
-
- XFontStruct *f;
- char *cp;
- int len, n, i1, i2, l;
-# define NLOCALBUFFER 200
- XChar2b xlatebuffer[NLOCALBUFFER];
- int nInstBytes;
- int directionReturn, fontAscentReturn, fontDescentReturn;
- XCharStruct overAllReturn;
-
- if (ISCONNECTED) {
- if (__bothSmallInteger(index1, index2)
- && __isExternalAddress(aFontId)
- && __isNonNilObject(aString)) {
- int lMax = __intVal(@global(MaxStringLength));
- f = __FontVal(aFontId);
- if (! f) goto fail;
-
- i1 = __intVal(index1) - 1;
-
- if (i1 >= 0) {
- OBJ cls;
-
- i2 = __intVal(index2) - 1;
- if (i2 < i1) {
- RETURN ( __MKSMALLINT(0) );
- }
-
- cp = (char *) __stringVal(aString);
- l = i2 - i1 + 1;
-
- if (__isStringLike(aString)) {
- n = __stringSize(aString);
- if (i2 < n) {
- cp += i1;
-
-#if 1
- len = XTextExtents(f, cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- //console_printf("lBear:%d rBear:%d width:%d\n", overAllReturn.lbearing, overAllReturn.rbearing, overAllReturn.width);
- RETURN ( __MKSMALLINT(overAllReturn.width) );
-#else
- ENTER_XLIB();
- len = XTextWidth(f, cp, l);
- LEAVE_XLIB();
- RETURN ( __MKSMALLINT(len) );
-#endif
- }
- }
-
- cls = __qClass(aString);
- nInstBytes = __OBJS2BYTES__(__intVal(__ClassInstPtr(cls)->c_ninstvars));
- cp += nInstBytes;
-
- if (__isBytes(aString)) {
- n = __byteArraySize(aString) - nInstBytes;
- if (i2 < n) {
- cp += i1;
-
-#if 1
- len = XTextExtents(f, cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- RETURN ( __MKSMALLINT(overAllReturn.width) );
-#else
- ENTER_XLIB();
- len = XTextWidth(f, cp, l);
- LEAVE_XLIB();
- RETURN ( __MKSMALLINT(len) );
-#endif
- }
- }
-
- /* TWOBYTESTRINGS */
- if (__isWords(aString)) {
- n = (__byteArraySize(aString) - nInstBytes) / 2;
-
- if (i2 < n) {
- union {
- char b[2];
- unsigned short s;
- } u;
- int i;
- XChar2b *cp2 = (XChar2b *)0;
- int mustFree = 0;
-
- cp += (i1 * 2);
- if (l > lMax) l = lMax;
-
- /*
- * ST/X TwoByteStrings store the asciiValue in native byteOrder;
- * X expects them MSB first
- * convert as required
- */
-
- u.s = 0x1234;
- if (u.b[0] != 0x12) {
- if (l <= NLOCALBUFFER) {
- cp2 = xlatebuffer;
- } else {
- cp2 = (XChar2b *)(malloc(l * 2));
- mustFree = 1;
- }
- for (i=0; i<l; i++) {
- cp2[i].byte1 = (((XChar2b *)cp)[i]).byte2;
- cp2[i].byte2 = (((XChar2b *)cp)[i]).byte1;
- }
- cp = (char *) cp2;
- }
-
-#if 1
- len = XTextExtents16(f, (XChar2b *)cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- len = overAllReturn.width;
-#else
- ENTER_XLIB();
- len = XTextWidth16(f, (XChar2b *)cp, l);
- LEAVE_XLIB();
-#endif
-
- if (mustFree) {
- free(cp2);
- }
-
- RETURN ( __MKSMALLINT(len) );
- }
- }
- /* FOURBYTESTRINGS */
- if (__isLongs(aString)) {
- int i;
- XChar2b *cp2;
- int mustFree = 0;
-
- n = (__byteArraySize(aString) - nInstBytes) / 4;
- if (i2 < n) {
- union {
- char b[2];
- unsigned short s;
- } u;
- int i;
- XChar2b *cp2 = (XChar2b *)0;
- int mustFree = 0;
-
- cp += (i1 * 4);
- if (l > lMax) l = lMax;
-
- /*
- * For now: X does not support 32bit characters without the new 32Unicode extensions.
- * For now, treat chars above 0xFFFF as 0xFFFF (should we use default-char ?).
- */
- if (l <= NLOCALBUFFER) {
- cp2 = xlatebuffer;
- } else {
- cp2 = (XChar2b *)(malloc(l * 2));
- mustFree = 1;
- }
- for (i=0; i<l; i++) {
- int codePoint;
-
- codePoint = ((unsigned int32 *)cp)[i];
- if (codePoint > 0xFFFF) {
- codePoint = 0xFFFF;
- }
- cp2[i].byte1 = codePoint & 0xFF;
- cp2[i].byte2 = (codePoint >> 8) & 0xFF;;
- }
- cp = (char *) cp2;
-
-#if 1
- len = XTextExtents16(f, (XChar2b *)cp, l,
- &directionReturn, &fontAscentReturn, &fontDescentReturn,
- &overAllReturn);
- len = overAllReturn.width;
-#else
- ENTER_XLIB();
- len = XTextWidth16(f, (XChar2b *)cp, l);
- LEAVE_XLIB();
-#endif
-
- if (mustFree) {
- free(cp2);
- }
-
- RETURN ( __MKSMALLINT(len) );
- }
- }
- }
- }
- }
-#undef NLOCALBUFFER
-fail: ;
-%}.
- self primitiveFailedOrClosedConnection.
- ^ 0
-! !
-
-!XWorkstation methodsFor:'grabbing'!
-
-allowEvents:mode
- <context: #return>
-%{
-
- 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
- && ISCONNECTED) {
- ENTER_XLIB();
- XAllowEvents(myDpy, _mode, CurrentTime);
- LEAVE_XLIB();
-
- RETURN (self);
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-grabKeyboardIn:aWindowId
- "grab the keyboard"
-
- <context: #return>
-%{
- int result, ok;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aWindowId)) {
-
- ENTER_XLIB();
- result = XGrabKeyboard(myDpy,
- __WindowVal(aWindowId),
- True /* False */,
- GrabModeAsync,
- GrabModeAsync,
- CurrentTime);
- LEAVE_XLIB();
-
- ok = 0;
- switch(result) {
- case AlreadyGrabbed:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: AlreadyGrabbed\n");
- }
- break;
- case GrabNotViewable:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: GrabNotViewable\n");
- }
- break;
- case GrabInvalidTime:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: InvalidTime\n");
- }
- break;
- case GrabFrozen:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab keyboard: Frozen\n");
- }
- break;
- default:
- ok = 1;
- break;
- }
- if (! ok) {
- ENTER_XLIB();
- XUngrabKeyboard(myDpy, CurrentTime);
- LEAVE_XLIB();
- RETURN (false);
- }
-
- RETURN ( true );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-!
-
-grabPointerIn:aWindowId withCursor:aCursorId eventMask:eventMask pointerMode:pMode keyboardMode:kMode confineTo:confineId
- "grap the pointer - return true if ok"
-
- <context: #return>
-%{
-
- int result, ok, evMask;
- Window confineWin;
- Cursor curs;
- int pointer_mode, keyboard_mode;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aWindowId)) {
- if (__isExternalAddress(confineId))
- confineWin = __WindowVal(confineId);
- else
- confineWin = (Window) None;
-
- if (__isExternalAddress(aCursorId))
- curs = __CursorVal(aCursorId);
- else
- curs = (Cursor) None;
-
- if (pMode == @symbol(sync))
- pointer_mode = GrabModeSync;
- else
- pointer_mode = GrabModeAsync;
-
- if (kMode == @symbol(sync))
- keyboard_mode = GrabModeSync;
- else
- keyboard_mode = GrabModeAsync;
-
- if (__isSmallInteger(eventMask))
- evMask = __intVal(eventMask);
- else
- evMask = ButtonPressMask | ButtonMotionMask | PointerMotionMask | ButtonReleaseMask;
-
-
-/*
- ENTER_XLIB();
-*/
- result = XGrabPointer(myDpy,
- __WindowVal(aWindowId),
- False,
- evMask,
- pointer_mode, keyboard_mode,
- confineWin,
- curs,
- CurrentTime);
-/*
- LEAVE_XLIB();
-*/
-
-
- ok = 0;
- switch (result) {
- case AlreadyGrabbed:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab pointer: AlreadyGrabbed\n");
- }
- break;
- case GrabNotViewable:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab pointer: GrabNotViewable\n");
- }
- break;
- case GrabInvalidTime:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab pointer: InvalidTime\n");
- }
- break;
- case GrabFrozen:
- if (@global(ErrorPrinting) == true) {
- console_fprintf(stderr, "XWorkstation [warning]: grab pointer: Frozen\n");
- }
- break;
- default:
- ok = 1;
- break;
- }
-
- if (! ok) {
-/*
- ENTER_XLIB();
-*/
- XUngrabPointer(myDpy, CurrentTime);
-/*
- LEAVE_XLIB();
-*/
- RETURN (false);
- }
- RETURN ( true );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-!
-
-grabPointerIn:aWindowId withCursor:aCursorId pointerMode:pMode keyboardMode:kMode confineTo:confineId
- "grap the pointer - return true if ok"
-
- ^ self
- grabPointerIn:aWindowId
- withCursor:aCursorId
- eventMask:nil
- pointerMode:pMode
- keyboardMode:kMode
- confineTo:confineId
-
- "Modified: / 28.7.1998 / 02:47:51 / cg"
-!
-
-primUngrabKeyboard
- "release the keyboard"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- ENTER_XLIB();
- XUngrabKeyboard(dpy, CurrentTime);
- XSync(dpy, 0);
- LEAVE_XLIB();
-
- }
-%}.
-!
-
-primUngrabPointer
- "release the pointer"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- ENTER_XLIB();
- XUngrabPointer(dpy, CurrentTime);
- XSync(dpy, 0);
- LEAVE_XLIB();
-
- }
-%}.
-!
-
-ungrabKeyboard
- "release the keyboard"
-
- activeKeyboardGrab notNil ifTrue:[
- activeKeyboardGrab := nil.
- self primUngrabKeyboard.
- ]
-!
-
-ungrabPointer
- "release the pointer"
-
- activePointerGrab notNil ifTrue:[
- activePointerGrab := nil.
- self primUngrabPointer.
- ]
-! !
-
-!XWorkstation methodsFor:'graphic context stuff'!
-
-noClipIn:aDrawableId gc:aGCId
- "disable clipping rectangle"
-
- <context: #return>
-%{
-
- XGCValues gcv;
- GC gc;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)) {
- gc = __GCVal(aGCId);
- gcv.clip_mask = None;
- ENTER_XLIB();
- XChangeGC(myDpy, gc, GCClipMask, &gcv);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setBackground:bgColorIndex in:aGCId
- "set background color to be drawn with"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)
- && __isSmallInteger(bgColorIndex)) {
- ENTER_XLIB();
- XSetBackground(myDpy, __GCVal(aGCId), __intVal(bgColorIndex));
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setBitmapMask:aBitmapId in:aGCId
- "set or clear the drawing mask - a bitmap mask using current fg/bg"
-
- <context: #return>
-%{
-
- GC gc;
- Pixmap bitmap;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- if (__isExternalAddress(aGCId)) {
- gc = __GCVal(aGCId);
- if (__isExternalAddress(aBitmapId)) {
- bitmap = __PixmapVal(aBitmapId);
- ENTER_XLIB();
- XSetStipple(dpy, gc, bitmap);
- XSetFillStyle(dpy, gc, FillOpaqueStippled);
- LEAVE_XLIB();
- RETURN ( self );
- }
- if (aBitmapId == nil) {
- ENTER_XLIB();
- XSetFillStyle(dpy, gc, FillSolid);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setClipByChildren:aBool in:aDrawableId gc:aGCId
- "enable/disable drawing into child views"
-
- <context: #return>
-%{
-
- XGCValues gcv;
- GC gc;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)) {
- gc = __GCVal(aGCId);
- if (aBool == true)
- gcv.subwindow_mode = ClipByChildren;
- else
- gcv.subwindow_mode = IncludeInferiors;
-
- ENTER_XLIB();
- XChangeGC(myDpy, gc, GCSubwindowMode, &gcv);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setClipX:clipX y:clipY width:clipWidth height:clipHeight in:drawableId gc:aGCId
- "clip to a rectangle"
-
- <context: #return>
-%{
-
- XRectangle r;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)
- && __bothSmallInteger(clipX, clipY)
- && __bothSmallInteger(clipWidth, clipHeight)) {
- r.x = __intVal(clipX);
- r.y = __intVal(clipY);
- r.width = __intVal(clipWidth);
- r.height = __intVal(clipHeight);
- ENTER_XLIB();
- XSetClipRectangles(myDpy, __GCVal(aGCId), 0, 0, &r, 1, Unsorted);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setDashes:dashList dashOffset:offset in:aGCId
- "set line attributes"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)
- && __isSmallInteger(offset)
- && __isByteArrayLike(dashList)) {
- ENTER_XLIB();
- XSetDashes(myDpy, __GCVal(aGCId),
- __intVal(offset),
- __ByteArrayInstPtr(dashList)->ba_element,
- __byteArraySize(dashList));
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-bad: ;
-%}.
- "
- either aGCId is invalid,
- and/or dashList is not a byteArray
- and/or offset is not a smallInteger
- "
- self primitiveFailedOrClosedConnection
-!
-
-setFont:aFontId in:aGCId
- "set font to be drawn in"
-
- <context: #return>
-%{
-
- XFontStruct *f;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aFontId)
- && __isExternalAddress(aGCId)) {
- f = (XFontStruct *) __FontVal(aFontId);
- ENTER_XLIB();
- XSetFont(myDpy, __GCVal(aGCId), f->fid);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- "
- aGCId and/or aFontId are invalid
- "
- self primitiveFailedOrClosedConnection
-!
-
-setForeground:fgColorIndex background:bgColorIndex in:aGCId
- "set foreground and background colors to be drawn with"
-
- <context: #return>
-%{
-
- GC gc;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
- if (__bothSmallInteger(fgColorIndex, bgColorIndex)
- && __isExternalAddress(aGCId)) {
- gc = __GCVal(aGCId);
-
- ENTER_XLIB();
- XSetForeground(dpy, gc, __intVal(fgColorIndex));
- XSetBackground(dpy, gc, __intVal(bgColorIndex));
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setForeground:fgColorIndex in:aGCId
- "set foreground color to be drawn with"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)
- && __isSmallInteger(fgColorIndex)) {
- ENTER_XLIB();
- XSetForeground(myDpy, __GCVal(aGCId), __intVal(fgColorIndex));
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setFunction:aFunctionSymbol in:aGCId
- "set alu function to be drawn with"
-
- <context: #return>
-%{
-
- GC gc;
- int fun = -1;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)) {
- gc = __GCVal(aGCId);
- if (aFunctionSymbol == @symbol(copy)) fun = GXcopy;
- else if (aFunctionSymbol == @symbol(copyInverted)) fun = GXcopyInverted;
- else if (aFunctionSymbol == @symbol(xor)) fun = GXxor;
- else if (aFunctionSymbol == @symbol(and)) fun = GXand;
- else if (aFunctionSymbol == @symbol(andReverse)) fun = GXandReverse;
- else if (aFunctionSymbol == @symbol(andInverted)) fun = GXandInverted;
- else if (aFunctionSymbol == @symbol(or)) fun = GXor;
- else if (aFunctionSymbol == @symbol(orReverse)) fun = GXorReverse;
- else if (aFunctionSymbol == @symbol(orInverted)) fun = GXorInverted;
- else if (aFunctionSymbol == @symbol(invert)) fun = GXinvert;
- else if (aFunctionSymbol == @symbol(clear)) fun = GXclear;
- else if (aFunctionSymbol == @symbol(set)) fun = GXset;
- else if (aFunctionSymbol == @symbol(noop)) fun = GXnoop;
- else if (aFunctionSymbol == @symbol(equiv)) fun = GXequiv;
- else if (aFunctionSymbol == @symbol(nand)) fun = GXnand;
- if (fun != -1) {
- ENTER_XLIB();
- XSetFunction(myDpy, gc, fun);
- LEAVE_XLIB();
- 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 primitiveFailedOrClosedConnection
-!
-
-setGraphicsExposures:aBoolean in:aGCId
- "set or clear the graphics exposures flag"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)) {
- ENTER_XLIB();
- XSetGraphicsExposures(myDpy, __GCVal(aGCId), (aBoolean==true)?1:0);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setLineWidth:aNumber style:lineStyle cap:capStyle join:joinStyle in:aGCId
- "set line attributes;
- lineStyle must be one of #solid, #dashed or #doubleDashed;
- capStyle one of: #notLast, #butt, #round or #projecting;
- joinStyle one of: #miter, #bevel or #round."
-
- <context: #return>
-%{
-
- int x_style, x_cap, x_join;
- static char dashList[2] = { 1,1 };
- static char dotList[2] = { 4,4 };
- static char dashDotList[4] = { 4,1 , 1,1 };
- static char dashDotDotList[6] = { 4,1 , 1,1 , 1,1 };
- char *x_dashes = 0;
- int x_nDash;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aGCId)
- && __isSmallInteger(aNumber)) {
- Display *dpy = myDpy;
-
- if (lineStyle == @symbol(solid)) {
- x_dashes = (char *)0;
- x_style = LineSolid;
- } else if (lineStyle == @symbol(dashed)) {
- x_dashes = dashList;
- x_nDash = sizeof(dashList);
- x_style = LineOnOffDash;
- } else if (lineStyle == @symbol(doubleDashed)) {
- x_dashes = dashList;
- x_nDash = sizeof(dashList);
- x_style = LineDoubleDash;
- } else if (lineStyle == @symbol(dotted)) {
- x_dashes = dotList;
- x_nDash = sizeof(dotList);
- x_style = LineOnOffDash;
- } else if (lineStyle == @symbol(dashDot)) {
- x_dashes = dashDotList;
- x_nDash = sizeof(dashDotList);
- x_style = LineOnOffDash;
- } else if (lineStyle == @symbol(dashDotDot)) {
- x_dashes = dashDotDotList;
- x_nDash = sizeof(dashDotDotList);
- x_style = LineOnOffDash;
- } 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;
-
- ENTER_XLIB();
- if (x_dashes) {
- XSetDashes(dpy, __GCVal(aGCId), 0, x_dashes, x_nDash);
- }
- XSetLineAttributes(dpy,
- __GCVal(aGCId), __intVal(aNumber),
- x_style, x_cap, x_join);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-bad: ;
-%}.
- "
- either aGCId is invalid,
- and/or lineWidth is not a smallInteger,
- and/or lineStyle is none of #solid, #dashed, #doubleDashed
- and/or capStyle is none of #notLast, #butt, #round, #projecting
- and/or joinStyle is none of #miter, #bevel, #round
- "
- self primitiveFailedOrClosedConnection
-!
-
-setMaskOriginX:orgX y:orgY in:aGCid
- "set the mask origin"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- if (__bothSmallInteger(orgX, orgY) && __isExternalAddress(aGCid)) {
- ENTER_XLIB();
- XSetTSOrigin(myDpy, __GCVal(aGCid), __intVal(orgX), __intVal(orgY));
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setPixmapMask:aPixmapId in:aGCId
- "set or clear the drawing mask - a pixmap mask providing full color"
-
- <context: #return>
-%{
-
- GC gc;
- Pixmap pixmap;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- if (__isExternalAddress(aGCId)) {
- gc = __GCVal(aGCId);
- if (__isExternalAddress(aPixmapId)) {
- pixmap = __PixmapVal(aPixmapId);
- ENTER_XLIB();
- XSetTile(dpy, gc, pixmap);
- XSetFillStyle(dpy, gc, FillTiled);
- LEAVE_XLIB();
- RETURN ( self );
- }
- if (aPixmapId == nil) {
- ENTER_XLIB();
- XSetFillStyle(dpy, gc, FillSolid);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-! !
-
-!XWorkstation methodsFor:'initialization & release'!
-
-closeConnection
- "close down the connection to the X-server"
-
- <context: #return>
-
-"/ 'closing' errorPrintCR.
-"/ thisContext fullPrintAll.
-
-%{ /* UNLIMITEDSTACK */ /* calls XSync()! */
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
-
- __INST(displayId) = nil;
- ENTER_XLIB();
- XCloseDisplay(dpy);
- LEAVE_XLIB();
- }
-%}
-!
-
-emergencyCloseConnection
- "low level close of the displays connection (without sending any buffered
- requests to the display). Only used in case of emergency (brokenConnection)"
-
-%{
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- __INST(displayId) = nil;
- close(ConnectionNumber(dpy));
- }
-%}
-!
-
-eventBufferSize
-%{
- RETURN ( __MKSMALLINT(sizeof(XEvent) + 100) );
-%}
-!
-
-getWindowGroupWindow
- "Creates a fake WindowGroup view. This window is used
- in XWMHints & _NET_WM_LEADER properties to define
- application window group"
-
- windowGroupWindow isNil ifTrue:[
- windowGroupWindow := WindowGroupWindow new create.
- ].
- ^ windowGroupWindow
-!
-
-initializeDefaultValues
- activateOnClick := false.
- maxOperationsUntilFlush := nil.
-
- super initializeDefaultValues.
-
- "JV@2012: On X11, mouse buttons are: left=1, middle=2, right=3
- Even on 2-button mouse (button 2 is simply not reported).
- Here the middle button is mapped to button #paste (which in EditTextView
- pastes the PRIMARY selection). 128 is here to make clear that this
- is somewhat special value.
-
- This remapping kludge is here to have all the widget's code backward/windows
- compatible while still having X11's middle button behavior.
-
- Also note, that buttonTranslation is overwritten in display.rc,
- the code is here just for a case display.rc is not read/available
- and for documentation (symbol references does not search .rc files).
- "
-
- buttonTranslation := buttonTranslation copy.
- buttonTranslation at: 2 put: #paste
-
- "Modified (comment): / 17-04-2012 / 21:18:34 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-initializeDeviceSignals
- super initializeDeviceSignals.
-
- deviceIOTimeoutErrorSignal := deviceIOErrorSignal newSignal.
- deviceIOTimeoutErrorSignal nameClass:self message:#deviceIOTimeoutErrorSignal.
-
- ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayError.
- ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOError.
- ObjectMemory registerErrorInterruptHandler:self class forID:#DisplayIOTimeoutError.
-!
-
-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"
-
- displayId notNil ifTrue:[
- "/ already connected - you bad guy try to trick me manually ?
- ^ self
- ].
-
- displayId := self openConnectionTo:aDisplayName.
- displayId isNil ifTrue:[
- "/ could not connect.
- DeviceOpenErrorSignal raiseWith:aDisplayName.
- ^ nil
- ].
-
- xlibTimeout := xlibTimeout ? DefaultXLibTimeout.
- xlibTimeoutForWindowCreation := xlibTimeoutForWindowCreation ? DefaultXLibTimeoutForWindowCreation.
- hasConnectionBroken := false.
-
- dispatching := false.
- dispatchingExpose := false.
- isSlow := false.
- shiftDown := false.
- ctrlDown := false.
- metaDown := false.
- altDown := false.
- motionEventCompression := true.
- buttonsPressed := 0.
- displayName := aDisplayName.
-
- listOfXFonts := nil.
-
- atoms := nil.
-
- "These values are initialized by primitive code in #createWindowFor:..."
- protocolsAtom := nil.
- deleteWindowAtom := nil.
- saveYourselfAtom := nil.
- quitAppAtom := nil.
-
- self initializeDeviceResourceTables.
- self initializeScreenProperties.
-
- self initializeDefaultValues.
- self initializeSpecialFlags.
- self initializeKeyboardMap.
- self initializeDeviceSignals.
-
- self initializeViewStyle.
-!
-
-initializeModifierMappings
- "initialize keyboard modifiers.
- We assume that mod1 are the META modifiers and mod2 are the ALT modifiers,
- but if any of them contains the Num_Lock key, it is disregarded."
-
- |map|
-
- super initializeModifierMappings.
-
- rawKeySymTranslation := RawKeySymTranslation.
-
- map := self modifierMapping.
- map isNil ifTrue:[
- "/
- "/ mhmh - a crippled Xlib which does not provide modifier mappings
- "/ setup some reasonable default. If that is not sufficient,
- "/ you have to change things from your display.rc file.
- "/
- altModifierMask := self modifier1Mask.
- metaModifierMask := self modifier2Mask.
- ] ifFalse:[
- | mod symbolFromKeyCode nonNilOnes |
-
- altModifierMask := 0.
- metaModifierMask := 0.
-
- symbolFromKeyCode := [:key | self symbolFromKeycode:key].
- nonNilOnes := [:str | str notNil].
-
- mod := map at:1.
- mod notNil ifTrue:[
- shiftModifiers := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
- ].
- mod := map at:3.
- mod notNil ifTrue:[
- ctrlModifiers := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
- ].
- mod := map at:4.
- mod notNil ifTrue:[
- mod := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
- (mod includes:#'Num_Lock') ifFalse:[
- metaModifiers := mod.
- metaModifierMask := 1 bitShift:(4-1).
- ].
- ].
- mod := map at:5.
- mod notNil ifTrue:[
- mod := mod collect:symbolFromKeyCode thenSelect:nonNilOnes.
- (mod includes:#'Num_Lock') ifFalse:[
- altModifiers := mod.
- altModifierMask := 1 bitShift:(5-1).
- ].
- ]
- ].
-
- "
- Display initializeModifierMappings
- "
-
- "Modified: 1.12.1995 / 23:44:40 / stefan"
-!
-
-initializeScreenBounds
- self isXineramaActive ifTrue:[
- |rect|
-
- self monitorBounds do:[:eachRect|
- rect isNil ifTrue:[
- rect := eachRect.
- ] ifFalse:[
- rect := rect merge:eachRect.
- ]
- ].
- width := rect width.
- height := rect height.
-
- "propagate possible size changes to our rottView"
- rootView notNil ifTrue:[
- rootView initialize.
- ].
- ] ifFalse:[
- width := self queryWidth.
- height := self queryHeight.
- ].
- widthMM := self queryWidthMM.
- heightMM := self queryHeightMM.
-
- "
- Display initializeScreenBounds
- "
-!
-
-initializeScreenProperties
- |masks|
-
- super initializeScreenProperties.
-
- hasShapeExtension := self queryShapeExtension.
- hasShmExtension := self querySHMExtension.
- hasDPSExtension := self queryDPSExtension.
- hasXVideoExtension := self queryXVideoExtension.
- hasMbufExtension := self queryMBUFExtension.
- hasPEXExtension := self queryPEXExtension.
- hasImageExtension := self queryXIEExtension.
- hasInputExtension := self queryXIExtension.
- hasXineramaExtension := self queryXineramaExtension.
- hasRenderExtension := self queryRenderExtension.
- hasXftLibrary := self queryXftLibrary.
-
- primaryAtom := self atomIDOf:#PRIMARY.
- stringAtom := self atomIDOf:#STRING.
- clipboardAtom := self atomIDOf:#CLIPBOARD.
-
- altModifierMask := self modifier2Mask.
- metaModifierMask := self modifier1Mask.
-
- screen := self queryDefaultScreen.
-
- self initializeScreenBounds.
-
- depth := self queryDepth.
- ncells := self queryCells.
- blackpixel := self queryBlackPixel.
- whitepixel := self queryWhitePixel.
-
- monitorType := #unknown.
- visualType := self queryDefaultVisualType.
-
- hasColors := hasGreyscales := true.
- (visualType == #StaticGray
- or:[ visualType == #GrayScale]) ifTrue:[
- hasColors := false.
- monitorType := #monochrome.
- ].
-
- ncells == 2 ifTrue:[
- hasColors := hasGreyscales := false.
- ].
-
- masks := self queryRGBMasks.
- redMask := masks at:1.
- greenMask := masks at:2.
- blueMask := masks at:3.
- bitsPerRGB := masks at:4.
-
- visualType == #TrueColor ifTrue:[
- redShift := redMask lowBit - 1.
- greenShift := greenMask lowBit - 1.
- blueShift := blueMask lowBit - 1.
-
- bitsRed := redMask highBit - redMask lowBit + 1.
- bitsGreen := greenMask highBit - greenMask lowBit + 1.
- bitsBlue := blueMask highBit - blueMask lowBit + 1.
- ].
-
-%{
-
- Display *dpy;
- int scr;
- Visual *visual;
- XVisualInfo viproto;
- XVisualInfo *vip; /* returned info */
- int maxRGBDepth, maxRGBADepth;
- int rgbRedMask, rgbGreenMask, rgbBlueMask;
- int rgbaRedMask, rgbaGreenMask, rgbaBlueMask, rgbaAlphaMask;
- int rgbVisualID, rgbaVisualID;
- int nvi, i;
- char *type, *nm;
- int dummy;
-
- if (ISCONNECTED) {
- dpy = myDpy;
-
- /*
- * look for RGB visual with the highest depth
- */
- nvi = 0;
- viproto.screen = scr;
- vip = XGetVisualInfo (dpy, VisualScreenMask, &viproto, &nvi);
- maxRGBDepth = maxRGBADepth = 0;
- for (i = 0; i < nvi; i++) {
- int thisDepth = vip[i].depth;
-
- switch (vip[i].class) {
- case TrueColor:
- if (thisDepth > maxRGBDepth) {
- if (thisDepth <= 24) {
- maxRGBDepth = thisDepth;
- rgbRedMask = vip[i].red_mask;
- rgbGreenMask = vip[i].green_mask;
- rgbBlueMask = vip[i].blue_mask;
- rgbVisualID = vip[i].visualid;
- } else {
- if (thisDepth > maxRGBADepth) {
- // printf("found rgba visual!\n");
- maxRGBADepth = thisDepth;
- rgbaRedMask = vip[i].red_mask;
- rgbaGreenMask = vip[i].green_mask;
- rgbaBlueMask = vip[i].blue_mask;
- rgbaVisualID = vip[i].visualid;
- }
- }
- }
- break;
- }
- }
- if (vip) XFree ((char *) vip);
-
- if (maxRGBDepth) {
- __INST(rgbVisual) = __MKEXTERNALADDRESS(rgbVisualID); __STORESELF(rgbVisual);
- }
- if (maxRGBADepth) {
- __INST(rgbaVisual) = __MKEXTERNALADDRESS(rgbaVisualID); __STORESELF(rgbaVisual);
- if (!maxRGBDepth) {
- __INST(rgbVisual) = __INST(rgbaVisual); __STORESELF(rgbVisual);
- }
- }
- }
-%}.
-!
-
-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.
- ].
-!
-
-initializeUniqueID
- uniqueDeviceID isNil ifTrue:[
- uniqueDeviceID := UUID genUUID.
- ]
-!
-
-openConnectionTo:dpyName
- "open a connection to some display;
- return the displayId if ok, nil of not ok"
-
-%{ /* STACK:100000 */ /* XOpenDisplay() calls gethostbyname() */
- Display *dpy;
- int i;
- char *nm;
-
- if (__isStringLike(dpyName))
- nm = (char *) __stringVal(dpyName);
- else {
- nm = NULL;
- }
- dpy = XOpenDisplay(nm);
-
- if (dpy) {
- static int firstCall = 1;
- OBJ dpyID;
-
- dpyID = __MKEXTERNALADDRESS(dpy);
-
- if (firstCall) {
- firstCall = 0;
- XSetErrorHandler(__XErrorHandler__);
- XSetIOErrorHandler(__XIOErrorHandler__);
- }
- RETURN (dpyID);
- }
-%}.
- ^ nil
-!
-
-queryBlackPixel
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(BlackPixel(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryBlackPixel
- "
-!
-
-queryCells
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(DisplayCells(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryCells
- "
-!
-
-queryDPSExtension
-%{ /* NOCONTEXT */
-
-#ifdef DPS
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, "DPSExtension", &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryDPSExtension
- "
-!
-
-queryDefaultScreen
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
-
- dpy = myDpy;
- RETURN ( __MKSMALLINT(DefaultScreen(dpy)));
- }
-%}.
- ^ nil
-
- "
- Display queryDefaultScreen
- "
-!
-
-queryDefaultVisualType
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- Visual *visual;
-
- dpy = myDpy;
- visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
- switch (visual->class) {
- case StaticGray:
- RETURN ( @symbol(StaticGray) );
- case GrayScale:
- RETURN ( @symbol(GrayScale) );
- case StaticColor:
- RETURN ( @symbol(StaticColor) );
- case PseudoColor:
- RETURN ( @symbol(PseudoColor) );
- case TrueColor:
- RETURN ( @symbol(TrueColor) );
- case DirectColor:
- RETURN ( @symbol(DirectColor) );
- }
- }
-%}.
- ^ nil
-
- "
- Display queryDefaultVisualType
- "
-!
-
-queryDepth
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(DisplayPlanes(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryDepth
- "
-!
-
-queryHeight
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(DisplayHeight(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryHeight
- "
-!
-
-queryHeightMM
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(DisplayHeightMM(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryHeightMM
- "
-!
-
-queryMBUFExtension
-%{ /* NOCONTEXT */
-
-#ifdef MBUF
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, "Multi-Buffering", &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryMBUFExtension
- "
-!
-
-queryPEXExtension
-%{ /* NOCONTEXT */
-
-#ifdef PEX5
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, PEX_NAME_STRING, &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryPEXExtension
- "
-!
-
-queryRGBMasks
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- Visual *visual;
- OBJ redMask, greenMask, blueMask, bprgb;
-
- dpy = myDpy;
- visual = DefaultVisualOfScreen(DefaultScreenOfDisplay(dpy));
- redMask = __MKSMALLINT(visual->red_mask);
- greenMask = __MKSMALLINT(visual->green_mask);
- blueMask = __MKSMALLINT(visual->blue_mask);
- bprgb = __MKSMALLINT(visual->bits_per_rgb);
- RETURN ( __ARRAY_WITH4(redMask, greenMask, blueMask, bprgb) );
- }
-%}.
- ^ nil
-
- "
- Display queryRGBMasks
- "
-!
-
-queryRenderExtension
-%{ /* NOCONTEXT */
-
-#ifdef XRENDER
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XRenderQueryExtension (dpy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryRenderExtension
- "
-!
-
-querySHMExtension
-%{ /* NOCONTEXT */
-
-#ifdef xxSHM
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, "MIT_SHM", &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display querySHMExtension
- "
-!
-
-queryShapeExtension
-%{ /* NOCONTEXT */
-
-#ifdef SHAPE
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XShapeQueryExtension(dpy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryShapeExtension
- "
-!
-
-queryWhitePixel
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(WhitePixel(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryWhitePixel
- "
-!
-
-queryWidth
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(DisplayWidth(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryWidth
- "
-!
-
-queryWidthMM
-%{ /* NOCONTEXT */
-
- if (ISCONNECTED) {
- Display *dpy;
- int scr;
-
- dpy = myDpy;
- scr = DefaultScreen(dpy);
- RETURN ( __MKSMALLINT(DisplayWidthMM(dpy, scr)));
- }
-%}.
- ^ nil
-
- "
- Display queryWidthMM
- "
-!
-
-queryXIEExtension
-%{ /* NOCONTEXT */
-
-#ifdef XIE
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, xieExtName, &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryXIEExtension
- "
-!
-
-queryXIExtension
-%{ /* NOCONTEXT */
-
-#ifdef XI
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, "XInputExtension", &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryXIExtension
- "
-!
-
-queryXVideoExtension
-%{ /* NOCONTEXT */
-
-#ifdef XVIDEO
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XQueryExtension(dpy, "XVideo", &dummy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryXVideoExtension
- "
-!
-
-queryXftLibrary
-%{
-#ifndef XFT
- RETURN (false);
-#endif
-%}.
- ^ self queryRenderExtension
-!
-
-queryXineramaExtension
-%{ /* NOCONTEXT */
-
-#ifdef XINERAMA
- if (ISCONNECTED) {
- Display *dpy;
- int dummy;
-
- dpy = myDpy;
-
- if (XineramaQueryExtension (dpy, &dummy, &dummy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display queryXineramaExtension
- "
-!
-
-reinitialize
- preWaitAction notNil ifTrue:[
- Processor removePreWaitAction:preWaitAction.
- preWaitAction := nil.
- ].
- virtualRootId := rootId := nil.
- selectionFetchers := nil.
- super reinitialize.
- dispatchingExpose := nil
-!
-
-releaseDeviceResources
- preWaitAction notNil ifTrue:[
- Processor removePreWaitAction:preWaitAction.
- preWaitAction := nil.
- ].
- selectionFetchers := nil.
- super releaseDeviceResources.
-! !
-
-!XWorkstation methodsFor:'keyboard mapping'!
-
-altModifierMask
- "return the mask (in motionEvents) for the alt-key modifier.
- Notice: ST/X may use the left ALT key as CMD/Meta key,
- therefore return a variable here, which can be changed during startup."
-
- ^ altModifierMask
-
- "Created: 23.3.1996 / 12:43:22 / cg"
- "Modified: 23.3.1996 / 12:44:56 / cg"
-!
-
-altModifierMask:aSmallInteger
- "define which key takes the role of an alt-key.
- By default, this is X's modifier1, which is the ALT key on
- most keyboards. However, there may be exceptions to this,
- and the setting can be changed with:
- Display altModifierMask:(Display modifier2Mask)
- Setting the mask to 0 disables the ALT key (in ST/X) altogether.
- "
-
- altModifierMask := aSmallInteger
-!
-
-ctrlModifierMask
- "return the Xlib mask bit for the control modifier key"
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(ControlMask));
-%}
-!
-
-metaModifierMask
- "return the mask (in motionEvents) for the meta-key modifier.
- Notice: ST/X may use the left ALT key as CMD/Meta key,
- therefore return a variable here, which can be changed during startup."
-
- ^ metaModifierMask
-
- "Created: 23.3.1996 / 12:43:39 / cg"
- "Modified: 23.3.1996 / 12:45:09 / cg"
-!
-
-metaModifierMask:aSmallInteger
- "define which key takes the role of a meta key.
- By default, this is X's modifier2, which is the 2nd ALT key on
- most keyboards (if present at all).
- However, there may be exceptions to this, and the setting can
- be changed with:
- Display metaModifierMask:(Display modifier1Mask)
- Setting the mask to 0 disables the META key (in ST/X) altogether.
- As reported, some Xservers place the Meta-key onto NumLock,
- and having NumLock enabled makes ST/X think, that meta is pressed
- all the time. On those, you should disable the meta key by setting
- the mask to 0.
- "
-
- metaModifierMask := aSmallInteger
-!
-
-modifier1Mask
- "return the Xlib mask bit for the 1st modifier key.
- See comment in altModifierMask: / metaModifierMask: for what
- this could be used."
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(Mod1Mask));
-%}
-!
-
-modifier2Mask
- "return the Xlib mask bit for the 2nd modifier key.
- See comment in altModifierMask: / metaModifierMask: for what
- this could be used."
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(Mod2Mask));
-%}
-!
-
-modifier3Mask
- "return the Xlib mask bit for the 3rd modifier key.
- See comment in altModifierMask: / metaModifierMask: for what
- this could be used."
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(Mod3Mask));
-%}
-!
-
-modifier4Mask
- "return the Xlib mask bit for the 4th modifier key.
- See comment in altModifierMask: / metaModifierMask: for what
- this could be used."
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(Mod4Mask));
-%}
-!
-
-modifier5Mask
- "return the Xlib mask bit for the 5th modifier key.
- See comment in altModifierMask: / metaModifierMask: for what
- this could be used."
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(Mod5Mask));
-%}
-!
-
-modifierMapping
- "Get the Modifier Mapping.
- We return an array of arrays of keycodes"
-
- |modifierKeyMap maxKeyPerMod ret nextKey|
-
- modifierKeyMap := self rawModifierMapping.
- modifierKeyMap isEmptyOrNil ifTrue:[^ nil].
- maxKeyPerMod := modifierKeyMap size // 8.
-
- 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 asArray.
- ].
- nextKey := nextKey+maxKeyPerMod.
- ].
-
- ^ ret
-
- "
- Display modifierMapping
- "
-
- "
- |mapping|
-
- mapping := Display modifierMapping.
- ^ mapping collect:[:eachRow |
- eachRow notNil ifTrue:[
- eachRow collect:[ :key | Display stringFromKeycode:key ].
- ] ifFalse:[
- nil
- ]
- ].
- "
-!
-
-rawKeySymTranslation
- "Get the raw keyboard mapping (maps some special X-keySyms to STX-internal names
- and can also be used to untranslate a stupid x-mapping (as on hpux)."
-
- ^ rawKeySymTranslation
-
-
- "
- Display rawKeySymTranslation
- "
-!
-
-rawModifierMapping
- "Get the raw Modifier Mapping."
-
- |modifierKeyMap|
-
-%{
- XModifierKeymap *modmap;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- if ((modmap = XGetModifierMapping(dpy)) != 0) {
- modifierKeyMap = __BYTEARRAY_UNINITIALIZED_NEW_INT(modmap->max_keypermod * 8);
- if (modifierKeyMap != nil) {
- memcpy((char *)__ByteArrayInstPtr(modifierKeyMap)->ba_element,
- (char *)modmap->modifiermap, modmap->max_keypermod * 8);
- }
- XFreeModifiermap(modmap);
- }
- }
-%}.
- ^ modifierKeyMap
-
- "
- Display rawModifierMapping
- "
-!
-
-shiftModifierMask
- "return the Xlib mask bit for the shift modifier key"
-
-%{ /* NOCONTEXT */
- RETURN (__MKSMALLINT(ShiftMask));
-%}
-!
-
-superModifierMask
- "return the Xlib mask bit for the super modifier key"
-
- ^ self modifier4Mask
-!
-
-symbolFromKeycode:code
- "Get a KeySymbol (a smalltalk symbol) from the keycode."
-
- |str|
-
-%{
- KeySym keysym;
- char *keystring;
-
- if (ISCONNECTED && __isSmallInteger(code)) {
- Display *dpy = myDpy;
-
-// Our Windows Xlib does not support Xkb as of 2013-01
-// if ((keysym = XkbKeycodeToKeysym(dpy, __intVal(code), 0, 0)) != NoSymbol
- if ((keysym = XKeycodeToKeysym(dpy, __intVal(code), 0)) != NoSymbol
- && (keystring = XKeysymToString(keysym)) != 0)
- str = __MKSYMBOL(keystring, 0);
- }
-%}.
- ^ str
-
- "
- Display symbolFromKeycode:50
- "
-! !
-
-!XWorkstation methodsFor:'misc'!
-
-beep
- "output an audible beep or bell"
-
- UserPreferences current beepEnabled ifTrue:[
- self beep:0 volume:50
- ]
-
- "Modified: / 3.12.1999 / 17:13:59 / ps"
-!
-
-beep:aSymbolOrInteger volume:volumeInPercent
- "output an audible beep. aSymbolOrInteger determines the sound, but is ignored here
- (kept for comaptibilty with WinWorkstation)."
-
- <context: #return>
-%{
- 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;
-
- ENTER_XLIB();
- XBell(myDpy, volume);
- LEAVE_XLIB();
- }
-%}
-!
-
-buffered
- "buffer drawing - do not send it immediately to the display.
- This is the default anyway.
- See #unBuffered for additional info."
-
- <context: #return>
-%{
- if (ISCONNECTED) {
- ENTER_XLIB();
- XSynchronize(myDpy, 0);
- LEAVE_XLIB();
- }
-%}
- "
- Display buffered
- "
-!
-
-flush
- "send all buffered drawing to the display.
- This may be required to make certain, that all previous operations
- are really sent to the display before continuing. For example,
- after a cursor-change with a followup long computation.
- (otherwise, the cursor change request may still be in the output buffer)
- See also #sync, which even waits until the request has been processed."
-
- <context: #return>
-%{
- if (ISCONNECTED) {
- ENTER_XLIB();
- XFlush(myDpy);
- LEAVE_XLIB();
- }
-%}.
-
- operationsUntilFlush := maxOperationsUntilFlush.
-!
-
-flushDpsContext:aDPSContext
- <context: #return>
-%{
-#ifdef DPS
- if (ISCONNECTED
- && __isExternalAddress(aDPSContext)) {
- ENTER_XLIB();
- DPSFlushContext(__DPSContextVal(aDPSContext));
- LEAVE_XLIB();
-
- RETURN ( self );
- }
-#endif
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-primSync
- "send all buffered drawing to the display AND wait until the display
- has finished drawing it.
- This is almost never needed, except if you are about to read previously
- drawn pixels back from the display screen, or you want to wait for a beep
- to be finished. See also #flush."
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
-
- ENTER_XLIB();
- XSync(myDpy, 0);
- LEAVE_XLIB();
-
- }
-%}.
- operationsUntilFlush := maxOperationsUntilFlush.
-!
-
-refreshKeyboardMapping:eB
- <context: #return>
-%{
- XMappingEvent *ev;
-
- if (ISCONNECTED && __isByteArrayLike(eB)) {
- ev = (XMappingEvent *)(__ByteArrayInstPtr(eB)->ba_element);
- ENTER_XLIB();
- XRefreshKeyboardMapping(ev);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-roundTripTime
- "answer the round trip time in milliSeconds.
- May be used to detect slow X11 connections"
-
- self sync.
- ^ Timestamp millisecondsToRun:[ self primSync ].
-
- "
- Screen current roundTripTime
- "
-!
-
-setInputFocusTo:aWindowId
- "set the focus to the view as defined by aWindowId.
- When released, return the focus to the root window"
-
-"/ 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."
-
- <context: #return>
-%{
- int arg;
- Window focusWindow;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aWindowId)) {
- focusWindow = __WindowVal(aWindowId);
- } else if (aWindowId == nil) {
- focusWindow = None;
- } else
- goto err;
- if (revertSymbol == @symbol(parent))
- arg = RevertToParent;
- else if (revertSymbol == @symbol(root))
- arg = RevertToPointerRoot;
- else
- arg = RevertToNone;
-
-
- ENTER_XLIB();
- XSetInputFocus(myDpy, focusWindow, arg, CurrentTime);
- LEAVE_XLIB();
-
- RETURN ( self );
- }
-err:;
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-sync
- "send all buffered drawing to the display AND wait until the display
- has finished drawing it.
- This is almost never needed, except if you are about to read previously
- drawn pixels back from the display screen, or you want to wait for a beep
- to be finished. See also #flush."
-
- self primSync.
- self dispatchPendingEvents.
-!
-
-unBuffered
- "make all drawing be sent immediately to the display.
- This makes all graphics synchronous and turns off any buffering
- (i.e. each individual draw-request is sent immediately without
- packing multiple requests into a larger message buffer).
- Be prepared, that this slows down graphics considerably.
- However, it allows display errors to be handled immediately and
- may be useful if you get Xdisplay errors and want to find the request
- which was responsible for it. See also #buffered."
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
-
- ENTER_XLIB();
- XSynchronize(myDpy, 1);
- LEAVE_XLIB();
-
- }
-%}
- "
- Display unBuffered
- "
-! !
-
-!XWorkstation methodsFor:'pointer stuff'!
-
-anyButtonStateMask
- "return an integer for masking out any button from a
- buttonStates value."
-
- "/ should use ``Display buttonXMotionMask bitOr:....''
-
- ^ 256 + 512 + 1024
-
- "Modified: 23.3.1996 / 12:41:33 / cg"
- "Created: 23.3.1996 / 12:46:35 / cg"
-!
-
-buttonStates
- "return an integer representing the state of the pointer buttons;
- a one-bit in positions 0.. represent a pressed button.
- See the button1Mask/button2Mask/button3Mask,
- shiftMask/controlMask and modifierMask methods for the meaning of the bits."
-
- <context: #return>
-%{
- Window w;
- int screen = __intVal(__INST(screen));
- Window rootRet, childRet;
- int rootX, rootY, winX, winY;
- unsigned int mask;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- w = RootWindow(dpy, screen);
- if (w) {
-
- ENTER_XLIB();
- XQueryPointer(dpy, w, &rootRet, &childRet,
- &rootX, &rootY,
- &winX, &winY,
- &mask);
- LEAVE_XLIB();
-
- RETURN (__MKSMALLINT(mask));
- }
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ nil
-
- "
- Display buttonStates
- "
-
- "is the control-key pressed ?
-
- Display buttonStates bitTest:(Display controlMask)
- "
-
- "is the alt/meta-key pressed ?
-
- Display buttonStates bitTest:(Display altModifierMask)
- Display buttonStates bitTest:(Display metaModifierMask)
- "
-!
-
-leftButtonStateMask
- "return an integer for masking out the left button from a
- buttonStates value"
-
- "/ should use ``Display button1MotionMask''
-
- ^ 256
-
- "Modified: 23.3.1996 / 12:41:33 / cg"
-!
-
-middleButtonStateMask
- "return an integer for masking out the middle button from a
- buttonStates value"
-
- "/ should use ``Display button2MotionMask''
-
- ^ 512
-
- "Modified: 23.3.1996 / 12:41:43 / cg"
-!
-
-pointerPosition
- "return the current pointer position in (virtual) root-window coordinates"
-
- <context: #return>
-
- |xpos ypos rootWindowId|
-
- rootWindowId := self rootWindowId.
-
-%{
- int screen = __intVal(__INST(screen));
- Window rootRet, childRet;
- int rootX, rootY, winX, winY;
- unsigned int mask;
-
- if (ISCONNECTED && rootWindowId != nil) {
- Display *dpy = myDpy;
- Window w = (Window)__externalAddressVal(rootWindowId);
-
- ENTER_XLIB();
- XQueryPointer(dpy, w, &rootRet, &childRet,
- &rootX, &rootY,
- &winX, &winY,
- &mask);
- LEAVE_XLIB();
- xpos = __MKSMALLINT(rootX);
- ypos = __MKSMALLINT(rootY);
-
- }
-%}.
- xpos isNil ifTrue:[
- self primitiveFailedOrClosedConnection.
- ^ nil
- ].
- ^ xpos @ ypos
-!
-
-rightButtonStateMask
- "return an integer for masking out the right button from a
- buttonStates value"
-
- "/ should use ``Display button3MotionMask''
-
- ^ 1024
-
- "Modified: 23.3.1996 / 12:41:52 / cg"
-!
-
-rootPositionOfLastEvent
- "return the position in root-window coordinates
- of the last button, key or pointer event"
-
- ^ eventRootX @ eventRootY
-!
-
-setPointerPosition:newPosition in:aWindowId
- "change the pointer position to a new position relative to the
- given windows origin (which may be the rootWindow).
- Be careful with this - its usually not very ergonomically
- to change the mousePointer position.
- This interface is provided for special applications (presentation
- playback) and should not be used in normal applications."
-
- <context: #return>
-
- |xpos ypos|
-
- xpos := newPosition x.
- ypos := newPosition y.
-
-%{
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __bothSmallInteger(xpos, ypos)) {
- Display *dpy = myDpy;
- Window w = __WindowVal(aWindowId);
-
- ENTER_XLIB();
- XWarpPointer(dpy,
- None, /* src window */
- w, /* dst window */
- 0, /* src_x */
- 0, /* src_y */
- 0, /* src_w */
- 0, /* src_h */
- __intVal(xpos), /* dst_x */
- __intVal(ypos) /* dst_y */
- );
- LEAVE_XLIB();
- }
-%}.
- ^ self
-
- "
- Display setPointerPosition:1000@1000
- "
-! !
-
-!XWorkstation methodsFor:'private'!
-
-addSelectionHandler:someone
- "register someone to be notified when the selection changes"
-
- selectionHandlers isNil ifTrue:[
- selectionHandlers := IdentitySet new.
- ].
- selectionHandlers add:someone
-!
-
-findSelectionFetcher:aDrawableId
- "find the SelectionFetcher that receives selection events for aDrawableId.
- Answer nil, if there is none"
-
- selectionFetchers isNil ifTrue:[
- ^ nil.
- ].
-
- ^ selectionFetchers at:aDrawableId ifAbsent:[].
-!
-
-registerSelectionFetcher:aSelectionFetcher
- "register a SelectionFetcher that receives selection events for aDrawableId"
-
- selectionFetchers isNil ifTrue:[
- selectionFetchers := Dictionary new.
- ].
-
- selectionFetchers at:aSelectionFetcher drawableID put:aSelectionFetcher.
-!
-
-removeSelectionHandler:someone
- "no longer tell someone about selection changes"
-
- selectionHandlers notNil ifTrue:[
- selectionHandlers remove:someone ifAbsent:nil.
- selectionHandlers := selectionHandlers asNilIfEmpty
- ].
-!
-
-unregisterSelectionFetcher:aSelectionFetcher
- "unregister a SelectionFetcher that received selection events for aDrawableId"
-
- selectionFetchers removeKey:aSelectionFetcher drawableID.
-! !
-
-!XWorkstation methodsFor:'properties'!
-
-deleteProperty:propertyID for:aWindowID
- "delete a property in the XServer"
-
- <context: #return>
-
-%{
- if (ISCONNECTED && __isAtomID(propertyID)) {
- Display *dpy = myDpy;
- Atom prop;
- Window window;
-
- prop = __AtomVal(propertyID);
-
- if (__isExternalAddress(aWindowID)) {
- window = __WindowVal(aWindowID);
- } else if (aWindowID == nil) {
- window = DefaultRootWindow(dpy);
- } else if (__isInteger(aWindowID)) {
- window = (Window)__unsignedLongIntVal(aWindowID);
- } else {
- goto fail;
- }
-
- ENTER_XLIB();
- XDeleteProperty(dpy, window, prop);
- LEAVE_XLIB();
- RETURN(true);
- }
-fail:;
-%}.
- self primitiveFailedOrClosedConnection.
-!
-
-getProperty:propertySymbolOrAtomID from:aWindowOrWindowIDOrNil delete:doDelete
- "get a property as an association propertyType->propertyValue"
-
- <context: #return>
-
- |val typeID propertyID windowID|
-
- propertySymbolOrAtomID isString ifTrue:[
- propertyID := self atomIDOf:propertySymbolOrAtomID create:false.
- propertyID isNil ifTrue:[^ nil].
- ] ifFalse:[
- propertyID := propertySymbolOrAtomID.
- ].
- aWindowOrWindowIDOrNil isView ifTrue:[
- windowID := aWindowOrWindowIDOrNil id.
- ] ifFalse:[
- windowID := aWindowOrWindowIDOrNil.
- ].
-
-%{
- Window window;
- Atom property;
- char *cp, *cp2;
- Atom actual_type;
- int actual_format;
- unsigned long nitems, bytes_after, nread;
- unsigned char *data;
- int ok = 1;
-# define PROP_SIZE 2048
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- if (__isAtomID(propertyID)) {
- property = __AtomVal(propertyID);
-
- if (__isExternalAddress(windowID)) {
- window = __WindowVal(windowID);
- } else if (windowID == nil) {
- window = DefaultRootWindow(dpy);
- } else
- goto fail;
-
- nread = 0;
- cp = 0;
-#ifdef PROPERTY_DEBUG
- console_fprintf(stderr, "getProperty %x\n", property);
-#endif
-
- do {
- int retVal;
-
- ENTER_XLIB();
- retVal = XGetWindowProperty(dpy, window, property, nread/4, PROP_SIZE,
- doDelete == true,
- AnyPropertyType, &actual_type, &actual_format,
- &nitems, &bytes_after, (unsigned char **)&data);
- LEAVE_XLIB();
- if (retVal != Success) {
-#ifdef PROPERTY_DEBUG
- console_fprintf(stderr, "- no success\n");
-#endif
- ok = 0;
- break;
- }
-#ifdef PROPERTY_DEBUG
- console_fprintf(stderr, "- type:%x\n", actual_type);
-#endif
- nitems *= (actual_format / 8);
- typeID = __MKATOMOBJ(actual_type);
- if (! cp) {
- cp = cp2 = (char *)malloc(nitems+bytes_after);
- } else {
- cp2 = cp + nread;
- }
- if (! cp) {
- XFree(data);
- goto fail;
- }
-
- nread += nitems;
- bcopy(data, cp2, nitems);
- XFree(data);
-#ifdef PROPERTY_DEBUG
- console_fprintf(stderr, "- <nitems:%d bytes_after:%d>\n", nitems, bytes_after);
-#endif
- } while (bytes_after > 0);
-
- if (ok) {
- switch (actual_format) {
- case 32:
- val = __stArrayFromCUIntArray((unsigned int*)cp, nread/4);
- break;
- case 16:
- val = __stArrayFromCUShortArray((unsigned short*)cp, nread/2);
- break;
- case 8:
- default:
- if (actual_type == XA_STRING) {
- val = __MKSTRING_L(cp, nread);
- } else {
- val = __MKBYTEARRAY(cp, nread);
- }
- break;
- }
- }
- if (cp)
- free(cp);
- }
- }
-fail: ;
-%}.
- (typeID isNil or:[typeID == 0]) ifTrue:[
- "typeID == 0 (None): The property does not exist in the specified window"
- ^ nil
- ].
- ^ typeID->val
-
- "
- Display
- getProperty:#'_NET_WM_ICON_GEOMETRY'
- from:nil
- delete:false
- "
-!
-
-propertiesOf:aWindowOrWindowIDOrNil
- "return a collection of all properties' atomIDs of a window.
- Returns the rootWindows props for a nil window argument."
-
- <context: #return>
-
- |windowID atoms|
-
- aWindowOrWindowIDOrNil isView ifTrue:[
- windowID := aWindowOrWindowIDOrNil id.
- ] ifFalse:[
- windowID := aWindowOrWindowIDOrNil.
- ].
-
-%{
- Window window;
- Atom *atomListPtr;
- int i;
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
- int numProps = 0;
-
- if (__isExternalAddress(windowID)) {
- window = __WindowVal(windowID);
- } else if (windowID == nil) {
- window = DefaultRootWindow(dpy);
- } else if (__isInteger(windowID)) {
- window = (Window)__unsignedLongIntVal(windowID);
- } else {
- goto fail;
- }
-
- ENTER_XLIB();
- atomListPtr = XListProperties(dpy, window, &numProps);
- LEAVE_XLIB();
-
- if (atomListPtr == NULL) {
- RETURN (nil);
- }
-
- atoms = __ARRAY_NEW_INT(numProps);
-
- if (atoms == nil) {
- goto fail;
- }
-
- for (i=0; i<numProps; i++) {
- OBJ atm;
-
- atm = __MKATOMOBJ(atomListPtr[i]);
- __ArrayInstPtr(atoms)->a_element[i] = atm; __STORE(atoms, atm);
- }
- XFree(atomListPtr);
- RETURN (atoms);
- }
-fail: ;
-%}.
- ^ self primitiveFailed
-
- "
- Display propertiesOf:nil
- Display propertiesOf:Transcript view id
- "
- "
- (Display propertiesOf:nil) do:[:atm |
- |v prop|
-
- Transcript show:((Display atomName:atm) printStringLeftPaddedTo:5).
- Transcript show:': '.
- prop := Display getProperty:atm from:nil delete:false.
- Transcript showCR:prop value.
- ]
- "
-!
-
-setIcon:anIcon for:aWindowID
- |iconAtom typeAtom buffer iWidth iHeight|
-
- iconAtom := self atomIDOf:#'_NET_WM_ICON' create:false.
- iconAtom isNil ifTrue:[
- "/Hmm, no such property, not running under EWMH compliant WM?
- ^ self
- ].
- typeAtom := self atomIDOf:#'CARDINAL' create:false.
- typeAtom isNil ifTrue:[
- "/Hmm, no such property, not running under EWMH compliant WM?
- ^ self
- ].
- iWidth := anIcon width.
- iHeight := anIcon height.
- buffer := IntegerArray new:(iWidth*iHeight+2).
- buffer at:1 put:iWidth.
- buffer at:2 put:iHeight.
-
- self setProperty:iconAtom type:typeAtom value:buffer for:aWindowID
-
- "
- Display setIcon:0 for:0
- "
-!
-
-setProperty:propertyID type:typeID value:anObject for:aWindowID
- "set a property in the XServer"
-
- <context: #return>
-
- |retval|
-
- retval := false.
-
-%{ /* UNLIMITEDSTACK */
- if (ISCONNECTED && __isAtomID(propertyID) && __isAtomID(typeID)) {
- Display *dpy = myDpy;
- Atom prop, type;
- Window window;
-
- prop = __AtomVal(propertyID);
- type = __AtomVal(typeID);
-
- if (__isExternalAddress(aWindowID)) {
- window = __WindowVal(aWindowID);
- } else if (aWindowID == nil) {
- window = DefaultRootWindow(dpy);
- } else if (__isInteger(aWindowID)) {
- window = (Window)__unsignedLongIntVal(aWindowID);
- } else {
- RETURN(false);
- }
-
- retval = true;
-
- ENTER_XLIB();
- if (__isInteger(anObject)) {
- unsigned INT value = __longIntVal(anObject);
- XChangeProperty(dpy, window, prop, type, 32,
- PropModeReplace,
- (unsigned char *)&value, 1);
- } else if (__isByteArrayLike(anObject)) {
- XChangeProperty(dpy, window, prop, type, 8,
- PropModeReplace,
- __byteArrayVal(anObject),
- __byteArraySize(anObject));
- } else if (__isWords(anObject)) {
- /* wordArray-like (16bit-string) object */
- XChangeProperty(dpy, window, prop, type, 16,
- PropModeReplace,
- __stringVal(anObject),
- __wordArraySize(anObject));
- } else if (__isIntegerArray(anObject)) {
- /* array of atoms */
- XChangeProperty(dpy, window, prop, type, 32,
- PropModeReplace,
- (char *)__integerArrayVal(anObject),
- __integerArraySize(anObject));
- } else if (__isStringLike(anObject)) {
- XChangeProperty(dpy, window, prop, type, 8,
- PropModeReplace,
- __stringVal(anObject),
- __stringSize(anObject));
- } else {
- retval = false;
- }
- LEAVE_XLIB();
-
- DPRINTF(("changeProp win=%"_lx_" prop=%"_lx_" type=%"_lx_"\n", (INT)window, (INT)prop, (INT)type));
- }
-%}.
- ^ retval
-! !
-
-!XWorkstation methodsFor:'queries'!
-
-defaultExtentForTopViews
- "redefined, to define the default extent for the default monitor"
- |extent|
-
- "the standard monitor is the first entry in monitorBounds"
- extent := self monitorBounds first extent.
-
- self isPDA ifTrue:[
- ^ extent - (16 @ 20)
- ].
- ^ extent * 2 // 3
-!
-
-isXineramaActive
-%{ /* NOCONTEXT */
-
-#ifdef XINERAMA
- if (ISCONNECTED) {
- Display *dpy;
- dpy = myDpy;
-
- if (XineramaIsActive(dpy)) {
- RETURN ( true );
- }
- }
-#endif
-%}.
- ^ false
-
- "
- Display isXineramaActive
- "
-!
-
-supportedClipboards
- "answer a collection of symbols with the supported clipboards.
- X11 additionaly supports a buffer containing the currently selected text
- (in xterm) - the PRIMARY selection"
-
- ^ #(clipboard selection)
-!
-
-supportsUTF8WindowLabels
- "answer true, if window labels are to be utf-8 encoded"
-
- ^ false
-!
-
-supportsVariableHeightFonts
- "are fonts with variable height supported?"
-
- ^ false
-! !
-
-!XWorkstation methodsFor:'resources'!
-
-atomIDOf:aStringOrSymbol
- "return an X11 atoms ID.
- This is highly X specific and only for local use (with selections).
- The default is to create the atom, if it does not exist, in order to
- speed up future lookups"
-
- ^ self atomIDOf:aStringOrSymbol create:true
-
- "
- Display atomIDOf:#'FACE_NAME'
- Display atomIDOf:#'FULL_NAME'
- Display atomIDOf:#DndProtocol
- Display atomIDOf:#DndSelection
- "
-
- "Modified: 4.4.1997 / 13:38:48 / cg"
-!
-
-atomIDOf:aStringOrSymbol create:create
- "return an Atoms ID given its name.
- If it already exists, return its ID.
- If not and the create argument is true, it is created.
- Otherwise, nil is returned.
- This is highly X specific and only for local use (with selections)."
-
- |atomSymbol atom|
-
- atomSymbol := aStringOrSymbol asSymbol.
- (atoms notNil and:[(atom := atoms at:atomSymbol ifAbsent:nil) notNil]) ifTrue:[
- ^ atom.
- ].
-
- atom := self primAtomIDOf:atomSymbol create:create.
- atom notNil ifTrue:[
- atoms isNil ifTrue:[
- atoms := IdentityDictionary new.
- ].
- atoms at:atomSymbol put:atom.
- ].
-
- ^ atom
-
- "
- Display atomIDOf:#'VT_SELECTION' create:false
- Display atomIDOf:#CLIPBOARD create:false
- Display atomIDOf:'STRING' create:false
- Display atomIDOf:'PRIMARY' create:false
- Display atomIDOf:'blabla' create:false
- "
-!
-
-atomName:anAtomID
- "given an AtomID, return its name.
- This is highly X specific and only for local use (with selections)."
-
- <context: #return>
-
-%{
- OBJ str;
- char *name;
-
- if (ISCONNECTED && __isAtomID(anAtomID)) {
- ENTER_XLIB();
- name = XGetAtomName(myDpy, __AtomVal(anAtomID));
- LEAVE_XLIB();
- if (name == 0) {
- RETURN (nil);
- }
- str = __MKSTRING(name);
- XFree(name);
- RETURN ( str );
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ nil
-
- "
- Display atomName:1 'PRIMARY'
- Display atomName:130 '_DEC_DEVICE_FONTNAMES'
- Display atomName:132 'FONTNAME_REGISTRY'
- Display atomName:135 'FOUNDRY'
- Display atomName:150 'CHARSET_REGISTRY'
- Display atomName:151 'ISO8859'
- Display atomName:152 'CHARSET_ENCODING'
- Display atomName:154
- "
-!
-
-getResource:name class:cls
- "access the displays resource database for a default value
- of name in a resource class.
- This is highly X specific and currently not used.
-
- Notice:
- we do not plan to use X's resources for ST/X's defaults,
- styles or resources. This would make porting of applications
- to different platforms much more difficult (Windows has no resource
- database). If you stay within ST/X's resource files, these can be
- easily transported to other platforms.
-
- This method is provided for special applications which want to access
- existing X resources and are not planned to be ever ported to other
- platforms."
-
-%{
- char *rslt;
-
- if (ISCONNECTED
- && __isStringLike(name)
- && __isStringLike(cls)) {
-
- rslt = XGetDefault(myDpy, (char *) __stringVal(cls),
- (char *) __stringVal(name));
-
- RETURN (rslt ? __MKSTRING(rslt) : nil );
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ nil.
-
- "if your ~/.Xdefaults contains an entry such as:
- OpenWindows.Beep: notices
- the following returns 'notices'.
-
- Display getResource:'Beep' class:'OpenWindows'
-
- if your ~/.Xdefaults contains an entry such as:
- *.beNiceToColormap: false
- the following return 'false'.
-
- Display getResource:'beNiceToColormap' class:'any'
- Display getResource:'beNiceToColormap' class:''
- "
-!
-
-primAtomIDOf:aStringOrSymbol create:create
- "return an Atoms ID; if create is true, create it if not already present.
- This is highly X specific and only for local use (with selections)."
-
- <context: #return>
-
-%{
- Atom prop;
-
- if (ISCONNECTED
- && __isStringLike(aStringOrSymbol)) {
-
- ENTER_XLIB();
- prop = XInternAtom(myDpy, __stringVal(aStringOrSymbol),
- (create == true) ? False : True);
- LEAVE_XLIB();
- if (prop == None) {
- RETURN (nil);
- }
- RETURN ( __MKATOMOBJ(prop) );
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ nil
-
- "
- Display primAtomIDOf:'VT_SELECTION' create:false
- Display primAtomIDOf:'CUT_BUFFER0' create:false
- Display primAtomIDOf:'STRING' create:false
- Display primAtomIDOf:'PRIMARY' create:false
- "
-! !
-
-!XWorkstation methodsFor:'retrieving pixels'!
-
-getBitsFromId:aDrawableId x:srcx y:srcy width:w height:h into:imageBits
- "get bits from a drawable into the imageBits. The storage for the bits
- must be big enough for the data to fit. If ok, returns an array with some
- info and the bits in imageBits. The info contains the depth, bitOrder and
- number of bytes per scanline. The number of bytes per scanline is not known
- in advance, since the X-server is free to return whatever it thinks is a good padding."
-
- |rawInfo info|
-
- ((w <= 0) or:[h <= 0]) ifTrue:[
- self primitiveFailed.
- ^ nil
- ].
-
- rawInfo := Array new:8.
- "1 -> bit order"
- "2 -> depth"
- "3 -> bytes_per_line"
- "4 -> byte_order"
- "5 -> format"
- "6 -> bitmap_unit"
- "7 -> bitmap_pad"
- "8 -> bits_per_pixel"
-
- "/ had to extract the getPixel call into a separate method, to specify
- "/ unlimitedStack (some implementations use alloca and require huge amounts
- "/ of temporary stack space
-
- (self primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:rawInfo) ifTrue:[
- info := IdentityDictionary new.
- info at:#bitOrder put:(rawInfo at:1).
- info at:#depth put:(rawInfo at:2).
- info at:#bytesPerLine put:(rawInfo at:3).
- info at:#byteOrder put:(rawInfo at:4).
- info at:#format put:(rawInfo at:5).
- info at:#bitmapUnit put:(rawInfo at:6).
- info at:#bitmapPad put:(rawInfo at:7).
- info at:#bitsPerPixel put:(rawInfo at:8).
- ^ info
- ].
- "
- some error occured - either args are not smallintegers, imageBits is not a ByteArray
- or is too small to hold the bits
- "
- self primitiveFailedOrClosedConnection.
- ^ nil
-!
-
-getPixelX:x y:y from:aDrawableId with:dummyGCId
- "return the pixel value at x/y; coordinates start at 0/0 for the upper left.
- Nil is returned for invalid coordinates or if any other problem arises."
-
- <context: #return>
-
-%{ /* UNLIMITEDSTACK */
-
- Window win;
- XImage *img;
- int ret;
- int xpos, ypos;
-
- if (ISCONNECTED
- && __isExternalAddress(aDrawableId) && __bothSmallInteger(x, y)) {
- win = __WindowVal(aDrawableId);
- xpos = __intVal(x);
- ypos = __intVal(y);
- if ((xpos < 0) || (ypos < 0)) {
- RETURN ( __MKSMALLINT(0) );
- }
- ENTER_XLIB();
- img = XGetImage(myDpy, win, xpos, ypos, 1, 1, (unsigned)~0, ZPixmap);
- LEAVE_XLIB();
- if (img != 0) {
- ret = XGetPixel(img, 0, 0);
- XDestroyImage(img);
- RETURN ( __MKSMALLINT(ret) );
- }
- }
-%}.
- ^ nil
-!
-
-primGetBitsFrom:aDrawableId x:srcx y:srcy width:w height:h into:imageBits infoInto:info
- "since XGetImage may allocate huge amount of stack space
- (some implementations use alloca), this must run with unlimited stack."
-
- <context: #return>
-
-%{ /* UNLIMITEDSTACK */
-
- Window win;
- XImage *image = (XImage *)0;
- int pad, bytes_per_line, numBytes;
-
- if (ISCONNECTED
- && __isExternalAddress(aDrawableId)
- && __bothSmallInteger(srcx, srcy)
- && __bothSmallInteger(w, h)
- && __isArray(info)
- && __isByteArray(imageBits)) {
- Display *dpy = myDpy;
-
- win = __WindowVal(aDrawableId);
- ENTER_XLIB();
- image = XGetImage(dpy, win, __intVal(srcx), __intVal(srcy),
- __intVal(w), __intVal(h),
- (unsigned)AllPlanes, ZPixmap);
- LEAVE_XLIB();
-
- if (! image) {
- RETURN ( false );
- }
-
- pad = image->bitmap_pad;
-#ifdef SUPERDEBUG
- console_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 ? */
- console_fprintf(stderr, "possibly unsupported depth:%d in primGetBits\n", image->depth);
- numBytes = image->bytes_per_line * image->height;
- break;
- }
-
-#ifdef SUPERDEBUG
- console_printf("bytes need:%d bytes given:%d\n", numBytes, __byteArraySize(imageBits));
-#endif
-
- if (numBytes > __byteArraySize(imageBits)) {
- /* imageBits too small */
- console_fprintf(stderr, "Workstation [warning]: byteArray too small in primGetBits\n");
- console_fprintf(stderr, " bytes need:%d given:%d\n", numBytes, (int)__byteArraySize(imageBits));
- console_fprintf(stderr, " pad:%d depth:%d imgBytesPerLine:%d\n",
- image->bitmap_pad, image->depth, image->bytes_per_line);
- goto fail;
- }
- if (image->bitmap_bit_order == MSBFirst)
- __ArrayInstPtr(info)->a_element[0] = @symbol(msbFirst);
- else
- __ArrayInstPtr(info)->a_element[0] = @symbol(lsbFirst);
- __ArrayInstPtr(info)->a_element[1] = __MKSMALLINT(image->depth);
- __ArrayInstPtr(info)->a_element[2] = __MKSMALLINT(image->bytes_per_line);
- if (image->byte_order == MSBFirst)
- __ArrayInstPtr(info)->a_element[3] = @symbol(msbFirst);
- else
- __ArrayInstPtr(info)->a_element[3] = @symbol(lsbFirst);
- if (image->format == XYBitmap)
- __ArrayInstPtr(info)->a_element[4] = @symbol(XYBitmap);
- else if (image->format == XYPixmap)
- __ArrayInstPtr(info)->a_element[4] = @symbol(XYPixmap);
- else if (image->format == ZPixmap)
- __ArrayInstPtr(info)->a_element[4] = @symbol(ZPixmap);
-
- __ArrayInstPtr(info)->a_element[5] = __MKSMALLINT(image->bitmap_unit);
- __ArrayInstPtr(info)->a_element[6] = __MKSMALLINT(image->bitmap_pad);
- __ArrayInstPtr(info)->a_element[7] = __MKSMALLINT(image->bits_per_pixel);
- bcopy(image->data, __ByteArrayInstPtr(imageBits)->ba_element, numBytes);
- XDestroyImage(image);
- RETURN ( true );
- }
-fail:
- if (image) {
- XDestroyImage(image);
- }
-%}.
- ^ false
-! !
-
-!XWorkstation methodsFor:'selection fetching'!
-
-getClipboardObjectFor:drawableId
- "get the object selection.
- Returns nil, if no selection is available.
-
- Smalltalk puts ST_OBJECT only into the CLIPBOARD"
-
- |selectionOwnerWindowId selection|
-
- selectionOwnerWindowId := self getSelectionOwnerOf:clipboardAtom.
- selectionOwnerWindowId isNil ifTrue:[
- "no selection. There is the possibilty that one of our (modal)
- views has been closed. Get the selection from the copyBuffer"
- ^ copyBuffer.
- ].
- selectionOwnerWindowId = selectionOwner ifTrue:[
- "I still hold the selection, so return my locally buffered data"
- ^ copyBuffer
- ].
-
- drawableId notNil ifTrue:[
- "sorry, cannot fetch a selection, if there is no drawableId.
- Should I borrow a drawableId from another window?"
-
- selection := SelectionFetcher
- requestSelection:clipboardAtom
- type:(self atomIDOf:#'ST_OBJECT')
- onDevice:self for:drawableId.
-
- "/ should not happen
-false ifTrue:[
- "/ cg: disabled the code below: I don't want any string here (when asking for an object)
- selection isEmptyOrNil ifTrue:[
- selection := SelectionFetcher
- requestSelection:clipboardAtom
- type:(self atomIDOf:#'UTF8_STRING')
- onDevice:self for:drawableId.
-
- selection isNil ifTrue:[
- selection := SelectionFetcher
- requestSelection:clipboardAtom
- type:(self atomIDOf:#STRING)
- onDevice:self for:drawableId.
- ].
- ].
-].
- ].
- selection isEmptyOrNil ifTrue:[ ^ copyBuffer ].
-
- ^ selection.
-
- "
- Display getClipboardObjectFor:Transcript id
- "
-!
-
-getClipboardText:selectionBufferSymbol for:drawableId
- "get the text selection.
- Returns nil, if no selection is available"
-
- |selectionId selectionOwnerWindowId selection|
-
- selectionBufferSymbol == #selection ifTrue:[
- selectionId := primaryAtom.
- ] ifFalse:[
- selectionId := clipboardAtom.
- ].
-
- selectionOwnerWindowId := self getSelectionOwnerOf:selectionId.
- selectionOwnerWindowId isNil ifTrue:[
- "no selection. There is the possibilty that one of our (modal)
- views has been closed. Get the selection from the copyBuffer"
- ^ self copyBufferAsString.
- ].
-
- selectionOwnerWindowId = selectionOwner ifTrue:[
- "I still hold the selection, so return my locally buffered data"
- "JV@2012-04-02: Added support for PRIMARY/SELECTION buffers."
- ^ selectionId == primaryAtom ifTrue:[
- self primaryBufferAsString
- ] ifFalse:[
- self copyBufferAsString.
- ]
- ].
-
- drawableId notNil ifTrue:[
- "sorry, cannot fetch a selection, if there is no drawableId.
- Should I borrow a drawableId from another window?"
-
- selection := SelectionFetcher
- requestSelection:selectionId
- type:(self atomIDOf:#'UTF8_STRING')
- onDevice:self for:drawableId.
-
- selection isNil ifTrue:[
- selection := SelectionFetcher
- requestSelection:selectionId
- type:(self atomIDOf:#STRING)
- onDevice:self for:drawableId.
- ].
- ].
-
- ^ selection
-
- "
- Display getTextSelection:#clipboard for:Transcript id
- Display getTextSelection:#selection for:Transcript id
- "
-
- "Modified: / 02-04-2012 / 10:34:44 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-! !
-
-!XWorkstation methodsFor:'selection sending'!
-
-selectionBuffer:bufferGetSelector as:aTargetAtomID
- "convert the current selection to the format defined by aTargetAtom.
- Answer an association with the type of converted selection (an atomID)
- and the converted selection"
-
- |buffer bufferAsString|
-
- buffer := self perform:bufferGetSelector.
-
- (aTargetAtomID == (self atomIDOf:#'ST_OBJECT')) ifTrue:[
- "/ 'st-object' printCR.
- "send the selection in binaryStore format"
- "require libboss to be loaded"
- (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
- 'XWorkstation: cannot use binary store for copy buffer (libboss missing)' errorPrintCR.
- ^ nil -> nil.
- ].
-
- [
- ^ aTargetAtomID -> (buffer binaryStoreBytes).
- ] on:Error do:[:ex|
- 'XWorkstation: error on binary store of copy buffer: ' infoPrint.
- ex description infoPrintCR.
- ^ nil -> nil.
- ].
- ].
-
- bufferAsString := self class bufferAsString:buffer.
-
- (aTargetAtomID == (self atomIDOf:#STRING)
- or:[aTargetAtomID == (self atomIDOf:#'text/plain')]
- ) ifTrue:[
- "/ 'string' printCR.
- "the other view wants the selection as string"
- ^ aTargetAtomID -> (bufferAsString asSingleByteStringReplaceInvalidWith:$#).
- ].
-
- (aTargetAtomID == (self atomIDOf:#UTF8_STRING)
- or:[aTargetAtomID == (self atomIDOf:#'text/plain;codeset=utf-8')]
- ) ifTrue:[
- "/ 'utf string' printCR.
- "the other view wants the selection as utf8 string"
- ^ aTargetAtomID -> (bufferAsString utf8Encoded).
- ].
-
- aTargetAtomID == (self atomIDOf:#LENGTH) ifTrue:[
- "the other one wants to know the size of our selection.
- LENGTH is deprecated, since we do not know how the selection is
- going to be converted. The client must not rely on the length returned"
-
- ^ (self atomIDOf:#INTEGER) -> (bufferAsString size).
- ].
-
- "we do not support the requestet target type"
- ^ nil -> nil.
-
- "Modified: / 23-08-2006 / 15:56:08 / cg"
-!
-
-setClipboardObject:anObject owner:aWindowId
- "set the object selection, and make aWindowId be the owner.
- This can be used by other Smalltalk(X) applications only.
- We set only the CLIPBOARD selection"
-
- clipboardSelectionTime := lastEventTime.
- self setSelectionOwner:aWindowId of:clipboardAtom time:clipboardSelectionTime
-!
-
-setClipboardText:aString owner:aWindowId
- "set the text selection, and make aWindowId be the owner.
- This can be used by any other X application.
-
- We set both the PRIMARY and CLIPBOARD, so that you can paste
- into xterm."
-
- clipboardSelectionTime := primarySelectionTime := lastEventTime.
-
- self setSelectionOwner:aWindowId of:clipboardAtom time:clipboardSelectionTime.
- self setSelectionOwner:aWindowId of:primaryAtom time:primarySelectionTime.
-
- "Modified: / 17.6.1998 / 19:48:54 / cg"
-!
-
-setPrimaryText:aString owner:aWindowId
- "set the PRIMARY selection, and make aWindowId be the owner.
- This can be used by any other X application when middle-click
- pasting. X Window specific."
-
- primarySelectionTime := lastEventTime.
-
- self setSelectionOwner:aWindowId of:primaryAtom time:primarySelectionTime.
-
- "Created: / 27-03-2012 / 14:16:29 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-supportedTargetAtoms
- "answer an integer array containing the list of supported targets
- i.e. supported clipboard formats"
-
- "Note: some sender code assumes that ST_OBJECT is first"
- ^ #(ST_OBJECT STRING UTF8_STRING TIMESTAMP TARGETS LENGTH
- #'text/plain' #'text/plain;codeset=utf-8'
- ) collect:[:eachTargetSymbol|
- self atomIDOf:eachTargetSymbol
- ] as:IntegerArray.
-! !
-
-!XWorkstation methodsFor:'selections-basic'!
-
-getSelectionOwnerOf:selectionAtomSymbolOrID
- "get the owner of a selection, aDrawableID.
- Answer nil, if there is no owner"
-
- <context:#return>
-
- |selectionAtomID|
-
- selectionAtomSymbolOrID isString ifTrue:[
- selectionAtomID := self atomIDOf:selectionAtomSymbolOrID create:false.
- ] ifFalse:[
- selectionAtomID := selectionAtomSymbolOrID.
- ].
-
-%{
- Window window;
-
- if (__isAtomID(selectionAtomID) && ISCONNECTED) {
- Display *dpy = myDpy;
-
- ENTER_XLIB();
- window = XGetSelectionOwner(dpy, __AtomVal(selectionAtomID));
- LEAVE_XLIB();
- RETURN ((window == None) ? nil : __MKEXTERNALADDRESS(window));
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ nil
-!
-
-requestSelection:selectionID type:typeID for:aWindowId intoProperty:propertyID
- "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)."
-
- <context:#return>
-
- |anIntegerTimestamp|
-
- anIntegerTimestamp := lastEventTime.
-
-%{
-
- if (ISCONNECTED
- && __isAtomID(typeID)
- && __isAtomID(propertyID)
- && __isAtomID(selectionID)) {
- Display *dpy = myDpy;
- Window w;
- Time time;
-
- if (__isExternalAddress(aWindowId)) {
- w = __WindowVal(aWindowId);
- } else if (aWindowId == nil) {
- w = (Window)0;
- } else
- goto err;
-
- if (anIntegerTimestamp == nil) {
- /*
- * the ICCCM convention says: you should set the time to the time when
- * the selection was requested and not to CurrentTime
- */
- time = CurrentTime;
- } else if (__isInteger(anIntegerTimestamp)) {
- time = __unsignedLongIntVal(anIntegerTimestamp);
- } else
- goto err;
-
- ENTER_XLIB();
- XConvertSelection(dpy, __AtomVal(selectionID), __AtomVal(typeID),
- __AtomVal(propertyID), w, time);
- LEAVE_XLIB();
-
- RETURN (true);
-err:;
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-
- "
- Display
- requestSelection:(Display atomIDOf:'PRIMARY')
- property:(Display atomIDOf:'VT_SELECTION')
- type:(Display atomIDOf:'STRING')
- for:Transcript id
- "
- "
- Display
- requestSelection:(Display atomIDOf:'PRIMARY')
- property:(Display atomIDOf:'VT_SELECTION')
- type:(Display atomIDOf:'C_STRING')
- for:Transcript id
- "
-!
-
-sendNotifySelection:selectionID property:propertyID target:targetID time:aTime to:requestorID
- "send a selectionNotify back from a SelectionRequest.
- PropertyID should be the same as requested or nil, if the selection
- could not be converted.
- TargetId should be the same as requested.
- Time should be the time when the selection has been acquired"
-
- <context: #return>
-%{
- if (ISCONNECTED
- && (__isAtomID(propertyID) || propertyID == nil)
- && __isAtomID(targetID) && __isAtomID(selectionID)) {
- Display *dpy = myDpy;
- XEvent ev;
- Window requestor;
- Status result;
-
- if (__isExternalAddress(requestorID)) {
- requestor = __WindowVal(requestorID);
- } else if (__isSmallInteger(requestorID)) {
- requestor = (Window)__smallIntegerVal(requestorID);
- } else if (requestorID == nil) {
- requestor = DefaultRootWindow(dpy);
- } else {
- requestor = (Window)__unsignedLongIntVal(requestorID);
- }
-
- ev.xselection.type = SelectionNotify;
- ev.xselection.display = dpy;
- ev.xselection.selection = __AtomVal(selectionID);
- ev.xselection.target = __AtomVal(targetID);
- ev.xselection.requestor = requestor;
-
- if (__isExternalAddress(aTime)) {
- ev.xselection.time = (INT)(__externalAddressVal(aTime));
- } else if (__isSmallInteger(aTime)) {
- ev.xselection.time = __smallIntegerVal(aTime);
- } else if (aTime == nil) {
- ev.xselection.time = CurrentTime;
- } else {
- ev.xselection.time = (INT)__unsignedLongIntVal(aTime);
- }
-#if 0
- console_printf("ev.xselection.selection: %x\n", ev.xselection.selection);
- console_printf("ev.xselection.target: %x\n", ev.xselection.target);
- console_printf("ev.xselection.requestor: %x\n", ev.xselection.requestor);
- console_printf("ev.xselection.time: %x\n", ev.xselection.time);
- console_printf("requestor: %x\n", requestor);
-#endif
-
- /* send nil property if selection cannot be converted */
- if (propertyID == nil)
- ev.xselection.property = None;
- else
- ev.xselection.property = __AtomVal(propertyID);
-
-
- DPRINTF(("sending SelectionNotify sel=%"_lx_" prop=%"_lx_" target=%"_lx_" requestor=%"_lx_" to %"_lx_"\n",
- (INT)ev.xselection.selection,
- (INT)ev.xselection.property,
- (INT)ev.xselection.target,
- (INT)ev.xselection.requestor,
- (INT)requestor));
-
- ENTER_XLIB();
- result = XSendEvent(dpy, requestor, False, 0 , &ev);
- LEAVE_XLIB();
-
- if ((result == BadValue) || (result == BadWindow)) {
- DPRINTF(("bad status\n"));
- RETURN (false);
- }
- ENTER_XLIB();
- XFlush(dpy);
- LEAVE_XLIB();
- RETURN (true)
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-
- "Modified: / 17.6.1998 / 20:23:20 / cg"
-!
-
-setSelectionOwner:aWindowId of:selectionAtomSymbolOrID time:anIntegerTimestamp
- "set the owner of a selection; return false if failed"
-
- <context: #return>
-
- |selectionAtomID|
-
- "store the current owner of the selection.
- If we still own the selection on paste,
- we can avoid the X11 overhead"
-
- selectionOwner := aWindowId.
-
- selectionAtomSymbolOrID isString ifTrue:[
- selectionAtomID := self atomIDOf:selectionAtomSymbolOrID create:false.
- ] ifFalse:[
- selectionAtomID := selectionAtomSymbolOrID.
- ].
-
-%{
- Window win;
-
- if (__isExternalAddress(aWindowId)
- && __isAtomID(selectionAtomID)
- && ISCONNECTED) {
- Display *dpy = myDpy;
- Time time;
-
- win = __WindowVal(aWindowId);
-
- if (anIntegerTimestamp == nil) {
- /*
- * the ICCCM convention says: you should set the time to the time when
- * the selection was acquired and not to CurrentTime
- */
- time = CurrentTime;
- } else if (__isInteger(anIntegerTimestamp)) {
- time = __unsignedLongIntVal(anIntegerTimestamp);
- } else
- goto err;
-
- DPRINTF(("setOwner prop=%"_lx_" win=%"_lx_"\n", (INT)__AtomVal(selectionAtomID), (INT)win));
- ENTER_XLIB();
- XSetSelectionOwner(dpy, __AtomVal(selectionAtomID), win, time);
- RETURN (self);
- LEAVE_XLIB();
- }
-err:;
-%}.
- self primitiveFailedOrClosedConnection.
-! !
-
-!XWorkstation methodsFor:'window queries'!
-
-allChildIdsOf:aWindowId
- "return all children-ids of the given window.
- Allows for all windows to be enumerated, if we start at the root."
-
- |childIDs allChildIDs|
-
- allChildIDs := OrderedCollection new.
- childIDs := self childIdsOf:aWindowId.
- childIDs notNil ifTrue:[
- allChildIDs addAll:childIDs.
- childIDs do:[:eachChildId |
- allChildIDs addAll:(self allChildIdsOf:eachChildId).
- ].
- ].
- ^ allChildIDs
-
- "
- Display allChildIdsOf:(Display rootWindowId)
- "
-
- "
- |deviceIDAtom uuidAtom|
-
- deviceIDAtom := (Display atomIDOf:#'STX_DEVICE_ID').
- uuidAtom := (Display atomIDOf:#'UUID').
- (Display allChildIdsOf:(Display rootWindowId))
- select:[:id |
- |uuid|
-
- Display
- getProperty:deviceIDAtom
- from:id
- delete:false
- into:[:type :value |
- type == uuidAtom ifTrue:[
- uuid := UUID fromBytes:value.
- ].
- ].
- uuid notNil.
- ]
- "
-!
-
-childIdsOf:aWindowId
- "return all children-ids of the given window. Allows for all windows to be
- enumerated, if we start at the root."
-
- |childIdArray|
-%{
- OBJ id;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- Display *dpy = myDpy;
- Window win = __WindowVal(aWindowId);
- Window rootReturn, parentReturn;
- Window* children = (Window *)0;
- unsigned int numChildren;
- int i;
- int rslt;
-
- ENTER_XLIB();
- rslt = XQueryTree(dpy, win,
- &rootReturn, &parentReturn,
- &children, &numChildren);
- LEAVE_XLIB();
- if (rslt) {
- childIdArray = __ARRAY_NEW_INT(numChildren);
- if (childIdArray != nil) {
- for (i=0; i < numChildren; i++) {
- if (children[i]) {
- OBJ childId;
-
- childId = __MKEXTERNALADDRESS(children[i]);
- __ArrayInstPtr(childIdArray)->a_element[i] = childId;
- __STORE(childIdArray, childId);
- }
- }
- if (children) XFree(children);
- }
- RETURN (childIdArray);
- }
- }
-%}.
- ^ nil.
-
- "
- Display childIdsOf:(Display rootWindowId)
- "
-!
-
-realRootWindowId
- "return the id of the real root window.
- This may not be the window you see as background,
- since some window managers install a virtual root window on top
- of it. Except for very special cases, use #rootWindowId, which takes
- care of any virtual root."
-
-%{
- int screen = __intVal(__INST(screen));
- Window root;
- OBJ id;
-
- if (__INST(rootId) != nil) {
- RETURN (__INST(rootId));
- }
-
- if (ISCONNECTED) {
- root = RootWindow(myDpy, screen);
- if (! root) {
- id = nil;
- } else {
- id = __MKEXTERNALADDRESS(root); __INST(rootId) = id; __STORE(self, id);
- }
- RETURN (id);
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ nil
-
- "
- Display rootWindowId
- Display realRootWindowId
- "
-!
-
-rootWindowId
- "return the id of the root window.
- This is the window you see as background,
- however, it may or may not be the real physical root window,
- since some window managers install a virtual root window on top
- of the real one. If this is the case, that views id is returned here."
-
-%{
- int screen = __intVal(__INST(screen));
- Window rootWin, vRootWin = 0;
- OBJ id;
-
- if (__INST(virtualRootId) != nil) {
- RETURN (__INST(virtualRootId));
- }
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- rootWin = RootWindow(dpy, screen);
-#ifndef IRIS
-
- /*
- * on IRIS, this creates a badwindow error - why ?
- * children contains a funny window (000034)
- */
-
- /*
- * care for virtual root windows (tvtwm & friends)
- */
- {
- Atom vRootAtom, kwinAtom;
- int i;
- Window rootReturn, parentReturn;
- Window* children = (Window *)0;
- unsigned int numChildren;
- int ignoreVRoot = 0;
-
- /*
- * Take care of KDE 2.1.
- * they define _SWM_ROOT but this is not the parent of
- * the application windows.
- * Instead it is used for background painting
- */
-
- kwinAtom = XInternAtom(dpy, "KWIN_RUNNING", True);
- if (kwinAtom != None) {
- Atom actual_type;
- int actual_format;
- unsigned long nitems, bytesafter;
- unsigned char *retVal = 0;
-
- ignoreVRoot = XGetWindowProperty(dpy, rootWin, kwinAtom,
- 0L, 1L, False, kwinAtom,
- &actual_type, &actual_format,
- &nitems, &bytesafter, &retVal) == Success
- && actual_type != 0;
- if (retVal)
- XFree(retVal);
- }
-
- if (!ignoreVRoot) {
- vRootAtom = XInternAtom(dpy, "__SWM_VROOT", True);
- if (vRootAtom != None) {
- if (XQueryTree(dpy, rootWin,
- &rootReturn, &parentReturn,
- &children, &numChildren)) {
- for (i=0; i < numChildren; i++) {
- Atom actual_type;
- int actual_format;
- unsigned long nitems, bytesafter;
- Window* newRoot = (Window*) 0;
-
- if (children[i]) {
- if (XGetWindowProperty(dpy, children[i], vRootAtom,
- 0L, 1L, False, XA_WINDOW,
- &actual_type, &actual_format,
- &nitems, &bytesafter,
- (unsigned char**) &newRoot
- ) == Success && newRoot) {
- vRootWin = *newRoot;
- XFree(newRoot); /* XXX */
- break;
- }
- }
- }
- if (children) XFree(children);
- }
- }
- }
- }
-#endif
- }
-
- if (! vRootWin) {
- vRootWin = rootWin;
- if (! vRootWin) {
- RETURN ( nil );
- }
- }
- id = __MKEXTERNALADDRESS(rootWin); __INST(rootId) = id; __STORE(self, id);
- id = __MKEXTERNALADDRESS(vRootWin); __INST(virtualRootId) = id; __STORE(self, id);
- RETURN ( id );
-%}
-
- "
- Display rootWindowId
- "
-! !
-
-!XWorkstation methodsFor:'window stuff'!
-
-clearRectangleX:x y:y width:width height:height in:aWindowId
- "clear a rectangular area to viewbackground"
-
- <context: #return>
-%{
-
- int w, h;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aWindowId)
- && __bothSmallInteger(x, y)
- && __bothSmallInteger(width, height)) {
- w = __intVal(width);
- h = __intVal(height);
- /*
- * need this check here: some servers simply dump core with bad args
- */
- if ((w >= 0) && (h >= 0)) {
- ENTER_XLIB();
- XClearArea(myDpy, __WindowVal(aWindowId), __intVal(x), __intVal(y), w, h, 0);
- LEAVE_XLIB();
- }
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection.
-!
-
-clearWindow:aWindowId
- "clear a window to viewbackground"
-
- <context: #return>
-%{
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XClearWindow(myDpy, __WindowVal(aWindowId));
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-configureWindow:aWindowId sibling:siblingId stackMode:modeSymbol
- "configure stacking operation of aWindowId w.r.t siblingId"
-
- <context: #return>
-%{
-
- XWindowChanges chg;
- int mask = CWSibling | CWStackMode;
-
- if (ISCONNECTED) {
- if (__isExternalAddress(aWindowId)
- && __isExternalAddress(siblingId)) {
- if (modeSymbol == @symbol(above)) {
- chg.stack_mode = Above;
- } else if (modeSymbol == @symbol(below)) {
- chg.stack_mode = Below;
- } else if (modeSymbol == @symbol(topIf)) {
- chg.stack_mode = TopIf;
- } else if (modeSymbol == @symbol(bottomIf)) {
- chg.stack_mode = BottomIf;
- } else if (modeSymbol == @symbol(opposite)) {
- chg.stack_mode = Opposite;
- } else {
- mask = CWSibling;
- }
-
- chg.sibling = __WindowVal(siblingId);
- ENTER_XLIB();
- XConfigureWindow(myDpy, __WindowVal(aWindowId),
- mask, &chg);
- LEAVE_XLIB();
- RETURN ( self );
- }
- }
-bad: ;
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-getGeometryOf:aWindowId
- "get a windows geometry.
- NOTICE: X-WindowManagers usually do wrap client topViews into their own
- decoration views (top label, resize boundaries etc.).
- Thus, the numbers returned here for topViews are the physical (real) dimensions
- relative to such a wrapper.
- In contrast, the values found in the views instance variables are virtual dimensions
- (i.e. ST/X makes this decoration view transparent to the program."
-
- <context: #return>
-
- |x y width height depth borderWidth info|
-
-%{
- int x_ret, y_ret;
- unsigned int width_ret, height_ret,
- border_width_ret, depth_ret;
- Window root_ret;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XGetGeometry(myDpy, __WindowVal(aWindowId),
- &root_ret,
- &x_ret, &y_ret,
- &width_ret, &height_ret, &border_width_ret,
- &depth_ret);
- LEAVE_XLIB();
-
- x = __MKSMALLINT(x_ret);
- y = __MKSMALLINT(y_ret);
- width = __MKSMALLINT(width_ret);
- height = __MKSMALLINT(height_ret);
- depth = __MKSMALLINT(depth_ret);
- borderWidth = __MKSMALLINT(border_width_ret);
- }
-%}.
- borderWidth isNil ifTrue:[
- self primitiveFailedOrClosedConnection.
- ^ nil
- ].
- info := Dictionary new.
- info at:#origin put:(x @ y).
- info at:#extent put:(width @ height).
- info at:#depth put:depth.
- info at:#borderWidth put:borderWidth.
- ^ info
-
- "
- Transcript topView device
- getGeometryOf:(Transcript id)
- "
- "
- Transcript topView device
- getGeometryOf:(Transcript topView id)
- "
- "
- Display
- getGeometryOf:(Display viewIdFromUser)
- "
- "
- |d|
-
- d := Transcript topView device.
- d getGeometryOf:(d parentWindowIdOf:Transcript topView id)
- "
-!
-
-isValidWindowId:aWindowId
- "return true, if the given window ID is (still) valid.
- Especially useful, if the passed windowID is
- an alien (external) windows id."
-
- |ret|
-
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- char *name = NULL;
- Status ok;
- Window root, parent, *children = NULL;
- unsigned int nChildren;
-
-/* ENTER_XLIB(); */
- ok = XQueryTree(myDpy, __WindowVal(aWindowId),
- &root, &parent, &children, &nChildren);
- if (children) {
- XFree(children);
- }
-/* LEAVE_XLIB(); */
- if (ok) {
- RETURN (true);
- }
- RETURN (false);
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-
- "
- |v aWindowId ok|
-
- v := StandardSystemView new.
- v label:'hello'.
- v openAndWait.
- aWindowId := v id.
- ok := Display isValidWindowId:aWindowId.
- Transcript showCR:'ok is: ' , ok printString.
- Delay waitForSeconds:1.
- v destroy.
- ok := Display isValidWindowId:aWindowId.
- Transcript showCR:'ok is: ' , ok printString.
- "
-!
-
-lowerWindow:aWindowId
- "bring a window to back"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XLowerWindow(myDpy, __WindowVal(aWindowId));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-mapView:aView id:aWindowId iconified:aBoolean atX:xPos y:yPos
- width:w height:h minExtent:minExt maxExtent:maxExt
-
- <context: #return>
-
- "make a window visible - either as icon or as a real view
- in addition, allow change of extend, position, minExtend and maxExtent.
- Needed for restart, to allow recreating a view as iconified,
- and to collaps/expand windows."
-
- |wicon wiconId iconMaskId wiconView wiconViewId wlabel minW minH maxW maxH|
-
- aBoolean ifTrue:[
- wicon := aView icon.
- wicon notNil ifTrue:[
- wiconId := wicon id.
- wicon mask notNil ifTrue:[
- iconMaskId := wicon mask id.
- ].
- ].
- wiconView := aView iconView.
- wiconView notNil ifTrue:[
- wiconViewId := wiconView id
- ].
- wlabel := aView label.
- ].
- minExt notNil ifTrue:[
- minW := minExt x.
- minH := minExt y.
- ].
- maxExt notNil ifTrue:[
- maxW := maxExt x.
- maxH := maxExt y.
- ].
-%{
-
- XWMHints wmhints;
- XSizeHints szhints;
- Window win;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- Display *dpy = myDpy;
-
- win = __WindowVal(aWindowId);
-
- szhints.flags = 0;
- if (__bothSmallInteger(xPos, yPos)) {
- szhints.x = __intVal(xPos);
- szhints.y = __intVal(yPos);
- szhints.flags |= USPosition;
- }
- if (__bothSmallInteger(w, h)) {
- szhints.width = __intVal(w);
- szhints.height = __intVal(h);
- szhints.flags |= USSize;
- }
- if (__bothSmallInteger(minW, minH)) {
- szhints.flags |= PMinSize;
- szhints.min_width = __intVal(minW);
- szhints.min_height = __intVal(minH);
- }
- if (__bothSmallInteger(maxW, maxH)) {
- szhints.flags |= PMaxSize;
- szhints.max_width = __intVal(maxW);
- szhints.max_height = __intVal(maxH);
- }
-
- if (aBoolean == true) {
- char *windowName = "";
- Pixmap iconBitmap = (Pixmap)0;
- Pixmap iconMask = (Pixmap)0;
- Window iconWindow = (Window)0;
-
- if (__isExternalAddress(wiconId))
- iconBitmap = __PixmapVal(wiconId);
-
- if (__isExternalAddress(iconMaskId)) {
- iconMask = __PixmapVal(iconMaskId);
- }
-
- if (__isExternalAddress(wiconViewId))
- iconWindow = __WindowVal(wiconViewId);
-
- if (__isStringLike(wlabel))
- windowName = (char *) __stringVal(wlabel);
-
- if (iconBitmap || windowName) {
- ENTER_XLIB();
- XSetStandardProperties(dpy, win,
- windowName, windowName,
- iconBitmap,
- 0, 0, &szhints);
- LEAVE_XLIB();
- }
-
- wmhints.flags = 0;
- if (iconBitmap) {
- wmhints.flags |= IconPixmapHint;
- wmhints.icon_pixmap = iconBitmap;
- }
- if (iconMask) {
- wmhints.flags |= IconMaskHint;
- wmhints.icon_mask = iconMask;
- }
- if (iconWindow) {
- wmhints.flags |= IconWindowHint;
- wmhints.icon_window = iconWindow;
- }
-
- wmhints.initial_state = IconicState;
- wmhints.flags |= StateHint;
- ENTER_XLIB();
- XSetWMHints(dpy, win, &wmhints);
- LEAVE_XLIB();
- }
-
- if (szhints.flags) {
- ENTER_XLIB();
- XSetNormalHints(dpy, win, &szhints);
- LEAVE_XLIB();
- }
-
- ENTER_XLIB();
- XMapWindow(dpy, win);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-mapWindow:aWindowId
- "make a window visible"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XMapWindow(myDpy, __WindowVal(aWindowId));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-moveResizeWindow:aWindowId x:x y:y width:w height:h
- "move and resize a window"
-
- <context: #return>
-%{
-
- int newWidth, newHeight;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __bothSmallInteger(w, h)
- && __bothSmallInteger(x, y)) {
- newWidth = __intVal(w);
- newHeight = __intVal(h);
- if (newWidth < 1) newWidth = 1;
- if (newHeight < 1) newHeight = 1;
- ENTER_XLIB();
- XMoveResizeWindow(myDpy, __WindowVal(aWindowId),
- __intVal(x), __intVal(y),
- newWidth, newHeight);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-moveWindow:aWindowId x:x y:y
- "move a window"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId) && __bothSmallInteger(x, y)) {
- ENTER_XLIB();
- XMoveWindow(myDpy, __WindowVal(aWindowId), __intVal(x), __intVal(y));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-parentWindowIdOf:aWindowId
- "return a windows parent-window id.
- Useful with getGeometryOf:, to compute information about the decoration."
-
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- Status ok;
- Window root, parent, *children = NULL;
- unsigned int nChildren;
-
-/* ENTER_XLIB(); */
- ok = XQueryTree(myDpy, __WindowVal(aWindowId),
- &root, &parent, &children, &nChildren);
- if (children) {
- XFree(children);
- }
-/* LEAVE_XLIB(); */
- if (! ok) {
- RETURN ( nil );
- }
- RETURN ( __MKEXTERNALADDRESS(parent) );
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false
-
- "
- |id|
-
- id := Transcript device parentWindowIdOf:(Transcript id).
- self assert: ( Transcript container id = id ).
- "
-!
-
-raiseWindow:aWindowId
- "bring a window to front"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XRaiseWindow(myDpy, __WindowVal(aWindowId));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-reparentWindow:windowId to:newParentWindowId
- "change a windows parent (an optional interface)"
-
- <context: #return>
-%{
- if (ISCONNECTED
- && __isExternalAddress(windowId)
- && __isExternalAddress(newParentWindowId)) {
- Display *dpy = myDpy;
- Window _child, _newParent;
- int i;
-
- _child = __WindowVal(windowId);
- _newParent = __WindowVal(newParentWindowId);
- ENTER_XLIB();
-
-#if 0
- XWithdrawWindow (dpy, _child, DefaultScreen(dpy));
- XSync (dpy, 0);
-#endif
- /*
- * Code 'stolen' from xswallow source ...
- * ... mhmh - what is this loop for ?
- */
- for (i=0; i<5; i++) {
- XReparentWindow (dpy, _child, _newParent, 0, 0);
- XSync (dpy, 0);
- }
-#if 0
- XMapWindow (dpy, _child);
- XSync (dpy, 0);
-#endif
- LEAVE_XLIB();
- RETURN ( true );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-resizeWindow:aWindowId width:w height:h
- "resize a window"
-
- <context: #return>
-%{
-
- int newWidth, newHeight;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId) && __bothSmallInteger(w, h)) {
- newWidth = __intVal(w);
- newHeight = __intVal(h);
- if (newWidth < 1) newWidth = 1;
- if (newHeight < 1) newHeight = 1;
- ENTER_XLIB();
- XResizeWindow(myDpy, __WindowVal(aWindowId), newWidth, newHeight);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setBackingStore:how in:aWindowId
- "turn on/off backing-store for a window"
-
- <context: #return>
-%{
-
- XSetWindowAttributes wa;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- if (__INST(ignoreBackingStore) != true) {
- if (how == @symbol(always)) wa.backing_store = Always;
- else if (how == @symbol(whenMapped)) wa.backing_store = WhenMapped;
- else if (how == true) wa.backing_store = Always;
- else wa.backing_store = 0;
-
- ENTER_XLIB();
- XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWBackingStore, &wa);
- LEAVE_XLIB();
-
- }
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setBitGravity:how in:aWindowId
- "set bit gravity for a window"
-
- <context: #return>
-%{
-
- XSetWindowAttributes wa;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- if (how == @symbol(NorthWest)) {
- wa.bit_gravity = NorthWestGravity;
- } else if (how == @symbol(NorthEast)) {
- wa.bit_gravity = NorthEastGravity;
- } else if (how == @symbol(SouthWest)) {
- wa.bit_gravity = SouthWestGravity;
- } else if (how == @symbol(SouthEast)) {
- wa.bit_gravity = SouthEastGravity;
- } else if (how == @symbol(Center)) {
- wa.bit_gravity = CenterGravity;
- } else if (how == @symbol(North)) {
- wa.bit_gravity = NorthGravity;
- } else if (how == @symbol(South)) {
- wa.bit_gravity = SouthGravity;
- } else if (how == @symbol(West)) {
- wa.bit_gravity = WestGravity;
- } else if (how == @symbol(East)) {
- wa.bit_gravity = EastGravity;
- } else {
- wa.bit_gravity = NorthWestGravity;
- }
-
-
- ENTER_XLIB();
- XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWBitGravity, &wa);
- LEAVE_XLIB();
-
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setCursor:aCursorId in:aWindowId
- "define a windows cursor"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isExternalAddress(aCursorId)) {
- Display *dpy = myDpy;
- Window w = __WindowVal(aWindowId);
- Cursor c = __CursorVal(aCursorId);
-
- if (w && c) {
- ENTER_XLIB();
- XDefineCursor(dpy, w, c);
- LEAVE_XLIB();
- }
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setForegroundWindow:aWindowId
- "bring a window to front.
- Send a specific message to the WindowManager"
-
- |activeWindowAtom|
-
-"/ self raiseWindow:aWindowId.
-
- activeWindowAtom := self atomIDOf:#'_NET_ACTIVE_WINDOW' create:false.
- activeWindowAtom notNil ifTrue:[
- self
- sendClientEvent:activeWindowAtom
- format:32
- to:(self rootWindowId)
- propagate:false
- eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
- window:aWindowId
- data1:2 "activate request from pager. This is a trick: kwm ignores requests from applications (1)"
- data2:nil
- data3:nil
- data4:nil
- data5:nil.
- ].
-
- "
- Transcript topView setForegroundWindow
- "
-!
-
-setIconName:aString in:aWindowId
- "define a windows iconname"
-
- <context: #return>
-
- |utf8StringAtom utf8String simpleString|
-
- utf8StringAtom := self atomIDOf:#UTF8_STRING create:true.
-
- utf8String := aString utf8Encoded.
- aString isWideString ifTrue:[
- "/ X does not like 2-byte labels ...
- simpleString := aString asSingleByteStringReplaceInvalidWith:$?
- ] ifFalse:[
- simpleString := aString.
- ].
-
-%{
- XTextProperty titleProperty;
-
- if (ISCONNECTED
- && __isStringLike(utf8String)
- && __isStringLike(simpleString)
- && __isExternalAddress(aWindowId)) {
-
- titleProperty.value = __stringVal(utf8String);
- titleProperty.encoding = __smallIntegerVal(utf8StringAtom);
- titleProperty.format = 8;
- titleProperty.nitems = __stringSize(utf8String);
-
- ENTER_XLIB();
- XSetIconName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(simpleString));
- /* alternative settings for UTF8-Strings */
- XSetWMIconName(myDpy, __WindowVal(aWindowId), &titleProperty);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setSaveUnder:yesOrNo in:aWindowId
- "turn on/off save-under for a window"
-
- <context: #return>
-%{
-
- XSetWindowAttributes wa;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- if (__INST(hasSaveUnder) == true) {
- wa.save_under = (yesOrNo == true) ? 1 : 0;
- ENTER_XLIB();
- XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWSaveUnder, &wa);
- LEAVE_XLIB();
- }
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setTransient:aWindowId for:aMainWindowId
- "set aWindowId to be a transient of aMainWindow"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- Window w;
-
- if ((aMainWindowId == nil) || (aMainWindowId == __MKSMALLINT(0))) {
- w = (Window) 0;
- } else {
- if (__isExternalAddress(aMainWindowId)) {
- w = __WindowVal(aMainWindowId);
- } else {
- goto getOutOfHere;
- }
- }
- ENTER_XLIB();
- XSetTransientForHint(myDpy, __WindowVal(aWindowId), w);
- LEAVE_XLIB();
- RETURN ( self );
- }
- getOutOfHere: ;
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-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."
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isSmallInteger(aColorIndex)) {
- ENTER_XLIB();
- XSetWindowBackground(myDpy, __WindowVal(aWindowId), __intVal(aColorIndex));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-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."
-
- <context: #return>
-%{ /* STACK: 64000 */
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isExternalAddress(aPixmapId)) {
- ENTER_XLIB();
- XSetWindowBackgroundPixmap(myDpy, __WindowVal(aWindowId), __PixmapVal(aPixmapId));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowBorderColor:aColorIndex in:aWindowId
- "set the windows border color"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isSmallInteger(aColorIndex)) {
- ENTER_XLIB();
- XSetWindowBorder(myDpy, __WindowVal(aWindowId), __intVal(aColorIndex));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowBorderPixmap:aPixmapId in:aWindowId
- "set the windows border pattern"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isExternalAddress(aPixmapId)) {
- ENTER_XLIB();
- XSetWindowBorderPixmap(myDpy, __WindowVal(aWindowId), __PixmapVal(aPixmapId));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowBorderShape:aPixmapId in:aWindowId
- "set the windows border shape"
-
- <context: #return>
-
- hasShapeExtension ifFalse:[^ self].
-
-%{
-
-#ifdef SHAPE
- Pixmap shapeBitmap;
-
- if (__isExternalAddress(aPixmapId))
- shapeBitmap = __PixmapVal(aPixmapId);
- else
- shapeBitmap = (Pixmap)0;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XShapeCombineMask(myDpy, __WindowVal(aWindowId), ShapeBounding,
- 0, 0, shapeBitmap, ShapeSet);
- LEAVE_XLIB();
- RETURN ( self );
- }
-#endif
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowBorderWidth:aNumber in:aWindowId
- "set the windows border width"
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)
- && __isSmallInteger(aNumber)) {
- ENTER_XLIB();
- XSetWindowBorderWidth(myDpy, __WindowVal(aWindowId), __intVal(aNumber));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowClass:wClass name:wName in:aWindowId
- "define class and name of a window.
- This may be used by the window manager to
- select client specific resources."
-
- <context: #return>
-%{
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- XClassHint classhint;
-
- classhint.res_class = classhint.res_name = 0;
-
- if (__isStringLike(wClass)) {
- classhint.res_class = (char *) __stringVal(wClass);
- } else if (wClass != nil)
- goto error;
-
- if (__isStringLike(wName)) {
- classhint.res_name = (char *) __stringVal(wName);
- } else if (wName != nil)
- goto error;
-
- ENTER_XLIB();
- XSetClassHint(myDpy, __WindowVal(aWindowId), &classhint);
- LEAVE_XLIB();
- RETURN ( self );
-error:;
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowGravity:how in:aWindowId
- "set window gravity for a window"
-
- <context: #return>
-%{
-
- XSetWindowAttributes wa;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- if (how == @symbol(NorthWest)) {
- wa.win_gravity = NorthWestGravity;
- } else if (how == @symbol(NorthEast)) {
- wa.win_gravity = NorthEastGravity;
- } else if (how == @symbol(SouthWest)) {
- wa.win_gravity = SouthWestGravity;
- } else if (how == @symbol(SouthEast)) {
- wa.win_gravity = SouthEastGravity;
- } else if (how == @symbol(Center)) {
- wa.win_gravity = CenterGravity;
- } else if (how == @symbol(North)) {
- wa.win_gravity = NorthGravity;
- } else if (how == @symbol(South)) {
- wa.win_gravity = SouthGravity;
- } else if (how == @symbol(West)) {
- wa.win_gravity = WestGravity;
- } else if (how == @symbol(East)) {
- wa.win_gravity = EastGravity;
- } else {
- wa.win_gravity = NorthWestGravity;
- }
-
-
- ENTER_XLIB();
- XChangeWindowAttributes(myDpy, __WindowVal(aWindowId), CWWinGravity, &wa);
- LEAVE_XLIB();
-
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowIcon:aForm in:aWindowId
- "define a bitmap to be used as icon"
-
- <context: #return>
-
- |iconId|
-
- aForm notNil ifTrue:[
- iconId := aForm id
- ].
-%{
- if (ISCONNECTED
- && __isExternalAddress(iconId)
- && __isExternalAddress(aWindowId)) {
- XWMHints hints;
-
- hints.icon_pixmap = __PixmapVal(iconId);
- hints.flags = IconPixmapHint;
- ENTER_XLIB();
- XSetWMHints(myDpy, __WindowVal(aWindowId), &hints);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowIcon:aForm mask:aMaskForm in:aWindowId
- "define a windows icon and (optional) iconMask."
-
- <context: #return>
-
- |iconId maskId|
-
- aForm notNil ifTrue:[
- iconId := aForm id
- ].
- aMaskForm notNil ifTrue:[
- maskId := aMaskForm id.
- ].
-%{
- if (ISCONNECTED
- && __isExternalAddress(iconId)
- && __isExternalAddress(aWindowId)) {
- XWMHints hints;
-
- hints.icon_pixmap = __PixmapVal(iconId);
- hints.flags = IconPixmapHint;
- if ((maskId != nil)
- && __isExternalAddress(maskId)) {
- hints.icon_mask = __PixmapVal(maskId);
- hints.flags |= IconMaskHint;
- }
- ENTER_XLIB();
- XSetWMHints(myDpy, __WindowVal(aWindowId), &hints);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-
-!
-
-setWindowIconWindow:aView in:aWindowId
- "define a window to be used as icon"
-
- <context: #return>
-
- |iconWindowId|
-
- aView notNil ifTrue:[
- iconWindowId := aView id
- ].
-%{
- if (ISCONNECTED
- && __isExternalAddress(iconWindowId)
- && __isExternalAddress(aWindowId)) {
- XWMHints wmhints;
-
- wmhints.icon_window = __WindowVal(iconWindowId);
- wmhints.flags = IconWindowHint;
- ENTER_XLIB();
- XSetWMHints(myDpy, __WindowVal(aWindowId), &wmhints);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowMinExtentX:minW y:minH maxExtentX:maxW y:maxH in:aWindowId
- "set a windows minimum & max extents.
- nil arguments are ignored."
-
- <context: #return>
-%{
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- Display *dpy = myDpy;
- XSizeHints szhints;
- Window win;
-
- win = __WindowVal(aWindowId);
-
- szhints.flags = 0;
- if (__bothSmallInteger(minW, minH)) {
- szhints.flags |= PMinSize;
- szhints.min_width = __intVal(minW);
- szhints.min_height = __intVal(minH);
- }
- if (__bothSmallInteger(maxW, maxH)) {
- szhints.flags |= PMaxSize;
- szhints.max_width = __intVal(maxW);
- szhints.max_height = __intVal(maxH);
- }
-
- if (szhints.flags) {
- ENTER_XLIB();
- XSetNormalHints(dpy, win, &szhints);
- LEAVE_XLIB();
- }
- }
-%}.
-!
-
-setWindowName:aString in:aWindowId
- "define a windows name"
-
- <context: #return>
-
- |utf8StringAtom utf8String simpleString|
-
- utf8StringAtom := self atomIDOf:#UTF8_STRING create:true.
-
- utf8String := aString utf8Encoded.
- aString isWideString ifTrue:[
- "/ X does not like 2-byte labels ...
- simpleString := aString asSingleByteStringReplaceInvalidWith:$?
- ] ifFalse:[
- simpleString := aString.
- ].
-
-%{
-
- XTextProperty titleProperty;
-
- if (ISCONNECTED
- && __isStringLike(utf8String)
- && __isStringLike(simpleString)
- && __isExternalAddress(aWindowId)) {
-
- titleProperty.value = __stringVal(utf8String);
- titleProperty.encoding = __smallIntegerVal(utf8StringAtom);
- titleProperty.format = 8;
- titleProperty.nitems = __stringSize(utf8String);
-
- ENTER_XLIB();
- XStoreName(myDpy, __WindowVal(aWindowId), (char *) __stringVal(simpleString));
- /* alternative settings for UTF8-Strings */
- XSetWMName(myDpy, __WindowVal(aWindowId), &titleProperty);
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowPid:anIntegerOrNil in:aWindowId
- "Sets the _NET_WM_PID property for the window.
- This may be used by the window manager to group windows.
- If anIntegerOrNil is nil, then PID of currently running
- Smalltalk is used"
-
- | propertyID typeId pid |
-
- propertyID := self atomIDOf: '_NET_WM_PID' create: false.
- propertyID isNil ifTrue:[ ^ self ].
- pid := anIntegerOrNil isNil ifTrue:[OperatingSystem getProcessId] ifFalse:[anIntegerOrNil].
- typeId := self atomIDOf:#'CARDINAL' create:false.
-
- self setProperty:propertyID type:typeId value:pid for:aWindowId
-
- "Created: / 04-01-2013 / 16:03:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-setWindowShape:aPixmapId in:aWindowId
- "set the windows shape.
- Returns false, if the display does not support the
- X shape extension."
-
- <context: #return>
-
- hasShapeExtension ifFalse:[^ self].
-
-%{
-
-#ifdef SHAPE
- Pixmap shapeBitmap;
-
- if (__isExternalAddress(aPixmapId))
- shapeBitmap = __PixmapVal(aPixmapId);
- else
- shapeBitmap = (Pixmap)0;
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XShapeCombineMask(myDpy, __WindowVal(aWindowId), ShapeClip,
- 0, 0,
- shapeBitmap, ShapeSet);
- LEAVE_XLIB();
- RETURN ( self );
- }
-#endif
-%}.
- self primitiveFailedOrClosedConnection
-!
-
-setWindowState:aSymbol in:aWindowId
- "tell the window type to the window manager.
- Send a specific message to the WindowManager"
-
- |netWmWindowStateAtom stateAtom|
-
- netWmWindowStateAtom := self atomIDOf:#'_NET_WM_WINDOW_STATE' create:false.
- stateAtom := self atomIDOf:aSymbol create:false.
-
- (netWmWindowStateAtom notNil and:[stateAtom notNil]) ifTrue:[
- self
- sendClientEvent:netWmWindowStateAtom
- format:32
- to:(self rootWindowId)
- propagate:true
- eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
- window:aWindowId
- data1:(self atomIDOf:#'_NET_WM_STATE_ADD' create:false)
- data2:stateAtom
- data3:nil
- data4:1
- data5:nil.
- ] ifFalse:[self halt.].
-
- "
- |v|
-
- v := TopView new create.
- Display setWindowState:#'_NET_WM_WINDOW_STATE_STICKY' in:v id.
- v open.
- "
-!
-
-setWindowType:aSymbol in:aWindowId
- "Tell the window type to the window manager.
- See Extended Window Manager Hints 1.3,
- chapter 'Application Window Properties'
- http://standards.freedesktop.org/wm-spec/1.3/
-
- JV@2012-05-15: There was some code prior 2012-05-15,
- but that code does not work anymore and I wonder if it
- ever worked correctly. I changed it to be
- EWMH compatible, as this improve UX on modern Linxu
- machines.
-
- It also helps to fix super-annoying problem with window autoraiser
- on X11 in a proper way - window manager should manage top-level
- window stacking, that's why it is called a 'window manager' :-)
-
- "
-
- | nameAtom typeAtom valueAtom |
-
- self assert:(#(_NET_WM_WINDOW_TYPE_DESKTOP
- _NET_WM_WINDOW_TYPE_DOCK
- _NET_WM_WINDOW_TYPE_TOOLBAR
- _NET_WM_WINDOW_TYPE_MENU
- _NET_WM_WINDOW_TYPE_UTILITY
- _NET_WM_WINDOW_TYPE_SPLASH
- _NET_WM_WINDOW_TYPE_DIALOG
- _NET_WM_WINDOW_TYPE_NORMAL) includes: aSymbol).
-
- nameAtom := self atomIDOf:#'_NET_WM_WINDOW_TYPE' create:false.
- nameAtom isNil ifTrue:[
- "/Hmm, no such property, not running under EWMH compliant WM?
- self breakPoint: #jv.
- ^self
- ].
- "/ Hmm, hmm, no access to XA_ATOM, XA_INTEGER and so on...
- typeAtom := self atomIDOf:#'ATOM' create:false.
- typeAtom isNil ifTrue:[
- self error:'Oops, no ATOM atom'.
- ].
- valueAtom := self atomIDOf: aSymbol create:false.
- valueAtom isNil ifTrue:[
- "/Hmm, no such property, not running under EWMH compliant WM?
- self breakPoint: #jv.
- ^self
- ].
-
- self setProperty: nameAtom type: typeAtom value: valueAtom for: aWindowId.
-
-
-"/ Original code that does not work (if ever worked)
-"/
-"/ |netWmWindowTypeAtom typeAtom|
-"/
-"/ netWmWindowTypeAtom := self atomIDOf:#'_NET_WM_WINDOW_TYPE' create:false.
-"/ typeAtom := self atomIDOf:aSymbol create:false.
-"/
-"/ (netWmWindowTypeAtom notNil and:[typeAtom notNil]) ifTrue:[
-"/ self
-"/ sendClientEvent:netWmWindowTypeAtom
-"/ format:32
-"/ to:(self rootWindowId)
-"/ propagate:true
-"/ eventMask:((self eventMaskFor:#substructureNotify) bitOr:(self eventMaskFor:#substructureRedirect))
-"/ window:aWindowId
-"/ data1:typeAtom
-"/ data2:nil
-"/ data3:nil
-"/ data4:nil
-"/ data5:nil.
-"/ ].
-
- "
- |v|
-
- v := TopView new create.
- Display setWindowType:#'_NET_WM_WINDOW_TYPE_DOCK' in:v id.
- v open.
-
- |v|
-
- v := TopView new create.
- Display setWindowType:#'_NET_WM_WINDOW_TYPE_UTILITY' in:v id.
- v open.
- "
-
- "Modified (comment): / 15-05-2012 / 10:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
-!
-
-unmapWindow:aWindowId
- "make a window invisible"
-
- <context: #return>
-%{
- /*
- * ignore closed connection
- */
- if (! ISCONNECTED) {
- RETURN ( self );
- }
-
- if (__isExternalAddress(aWindowId)) {
- ENTER_XLIB();
- XUnmapWindow(myDpy, __WindowVal(aWindowId));
- LEAVE_XLIB();
- RETURN ( self );
- }
-%}.
- self primitiveFailed
-!
-
-windowIsIconified:aWindowId
- "return true, if some window is iconified.
- The passed windowID may be an alien windows id."
-
- <context: #return>
-%{
-
- if (ISCONNECTED
- && __isExternalAddress(aWindowId)) {
- Atom JunkAtom;
- int JunkInt;
- unsigned long WinState,JunkLong;
- unsigned char *Property;
- Atom WM_STATE_Atom;
-
- if (__INST(wmStateAtom) != nil) {
- WM_STATE_Atom = __AtomVal(__INST(wmStateAtom));
-
- ENTER_XLIB();
- XGetWindowProperty(myDpy, __WindowVal(aWindowId),
- WM_STATE_Atom,
- 0L, 2L, False, AnyPropertyType,
- &JunkAtom,&JunkInt,&WinState,&JunkLong,
- &Property);
- LEAVE_XLIB();
- WinState=(unsigned long)(*((long*)Property));
- if (WinState==3) {
- RETURN (true);
- }
- }
- RETURN (false);
- }
-%}.
- self primitiveFailedOrClosedConnection.
- ^ false "/ or true or what ?
-! !
-
-!XWorkstation::SelectionFetcher class methodsFor:'documentation'!
-
-documentation
-"
- This class is responsible for fetching the clipboard.
- The X11 clipboard is implemented via asynchonous messages.
-
- For each fetch operation an instance of this class is created.
- The asynchronous messages are queued and executed in the
- process that requests the clipboard.
-
- [author:]
- Stefan Vogel (stefan@zwerg)
-
- [instance variables:]
-
- [class variables:]
-
- [see also:]
-
-"
-! !
-
-!XWorkstation::SelectionFetcher class methodsFor:'selections'!
-
-requestSelection:selectionId type:aTargetId onDevice:aDisplay for:aDrawableId
- ^ self new requestSelection:selectionId type:aTargetId onDevice:aDisplay for:aDrawableId
-! !
-
-!XWorkstation::SelectionFetcher methodsFor:'accessing'!
-
-drawableID
- ^ drawableID
-!
-
-getSelection
- "convert the data in buffer to a selection"
-
- |selection|
-
- buffer isNil ifTrue:[
- ^ nil.
- ].
-
- targetID == (display atomIDOf:#STRING) ifTrue:[
- display clipboardEncoding notNil ifTrue:[
- selection := buffer decodeFrom:display clipboardEncoding
- ].
- selection := buffer.
- ] ifFalse:[targetID == (display atomIDOf:#'UTF8_STRING') ifTrue:[
-"/ Transcript show:'UTF8: '; showCR:buffer storeString.
- selection := CharacterArray fromUTF8Bytes:buffer
- ] ifFalse:[targetID == (display atomIDOf:#TEXT) ifTrue:[
-"/ Transcript show:'TEXT: '; showCR:buffer storeString.
- selection := buffer asString
- ] ifFalse:[targetID == (display atomIDOf:#'COMPOUND_TEXT') ifTrue:[
-"/ Transcript show:'COMPOUND_TEXT: '; showCR:buffer storeString.
- selection := buffer asString
- ]]]].
-
- selection notNil ifTrue:[
- (selection endsWith:Character cr) ifTrue:[
- selection := selection asStringCollection copyWith:''
- ].
- ^ selection.
- ].
-
- targetID == (display atomIDOf:#'TARGETS') ifTrue:[
- ^ buffer
- ].
- targetID == (display atomIDOf:#'ST_OBJECT') ifTrue:[
- "require libboss to be loaded"
- (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
- 'SelectionFetch: cannot decode object (libboss library missing)' errorPrintCR.
- ^ nil
- ].
- ^ (Object
- readBinaryFrom:(ReadStream on:buffer)
- onError:[:ex |
- ('SelectionFetch: error while decoding binary object: ',ex description) errorPrintCR.
- nil
- ])
- ].
-
- 'XWorkstation: unimplemented property targetID: ' infoPrint. (display atomName:targetID) infoPrint.
- ' buffer:' infoPrint. buffer infoPrintCR.
- ^ nil
-
- "Modified: / 23-08-2006 / 15:56:04 / cg"
-! !
-
-!XWorkstation::SelectionFetcher methodsFor:'event handling'!
-
-message:aMessage
- "got an asynchronous event from the display.
- Save and wake up waiters"
-
- aMessage selector == #propertyChange:property:state:time: ifTrue:[
- (aMessage arguments at:2) ~~ propertyID ifTrue:[
- "I am only interested in changes of the property used to
- store the selection"
- ^ self.
- ].
- message notNil ifTrue:[
- "this should not happen - bad selection holder?"
- 'XWorkstation(error): message overflow: ' errorPrint. display errorPrintCR.
- ^ self.
- ].
- ].
-
- "we get a propertyChange before the selectionNotify.
- Since the propertyChange will be ignored anyway (because we are not in incremental mod,
- a selectionNotify message may overwrite a propertyChange message"
-
- message := aMessage.
- sema signal.
-!
-
-propertyChange:aView property:aPropertyId state:stateSymbol time:time
- "this is a forwarded propretyChange event from XWorkstation"
-
- |property propertyValue|
-
- incremental ifFalse:[
- "ignore property changes until we are in incremental mode"
- ^ self.
- ].
-
- property := display getProperty:propertyID from:drawableID delete:true.
- propertyValue := property value.
-
- propertyValue size == 0 ifTrue:[
- "property with size 0 signals end of transfer"
- done := true.
- ] ifFalse:[
- buffer isNil ifTrue:[
- targetID := property key.
- buffer := propertyValue.
- ] ifFalse:[
- targetID ~= property key ifTrue:[
- 'XWorkstation(warning): targetID change in incremental select: ' errorPrint. display errorPrintCR.
- ].
- buffer := buffer, propertyValue.
- ].
- ].
-!
-
-selectionClear:aView selection:selectionId time:time
- "sent when another X-client has created a selection.
- This is a very X-specific mechanism."
-!
-
-selectionNotify:aView selection:aSelectionID target:aTargetID property:aPropertyID requestor:requestorID time:time
- "this is a forwarded selectionNotify event from XWorkstation"
-
- |property propertyKey atomName|
-
- aSelectionID ~~ selectionID ifTrue:[
- "ignore notification that is not for our selection"
- ^ self.
- ].
-
- aPropertyID == 0 ifTrue:[
- "the selection owner could not convert the selection to our target type"
- done := true.
- ^ self.
- ].
-
- property := display getProperty:aPropertyID from:drawableID delete:true.
- property isNil ifTrue:[
- "the property does not exist in the specified window"
- done := true.
- ^ self
- ].
-
- propertyKey := property key.
- propertyKey == aTargetID ifTrue:[
- "good, the property is consistent with our request.
- The whole selection is in the property"
- buffer := property value.
- done := true.
- ] ifFalse:[propertyKey == (display atomIDOf:#INCR) ifTrue:[
- "this is an incremental transfer. Wait for property change"
- incremental := true.
- ] ifFalse:[
- atomName := (display atomName:propertyKey) ? propertyKey.
- 'XWorkstation(error): unexpected targetID (' errorPrint.
- atomName errorPrint.
- ') in selectionNotify: ' errorPrint.
- display errorPrintCR.
- done := true.
- ]].
-! !
-
-!XWorkstation::SelectionFetcher methodsFor:'selection actions'!
-
-requestSelection:aSelectionId type:aTargetId onDevice:aDisplay for:aDrawableId
- "request the selection of type targetId.
- Wait for next asynchronous message and process it,
- until done"
-
- display := aDisplay.
- drawableID := aDrawableId.
- selectionID := aSelectionId.
- propertyID := display atomIDOf:#'VT_SELECTION'.
- targetID := aTargetId.
- sema := Semaphore new name:'X11SelectionFetcher'.
- done := false.
- incremental := false.
-
- [
- |timeout|
-
- display registerSelectionFetcher:self.
-
- display
- requestSelection:aSelectionId
- type:aTargetId
- for:drawableID
- intoProperty:propertyID.
-
- timeout := display xlibTimeout.
- [
- |currentMessage|
-
- (sema waitWithTimeout:timeout) isNil ifTrue:[
- "the selection owner didn't respond within reasonable time"
- 'XWorkstation(error): selection owner does not respond:' infoPrint. display infoPrintCR.
- ^ nil.
- ].
- currentMessage := message.
- message := nil.
- currentMessage notNil ifTrue:[currentMessage sendTo:self].
- ] doUntil:[done].
- ] ensure:[
- display unregisterSelectionFetcher:self.
- ].
-
- ^ self getSelection
-! !
-
-!XWorkstation::SelectionFetcher methodsFor:'testing'!
-
-matchesDrawableId:aDrawableId
- "return true, if this SelectionFetcher fetches for aDrawableId"
-
- ^ drawableID = aDrawableId
-! !
-
-!XWorkstation::WindowGroupWindow class methodsFor:'documentation'!
-
-documentation
-"
- A special window to serve as window group id. This window
- is newer mapped.
-
- [author:]
- Jan Vrany <jan.vrany@fit.cvut.cz>
-
- [instance variables:]
-
- [class variables:]
-
- [see also:]
- Inter-Client Communication Conventions Manual [http://tronche.com/gui/x/icccm/]
-
-
-"
+#endif
+%}.
+ ^ super displayString:aString x:x y:y opaque:opaque
! !
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.582 2014-02-04 15:34:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_CVS
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.582 2014-02-04 15:34:49 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.592.2.1 2014-05-08 08:27:50 stefan Exp $'
!
version_SVN