diff -r 6280ab9b914d -r cdc53ab8ceff XWorkstation.st --- 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, 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, 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!