XWorkstation.st
changeset 8613 e075e50db4ac
parent 8564 8f02ab430d57
child 8644 88aa821a64ec
--- a/XWorkstation.st	Thu Jan 17 13:01:26 2019 +0100
+++ b/XWorkstation.st	Thu Jan 17 13:07:21 2019 +0100
@@ -3736,21 +3736,21 @@
 
      xDndAware := self atomIDOf:#XdndAware create:false.
      xDndAware notNil ifTrue:[
-         xDndSelection := self atomIDOf:#XdndSelection create:false.
-         xDndEnter := self atomIDOf:#XdndEnter create:false.
-         xDndLeave := self atomIDOf:#XdndLeave create:false.
-         xDndPosition := self atomIDOf:#XdndPosition create:false.
-         xDndDrop := self atomIDOf:#XdndDrop create:false.
-         xDndFinished := self atomIDOf:#XdndFinished create:false.
-         xDndStatus := self atomIDOf:#XdndStatus create:false.
-         xDndActionCopy := self atomIDOf:#XdndActionCopy create:false.
-         xDndActionMove := self atomIDOf:#XdndActionMove create:false.
-         xDndActionLink := self atomIDOf:#XdndActionLink create:false.
-         xDndActionAsk := self atomIDOf:#XdndActionAsk create:false.
-         xDndActionPrivate := self atomIDOf:#XdndActionPrivate create:false.
-         xDndTypeList := self atomIDOf:#XdndTypeList create:false.
-         xDndTextUriList := self atomIDOf:'test/uri-list' create:false.
-         xDndSelectionAtom := self atomIDOf:'XdndSTXSelection' create:true.   
+	 xDndSelection := self atomIDOf:#XdndSelection create:false.
+	 xDndEnter := self atomIDOf:#XdndEnter create:false.
+	 xDndLeave := self atomIDOf:#XdndLeave create:false.
+	 xDndPosition := self atomIDOf:#XdndPosition create:false.
+	 xDndDrop := self atomIDOf:#XdndDrop create:false.
+	 xDndFinished := self atomIDOf:#XdndFinished create:false.
+	 xDndStatus := self atomIDOf:#XdndStatus create:false.
+	 xDndActionCopy := self atomIDOf:#XdndActionCopy create:false.
+	 xDndActionMove := self atomIDOf:#XdndActionMove create:false.
+	 xDndActionLink := self atomIDOf:#XdndActionLink create:false.
+	 xDndActionAsk := self atomIDOf:#XdndActionAsk create:false.
+	 xDndActionPrivate := self atomIDOf:#XdndActionPrivate create:false.
+	 xDndTypeList := self atomIDOf:#XdndTypeList create:false.
+	 xDndTextUriList := self atomIDOf:'test/uri-list' create:false.
+	 xDndSelectionAtom := self atomIDOf:'XdndSTXSelection' create:true.
     ].
 
     "
@@ -3764,22 +3764,22 @@
     "announce that this window supports the Xdnd (drag & drop) protocol"
 
     |xdndAwareAtom|
-    
+
     xdndAwareAtom := self atomIDOf:#XdndAware create:false.
     xdndAwareAtom isNil ifTrue:[
-        "/ mh - window manager is not DND capable
-        Logger info:'display does not support Xdnd'.
-        ^ self.
+	"/ mh - window manager is not DND capable
+	Logger info:'display does not support Xdnd'.
+	^ self.
     ].
     "/ protocol version 3 is from 1998...
     "/ protocol version 4 from 1999 added root-window drop support...
     "/ protocol version 5 from 2002 added some info to XdndFinished...
-    self 
-        setProperty:xdndAwareAtom 
-        type:#ATOM 
-        value:3 
-        for:aWindowOrWindowID
-    
+    self
+	setProperty:xdndAwareAtom
+	type:#ATOM
+	value:3
+	for:aWindowOrWindowID
+
     "
      Display setXdndAwarePropertyFor:Transcript
      Display getProperty:#'XdndAware' from:Transcript delete:false
@@ -4345,6 +4345,65 @@
     self primitiveFailedOrClosedConnection
 !
 
+displayPointsX:xColl y:yColl in:aDrawableId with:aGCId
+    "draw a collection of points. Each element of xColl/yCollmust be integer,
+     otherwise, an error is triggered."
+
+    <context: #return>
+
+    |n|
+
+    xColl isArray ifFalse:[self error].
+    yColl isArray ifFalse:[self error].
+    (n := xColl size) == yColl size ifFalse:[self error].
+
+    operationsUntilFlush notNil ifTrue:[
+	operationsUntilFlush <= 0 ifTrue:[
+	    self flush.
+	] ifFalse:[
+	    operationsUntilFlush := operationsUntilFlush - 1.
+	].
+    ].
+%{
+
+    GC gc;
+    Window win;
+
+    if (ISCONNECTED
+     && __isExternalAddress(aGCId)
+     && __isExternalAddress(aDrawableId)) {
+	int _n = __intVal(n);
+	int i;
+	gc = __GCVal(aGCId);
+	win = __WindowVal(aDrawableId);
+
+	ENTER_XLIB();
+	for (i=0; i<_n; i++) {
+	    int px, py;
+	    OBJ x = __ArrayInstPtr(xColl)->a_element[i];
+	    OBJ y = __ArrayInstPtr(yColl)->a_element[i];
+
+	    if (!__bothSmallInteger(x,y)) goto fail;
+
+	    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;
+	    XDrawPoint(myDpy, win, gc, px, py);
+	}
+	LEAVE_XLIB();
+	RETURN ( self );
+    }
+    fail: ;
+%}.
+    "badGC, badDrawable or x/y not integer"
+    self primitiveFailedOrClosedConnection
+
+    "Created: / 17-01-2019 / 10:50:32 / Claus Gittinger"
+!
+
 displayPolygon:aPolygon in:aDrawableId with:aGCId
     "draw a polygon, the argument aPolygon is a Collection of individual points, which
      define the polygon.
@@ -5437,26 +5496,26 @@
     |sensor|
 
     targetView isNil ifTrue:[
-        "targetView is gone? Anyway, cannot do anything with this event..."
-        ^ self.
+	"targetView is gone? Anyway, cannot do anything with this event..."
+	^ self.
     ].
 
     "DND drag&drop protocol"
     (typeAtom == (self atomIDOf:#XdndAware)) ifTrue:[
-        self xdndMessage:nil data:data view:targetView.
-        ^ self.
+	self xdndMessage:nil data:data view:targetView.
+	^ self.
     ].
 
     "DND drag&drop protocol"
     (format == 32 and:[typeAtom == (self atomIDOf:#DndProtocol)]) ifTrue:[
-        self dndMessage:nil data:data view:targetView.
-        ^ self.
+	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
+	sensor clientMessage:typeAtom format:format eventData:data view:targetView
     ].
 
     "Created: / 04-04-1997 / 17:49:26 / cg"
@@ -10772,62 +10831,62 @@
     |val propertyAtomID association windowIDOrNil|
 
     propertySymbolOrAtomID isString ifTrue:[
-        propertyAtomID := self atomIDOf:propertySymbolOrAtomID create:false.
-        propertyAtomID isNil ifTrue:[
-            "The propertyAtom does not even exist"
-            ^ nil
-        ].
+	propertyAtomID := self atomIDOf:propertySymbolOrAtomID create:false.
+	propertyAtomID isNil ifTrue:[
+	    "The propertyAtom does not even exist"
+	    ^ nil
+	].
     ] ifFalse:[
-        propertyAtomID := propertySymbolOrAtomID.
+	propertyAtomID := propertySymbolOrAtomID.
     ].
     aWindowOrWindowIDOrNil isView ifTrue:[
-        windowIDOrNil := aWindowOrWindowIDOrNil drawableId.
+	windowIDOrNil := aWindowOrWindowIDOrNil drawableId.
     ] ifFalse:[
-        windowIDOrNil := aWindowOrWindowIDOrNil.
+	windowIDOrNil := aWindowOrWindowIDOrNil.
     ].
 
     association := self primGetProperty:propertyAtomID from:windowIDOrNil delete:doDelete.
     association isNil ifTrue:[
-        "The property does not exist in the specified window"
-        ^ nil
+	"The property does not exist in the specified window"
+	^ nil
     ].
     val := association value.
     (val isByteArray and:[association key = (self atomIDOf:#'UTF8_STRING' create:true)]) ifTrue:[
-        val := val utf8Decoded.
+	val := val utf8Decoded.
     ].
     (val isString and:[val includes:(Character codePoint:0)]) ifTrue:[
-        val := val asCollectionOfSubCollectionsSeparatedBy:(Character codePoint:0).
+	val := val asCollectionOfSubCollectionsSeparatedBy:(Character codePoint:0).
     ].
     association value:val.
     ^ association
 
     "
      Display
-        getProperty:#'_NET_DESKTOP_NAMES'
-        from:nil
-        delete:false
+	getProperty:#'_NET_DESKTOP_NAMES'
+	from:nil
+	delete:false
 
      Display
-        getProperty:#'_NET_CURRENT_DESKTOP'
-        from:nil
-        delete:false
+	getProperty:#'_NET_CURRENT_DESKTOP'
+	from:nil
+	delete:false
 
      Display
-        getProperty:#'_NET_WM_ALLOWED_ACTIONS'
-        from:Transcript
-        delete:false
+	getProperty:#'_NET_WM_ALLOWED_ACTIONS'
+	from:Transcript
+	delete:false
 
      Display
-        getProperty:#'_NET_SUPPORTED'
-        from:nil
-        delete:false
+	getProperty:#'_NET_SUPPORTED'
+	from:nil
+	delete:false
 
      Transcript showCR:(
-         (Display
-            getProperty:#'_NET_SUPPORTED'
-            from:nil
-            delete:false) value
-                    collect:[:eachID | Display atomName:eachID])
+	 (Display
+	    getProperty:#'_NET_SUPPORTED'
+	    from:nil
+	    delete:false) value
+		    collect:[:eachID | Display atomName:eachID])
 
     "
 
@@ -11097,19 +11156,19 @@
 
     self assert:(anIcon depth == 32).
     self assert:(anIcon photometric == #argb).
-    
+
     iWidth  := anIcon width.
     iHeight := anIcon height.
     buffer := IntegerArray new:(iWidth*iHeight+2).
     buffer at:1 put:iWidth.
     buffer at:2 put:iHeight.
     buffer replaceFrom:3 with:anIcon bits startingAt:1.
-    
-    self 
-        setProperty:#'_NET_WM_ICON' 
-        type:#CARDINAL 
-        value:buffer 
-        for:aWindowOrWindowID
+
+    self
+	setProperty:#'_NET_WM_ICON'
+	type:#CARDINAL
+	value:buffer
+	for:aWindowOrWindowID
 
     "
      Display setIcon:0 for:Transcript
@@ -11125,29 +11184,29 @@
     |propertyAtomID typeAtomID windowIDOrNil|
 
     propertySymbolOrAtomID isString ifTrue:[
-        propertyAtomID := self atomIDOf:propertySymbolOrAtomID create:false.
-        propertyAtomID isNil ifTrue:[
-            "/ the property atom does not exist
-            Logger info:'property ATOM does not exist: %1' with:propertySymbolOrAtomID.
-            ^ false
-        ].
+	propertyAtomID := self atomIDOf:propertySymbolOrAtomID create:false.
+	propertyAtomID isNil ifTrue:[
+	    "/ the property atom does not exist
+	    Logger info:'property ATOM does not exist: %1' with:propertySymbolOrAtomID.
+	    ^ false
+	].
     ] ifFalse:[
-        propertyAtomID := propertySymbolOrAtomID.
+	propertyAtomID := propertySymbolOrAtomID.
     ].
     typeSymbolOrAtomID isString ifTrue:[
-        typeAtomID := self atomIDOf:typeSymbolOrAtomID create:false.
-        typeAtomID isNil ifTrue:[
-            "/ the type atom does not exist
-            Logger info:'type ATOM does not exist: %1' with:typeSymbolOrAtomID.
-            ^ false
-        ].
+	typeAtomID := self atomIDOf:typeSymbolOrAtomID create:false.
+	typeAtomID isNil ifTrue:[
+	    "/ the type atom does not exist
+	    Logger info:'type ATOM does not exist: %1' with:typeSymbolOrAtomID.
+	    ^ false
+	].
     ] ifFalse:[
-        typeAtomID := typeSymbolOrAtomID.
+	typeAtomID := typeSymbolOrAtomID.
     ].
     aWindowOrWindowIDOrNil isView ifTrue:[
-        windowIDOrNil := aWindowOrWindowIDOrNil drawableId.
+	windowIDOrNil := aWindowOrWindowIDOrNil drawableId.
     ] ifFalse:[
-        windowIDOrNil := aWindowOrWindowIDOrNil.
+	windowIDOrNil := aWindowOrWindowIDOrNil.
     ].
 
     ^ self primSetProperty:propertyAtomID type:typeAtomID value:anObject for:windowIDOrNil
@@ -11230,15 +11289,15 @@
 
     atomSymbol := aStringOrSymbol asSymbol.
     (atoms notNil and:[(atom := atoms at:atomSymbol ifAbsent:[nil]) notNil]) ifTrue:[
-        ^ atom.
+	^ atom.
     ].
 
     atom := self primAtomIDOf:atomSymbol create:create.
     atom notNil ifTrue:[
-        atoms isNil ifTrue:[
-            atoms := IdentityDictionary new.
-        ].
-        atoms at:atomSymbol put:atom.
+	atoms isNil ifTrue:[
+	    atoms := IdentityDictionary new.
+	].
+	atoms at:atomSymbol put:atom.
     ].
 
     ^ atom
@@ -13399,14 +13458,14 @@
 
     | pid |
 
-    pid := anIntegerOrNil isNil 
-                ifTrue:[OperatingSystem getProcessId] 
-                ifFalse:[anIntegerOrNil].
-    self 
-        setProperty:#'_NET_WM_PID' 
-        type:#CARDINAL 
-        value:pid 
-        for:aWindowId
+    pid := anIntegerOrNil isNil
+		ifTrue:[OperatingSystem getProcessId]
+		ifFalse:[anIntegerOrNil].
+    self
+	setProperty:#'_NET_WM_PID'
+	type:#CARDINAL
+	value:pid
+	for:aWindowId
 
     "Created: / 04-01-2013 / 16:03:30 / Jan Vrany <jan.vrany@fit.cvut.cz>"
     "Modified: / 26-04-2018 / 10:46:24 / stefan"
@@ -13492,26 +13551,26 @@
     | 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).
+		  _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).
 
     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:#'_NET_WM_WINDOW_TYPE' 
-        type:#ATOM 
-        value:valueAtom 
-        for:aWindowOrWindowId.
+	"/ Hmm, no such property, not running under EWMH compliant WM?
+	self breakPoint: #jv.
+	^ self
+    ].
+
+    self
+	setProperty:#'_NET_WM_WINDOW_TYPE'
+	type:#ATOM
+	value:valueAtom
+	for:aWindowOrWindowId.
 
     "
       |v|