--- a/XWorkstation.st Sat Apr 05 01:58:32 1997 +0200
+++ b/XWorkstation.st Sun Apr 06 13:42:57 1997 +0200
@@ -2415,18 +2415,175 @@
!XWorkstation methodsFor:'drag & drop'!
+dndDrop:dropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
+ "drop something in some alien view, using the DND protocol.
+ Returns false, if the drop could not be performed."
+
+ |msgType dropColl anyFile anyDir anyText anyOther
+ dropType dropTypeCode strings sz idx val|
+
+ (msgType := self atomIDOf:'DndProtocol') notNil ifTrue:[
+
+ "/ DND can drop files, file, dir, links, dirLink and text
+ "/ check for this.
+
+ dropObjects isCollection ifFalse:[
+ dropColl := Array with:dropObjects
+ ] ifTrue:[
+ dropColl := dropObjects
+ ].
+ anyFile := anyDir := anyText := anyOther := false.
+ dropColl do:[:aDropObject |
+ aDropObject isFileObject ifTrue:[
+ aDropObject theObject isDirectory ifTrue:[
+ anyDir := true
+ ] ifFalse:[
+ anyFile := true
+ ]
+ ] ifFalse:[
+ aDropObject isTextObject ifTrue:[
+ anyText := true
+ ] ifFalse:[
+ anyOther := true
+ ]
+ ]
+ ].
+
+ anyOther ifTrue:[
+ "/ DND does not support this ...
+ 'XWorkstation [info]: DND can only drop files or text' infoPrintCR.
+ ^ false
+ ].
+ anyText ifTrue:[
+ (anyFile or:[anyDir]) ifTrue:[
+ "/ DND does not support mixed types
+ 'XWorkstation [info]: DND cannot drop both files and text' infoPrintCR.
+ ^ false
+ ]
+ ].
+
+ anyFile ifTrue:[
+ dropType := #DndFiles.
+ dropColl size == 1 ifTrue:[
+ dropType := #DndFile
+ ]
+ ] ifFalse:[
+ anyDir ifTrue:[
+ dropType := #DndFiles.
+ dropColl size == 1 ifTrue:[
+ dropType := #DndDir
+ ]
+ ] ifFalse:[
+ anyText ifTrue:[
+ dropColl size == 1 ifTrue:[
+ dropType := #DndText
+ ] ifFalse:[
+ "/ can only drop a single text object
+ 'XWorkstation [info]: DND can only drop a single text' infoPrintCR.
+ ^ false
+ ]
+ ] ifFalse:[
+ "/ mhmh ...
+ 'XWorkstation [info]: DND cannot drop this' infoPrintCR.
+ ^ false
+ ]
+ ]
+ ].
+
+ dropTypeCode := self dndDropTypes indexOf:dropType.
+ dropTypeCode == 0 ifTrue:[
+ 'XWorkstation [info]: DND cannot drop this' infoPrintCR.
+ ^ false
+ ].
+ dropTypeCode := dropTypeCode - 1.
+
+
+ "/ place the selection inTo the DndSelection property
+ "/ of the rootView ...
+ "/ ... need a single string, with 0-terminated parts.
+
+ strings := OrderedCollection new.
+ sz := 0.
+ dropColl do:[:anObject |
+ |s|
+
+ anObject isFileObject ifTrue:[
+ s := anObject theObject pathName asString
+ ] ifFalse:[
+ s := anObject theObject asString
+ ].
+ strings add:s.
+ sz := sz + (s size) + 1.
+ ].
+ val := String new:sz.
+ idx := 1.
+ strings do:[:aString |
+ val replaceFrom:idx to:(idx + aString size - 1) with:aString startingAt:1.
+ idx := idx + aString size.
+ val at:idx put:(Character value:0).
+ idx := idx + 1
+ ].
+
+ self
+ setProperty:(self atomIDOf:'DndSelection')
+ type:(stringAtom)
+ value:val
+ for:rootId.
+
+ ^ self
+ sendClientEvent:msgType
+ format:32
+ to:destinationId
+ data1:dropTypeCode
+ data2:0
+ data3:(destinationId)
+ data4:nil
+ data5:nil.
+ ].
+
+ ^ false
+
+ "Created: 6.4.1997 / 13:39:37 / cg"
+!
+
+dndDropTypes
+ "return the dropTypes as supported by DND"
+
+ ^ #(
+ DndUnknown "/ 0
+ DndRawData "/ 1
+ DndFile "/ 2
+ DndFiles "/ 3
+ DndText "/ 4
+ DndDir "/ 5
+ DndLink "/ 6
+ DndExe "/ 7
+ )
+
+ "Created: 6.4.1997 / 12:57:56 / cg"
+ "Modified: 6.4.1997 / 13:38:52 / cg"
+!
+
drop:dropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
- "drop something in some alien view"
-
+ "drop something in some alien view.
+ Returns false, if the drop could not be performed."
+
+ "/
"/ see, if the display supports the DND protocol ...
-
+ "/
(self atomIDOf:'DndProtocol') notNil ifTrue:[
- self halt:'not yet implemented'
+ ^ self
+ dndDrop:dropObjects
+ inWindowID:destinationId
+ position:destinationPoint
+ rootPosition:rootPoint
].
- "/ add other protocols here.
-
- "Created: 4.4.1997 / 18:35:21 / cg"
+ "/ add more drag&drop protocols here.
+
+ ^ false
+
+ "Modified: 6.4.1997 / 13:40:37 / cg"
! !
!XWorkstation methodsFor:'drawing'!
@@ -3370,16 +3527,7 @@
dropType := data doubleWordAt:1.
"/ see def's in DragAndDropTypes.h
- dropType := #(
- DndUnknown
- DndRawData
- DndFile
- DndFiles
- DndText
- DndDir
- DndLink
- DndExe
- ) at:dropType+1 ifAbsent:#DndNotDnd.
+ dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
self
getProperty:(self atomIDOf:'DndSelection')
@@ -3444,7 +3592,7 @@
]
"Created: 4.4.1997 / 17:59:37 / cg"
- "Modified: 5.4.1997 / 01:51:21 / cg"
+ "Modified: 6.4.1997 / 12:58:20 / cg"
!
gravityNotifyView:aView
@@ -4594,6 +4742,109 @@
!XWorkstation methodsFor:'event sending'!
+sendClientEvent:msgType format:format to:targetWindowID data1:d1 data2:d2 data3:d3 data4:d4 data5:d5
+ "send a ClientMessage to some other (possibly: non-ST/X) view.
+ The client message gets message_type and format 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 = format;
+ "/ Event.xclient.window = targetWindowID;
+ "/ Event.xclient.data.l[0] = d1
+ "/ Event.xclient.data.l[1] = d2
+ "/ Event.xclient.data.l[2] = d3
+ "/ Event.xclient.data.l[3] = d4
+ "/ Event.xclient.data.l[4] = d5
+ "/
+ "/ XSendEvent(dpy,DispatchWindow,True,NoEventMask,&Event);
+
+%{ /* NOCONTEXT */
+ int type;
+ int state;
+
+ if (ISCONNECTED
+ && __isInteger(msgType)
+ && __isInteger(format)
+ && (__isExternalAddress(targetWindowID) || __isInteger(targetWindowID))) {
+ Display *dpy = myDpy;
+ XEvent ev;
+ Status result;
+
+ if (__isInteger(d1)) {
+ ev.xclient.data.l[0] = __longIntVal(d1);
+ } else {
+ if (__isExternalAddress(d1)) {
+ ev.xclient.data.l[0] = (int)__externalAddressVal(d1);
+ } else {
+ ev.xclient.data.l[0] = 0;
+ }
+ }
+ if (__isInteger(d2)) {
+ ev.xclient.data.l[1] = __longIntVal(d2);
+ } else {
+ if (__isExternalAddress(d2)) {
+ ev.xclient.data.l[1] = (int)__externalAddressVal(d2);
+ } else {
+ ev.xclient.data.l[1] = 0;
+ }
+ }
+ if (__isInteger(d3)) {
+ ev.xclient.data.l[2] = __longIntVal(d3);
+ } else {
+ if (__isExternalAddress(d3)) {
+ ev.xclient.data.l[2] = (int)__externalAddressVal(d3);
+ } else {
+ ev.xclient.data.l[2] = 0;
+ }
+ }
+ if (__isInteger(d4)) {
+ ev.xclient.data.l[3] = __longIntVal(d4);
+ } else {
+ if (__isExternalAddress(d4)) {
+ ev.xclient.data.l[3] = (int)__externalAddressVal(d4);
+ } else {
+ ev.xclient.data.l[3] = 0;
+ }
+ }
+ if (__isInteger(d5)) {
+ ev.xclient.data.l[4] = __longIntVal(d5);
+ } else {
+ if (__isExternalAddress(d5)) {
+ ev.xclient.data.l[4] = (int)__externalAddressVal(d5);
+ } else {
+ ev.xclient.data.l[4] = 0;
+ }
+ }
+
+ if (__isExternalAddress(targetWindowID)) {
+ ev.xclient.window = _WindowVal(targetWindowID);
+ } else {
+ ev.xclient.window = (Window)__longIntVal(targetWindowID);
+ }
+
+ ev.xclient.type = ClientMessage;
+ ev.xclient.display = dpy;
+ ev.xclient.message_type = __longIntVal(msgType);
+ ev.xclient.format = __longIntVal(format);
+
+ result = XSendEvent(dpy, ev.xclient.window, True, NoEventMask , &ev);
+
+ if ((result == BadValue) || (result == BadWindow)) {
+ DPRINTF(("bad status in sendClientEvent\n"));
+ RETURN ( false )
+ }
+ RETURN (true)
+ }
+%}.
+ self primitiveFailed.
+ ^ false
+!
+
sendKeyOrButtonEvent:typeSymbol x:xPos y:yPos keyOrButton:keySymCodeOrButtonNr state:stateMask toViewId:targetId
"send a keyPress/Release or buttonPress/Release event to some (possibly alien) view.
TypeSymbol must be one of: #keyPress, #keyRelease, #buttonPress , #buttonRelease.
@@ -7319,6 +7570,227 @@
^ eventRootX @ eventRootY
! !
+!XWorkstation methodsFor:'properties'!
+
+getObjectProperty:propertyID from:aWindowID
+ "get an object property from the server; return object or nil"
+
+ self getProperty:propertyID from:aWindowID into:[:type :value |
+ type == stringAtom ifTrue:[
+ ^ value
+ ].
+ (value isMemberOf:ByteArray) ifTrue:[
+ ^ (Object readBinaryFrom:(ReadStream on:value) onError:[nil])
+ ]
+ ].
+ ^ nil
+
+ "Modified: 6.4.1997 / 13:27:07 / cg"
+!
+
+getProperty:propertyID from:aWindowID into:aTwoArgBlock
+ "get a property, evaluate aTwoArgBlock with typeID and value"
+
+ |val typeID cls|
+
+ cls := ByteArray.
+%{
+ Window window;
+ Atom property;
+ char *cp, *cp2;
+ Atom actual_type;
+ int actual_format,i;
+ unsigned long nitems, bytes_after, nread;
+ unsigned char *data;
+ int ok = 1;
+# define PROP_SIZE 2048
+
+ if (ISCONNECTED) {
+ Display *dpy = myDpy;
+
+ if (__isAtomID(propertyID)) {
+ property = _AtomVal(propertyID);
+ if (__isExternalAddress(aWindowID)) {
+ window = _WindowVal(aWindowID);
+ } else {
+ window = DefaultRootWindow(dpy);
+ }
+
+ nread = 0;
+ cp = 0;
+/*
+ fprintf(stderr, "getProperty: ");
+ */
+ do {
+ if (XGetWindowProperty(dpy,window,property,nread/4,PROP_SIZE,False,
+ AnyPropertyType,&actual_type,&actual_format,
+ &nitems,&bytes_after,(unsigned char **)&data)
+ != Success) {
+ ok = 0;
+ break;
+ }
+ typeID = __MKATOMOBJ(actual_type);
+ if (! cp) {
+ cp = cp2 = (char *)malloc(nitems+1);
+ } else {
+ cp = (char *)realloc(cp, nread + nitems + 1);
+ cp2 = cp + nread;
+ }
+ if (! cp) {
+ XFree(data);
+ goto fail;
+ }
+
+ nread += nitems;
+ bcopy(data, cp2, nitems);
+ XFree(data);
+ /*
+ fprintf(stderr, "<nitems:%d bytes_after:%d>", nitems, bytes_after);
+ */
+ } while (bytes_after > 0);
+ /*
+ fprintf(stderr, "\n");
+ */
+
+ if (ok) {
+ if (actual_type == XA_STRING) {
+ cp[nread] = '\0';
+ val = __MKSTRING_L(cp, nread);
+ } else {
+ val = __new(nread + OHDR_SIZE);
+ val->o_class = cls;
+ bcopy(cp, __ByteArrayInstPtr(val)->ba_element, nread);
+ }
+ }
+ if (cp)
+ free(cp);
+ }
+ }
+fail: ;
+%}.
+ typeID isNil ifTrue:[
+ ^ false
+ ].
+ aTwoArgBlock value:typeID value:val.
+ ^ true
+!
+
+getTextProperty:propertyID from:aWindowID
+ "get a text property; return string or nil"
+
+ self getProperty:propertyID from:aWindowID into:[:type :value |
+ type == stringAtom ifTrue:[
+ ^ value
+ ]
+ ].
+ ^ nil
+!
+
+setLengthProperty:propertyID value:aNumber for:aWindowID
+ "set a size property"
+
+ ^ self
+ setProperty:propertyID
+ type:(self atomIDOfLENGTH)
+ value:aNumber
+ for:aWindowID
+
+ "Modified: 6.4.1997 / 13:27:26 / cg"
+!
+
+setObjectProperty:propertyID value:anObject for:aWindowID
+ "set a property to a smalltalk object in the XServer.
+ Can only be retrieved by another ST/X smalltalk"
+
+ |s|
+
+ (anObject isMemberOf:String) ifTrue:[
+ ^ self setTextProperty:propertyID value:anObject for:aWindowID
+ ].
+ s := WriteStream on:(ByteArray new:200).
+ anObject storeBinaryOn:s.
+ ^ self
+ setProperty:propertyID
+ type:(self atomIDOf:'ST_OBJECT' create:true)
+ value:(s contents)
+ for:aWindowID
+
+ "Modified: 6.4.1997 / 13:27:57 / cg"
+!
+
+setProperty:propertyID type:typeID value:anObject for:aWindowID
+ "set a property in the XServer"
+
+%{ /* UNLIMITEDSTACK */
+
+ Atom prop, type;
+ Window window;
+ unsigned int value;
+
+ if (__isAtomID(propertyID)
+ && __isAtomID(typeID)
+ && ISCONNECTED
+ && (__isString(anObject)
+ || __isSmallInteger(anObject)
+ || __isSymbol(anObject)
+ || __isByteArray(anObject)
+ || __isWords(anObject))) {
+
+ Display *dpy = myDpy;
+
+ prop = _AtomVal(propertyID);
+ type = _AtomVal(typeID);
+
+ if (__isExternalAddress(aWindowID)) {
+ window = _WindowVal(aWindowID);
+ } else {
+ window = DefaultRootWindow(dpy);
+ }
+ if (__isSmallInteger(anObject)) {
+ value = __intVal(anObject);
+ XChangeProperty(dpy, window, prop, type, 32,
+ PropModeReplace,
+ (unsigned char *)(&value), sizeof(unsigned int));
+ } else {
+ if (__isByteArray(anObject)) {
+ XChangeProperty(dpy, window, prop, type, 8,
+ PropModeReplace,
+ __ByteArrayInstPtr(anObject)->ba_element,
+ __byteArraySize(anObject));
+ } else {
+ /* string or symbol or wordArray-like (16bit-string) object */
+ type = _AtomVal(typeID);
+ if (__isWords(__qClass(anObject))) {
+ XChangeProperty(dpy, window, prop, type, 16,
+ PropModeReplace,
+ __stringVal(anObject),
+ __wordArraySize(anObject));
+ } else {
+ XChangeProperty(dpy, window, prop, type, 8,
+ PropModeReplace,
+ __stringVal(anObject),
+ strlen(__stringVal(anObject)));
+ }
+ }
+ }
+ RETURN (true);
+ }
+%}.
+ ^ false
+!
+
+setTextProperty:propertyID value:aString for:aWindowID
+ "set a property to a stringValue in the XServer"
+
+ ^ self
+ setProperty:propertyID
+ type:(self atomIDOfSTRING)
+ value:aString
+ for:aWindowID
+
+ "Modified: 6.4.1997 / 13:26:32 / cg"
+! !
+
!XWorkstation methodsFor:'resources'!
atomIDOf:aStringOrSymbol
@@ -7665,107 +8137,6 @@
!XWorkstation methodsFor:'selections'!
-getObjectProperty:propertyID from:aWindowID
- "get an object property; return object or nil"
-
- self getProperty:propertyID from:aWindowID into:[:type :value |
- type == stringAtom ifTrue:[
- ^ value
- ].
- (value isMemberOf:ByteArray) ifTrue:[
- ^ (Object readBinaryFrom:(ReadStream on:value) onError:[nil])
- ]
- ].
- ^ nil
-!
-
-getProperty:propertyID from:aWindowID into:aTwoArgBlock
- "get a property, evaluate aTwoArgBlock with typeID and value"
-
- |val typeID cls|
-
- cls := ByteArray.
-%{
- Window window;
- Atom property;
- char *cp, *cp2;
- Atom actual_type;
- int actual_format,i;
- unsigned long nitems, bytes_after, nread;
- unsigned char *data;
- int ok = 1;
-# define PROP_SIZE 2048
-
- if (ISCONNECTED) {
- Display *dpy = myDpy;
-
- if (__isAtomID(propertyID)) {
- property = _AtomVal(propertyID);
- if (__isExternalAddress(aWindowID)) {
- window = _WindowVal(aWindowID);
- } else {
- window = DefaultRootWindow(dpy);
- }
-
- nread = 0;
- cp = 0;
-/*
- fprintf(stderr, "getProperty: ");
- */
- do {
- if (XGetWindowProperty(dpy,window,property,nread/4,PROP_SIZE,False,
- AnyPropertyType,&actual_type,&actual_format,
- &nitems,&bytes_after,(unsigned char **)&data)
- != Success) {
- ok = 0;
- break;
- }
- typeID = __MKATOMOBJ(actual_type);
- if (! cp) {
- cp = cp2 = (char *)malloc(nitems+1);
- } else {
- cp = (char *)realloc(cp, nread + nitems + 1);
- cp2 = cp + nread;
- }
- if (! cp) {
- XFree(data);
- goto fail;
- }
-
- nread += nitems;
- bcopy(data, cp2, nitems);
- XFree(data);
- /*
- fprintf(stderr, "<nitems:%d bytes_after:%d>", nitems, bytes_after);
- */
- } while (bytes_after > 0);
- /*
- fprintf(stderr, "\n");
- */
-
- if (ok) {
- if (actual_type == XA_STRING) {
- cp[nread] = '\0';
- val = __MKSTRING_L(cp, nread);
- } else {
- val = __new(nread + OHDR_SIZE);
- val->o_class = cls;
- bcopy(cp, __ByteArrayInstPtr(val)->ba_element, nread);
- }
- }
- if (cp)
- free(cp);
- }
- }
-fail: ;
-%}.
- typeID isNil ifTrue:[
- ^ false
- ].
- aTwoArgBlock value:typeID value:val.
- ^ true
-!
-
getSelectionFor:drawableId
"get the object selection - either immediate, or asynchronous.
Returns nil, if async request is on its way"
@@ -7800,17 +8171,6 @@
^ nil
!
-getTextProperty:propertyID from:aWindowID
- "get a text property; return string or nil"
-
- self getProperty:propertyID from:aWindowID into:[:type :value |
- type == stringAtom ifTrue:[
- ^ value
- ]
- ].
- ^ nil
-!
-
getTextSelectionFor:drawableId
"get the text selection - either immediate, or asynchronous.
Returns nil, if async request is on its way"
@@ -7964,83 +8324,6 @@
^ false
!
-setLengthProperty:propertyID value:aNumber for:aWindowID
- ^ self setProperty:propertyID type:(self atomIDOfLENGTH) value:aNumber for:aWindowID
-!
-
-setObjectProperty:propertyID value:anObject for:aWindowID
- |s|
-
- (anObject isMemberOf:String) ifTrue:[
- ^ self setTextProperty:propertyID value:anObject for:aWindowID
- ].
- s := WriteStream on:(ByteArray new:200).
- anObject storeBinaryOn:s.
- ^ self
- setProperty:propertyID
- type:(self atomIDOf:'ST_OBJECT' create:true)
- value:(s contents)
- for:aWindowID
-!
-
-setProperty:propertyID type:typeID value:anObject for:aWindowID
-
-%{ /* UNLIMITEDSTACK */
-
- Atom prop, type;
- Window window;
- unsigned int value;
-
- if (__isAtomID(propertyID)
- && __isAtomID(typeID)
- && ISCONNECTED
- && (__isString(anObject)
- || __isSmallInteger(anObject)
- || __isSymbol(anObject)
- || __isByteArray(anObject)
- || __isWords(anObject))) {
-
- Display *dpy = myDpy;
-
- prop = _AtomVal(propertyID);
- type = _AtomVal(typeID);
- if (__isExternalAddress(aWindowID)) {
- window = _WindowVal(aWindowID);
- } else {
- window = DefaultRootWindow(dpy);
- }
- if (__isSmallInteger(anObject)) {
- value = __intVal(anObject);
- XChangeProperty(dpy, window, prop, type, 32,
- PropModeReplace,
- (unsigned char *)(&value), sizeof(unsigned int));
- } else {
- if (__isByteArray(anObject)) {
- XChangeProperty(dpy, window, prop, type, 8,
- PropModeReplace,
- __ByteArrayInstPtr(anObject)->ba_element,
- __byteArraySize(anObject));
- } else {
- /* string or symbol or wordArray-like (16bit-string) object */
- if (__isWords(__qClass(anObject))) {
- XChangeProperty(dpy, window, prop, XA_STRING, 16,
- PropModeReplace,
- __stringVal(anObject),
- __wordArraySize(anObject));
- } else {
- XChangeProperty(dpy, window, prop, XA_STRING, 8,
- PropModeReplace,
- __stringVal(anObject),
- strlen(__stringVal(anObject)));
- }
- }
- }
- RETURN (true);
- }
-%}.
- ^ false
-!
-
setSelection:anObject owner:aWindowId
"set the object selection, and make aWindowId be the owner.
This can be used by other Smalltalk(X) applications only."
@@ -8076,10 +8359,6 @@
^ nil
!
-setTextProperty:propertyID value:aString for:aWindowID
- ^ self setProperty:propertyID type:(self atomIDOfSTRING) value:aString for:aWindowID
-!
-
setTextSelection:aString owner:aWindowId
"set the text selection, and make aWindowId be the owner.
This can be used by any other X application."
@@ -8856,6 +9135,6 @@
!XWorkstation class methodsFor:'documentation'!
version
- ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.229 1997-04-04 23:52:20 cg Exp $'
+ ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.230 1997-04-06 11:42:57 cg Exp $'
! !
XWorkstation initialize!