--- a/XWorkstation.st Tue Oct 30 16:41:16 2018 +0100
+++ b/XWorkstation.st Tue Oct 30 21:34:26 2018 +0100
@@ -3617,6 +3617,90 @@
"Modified: 6.4.1997 / 13:38:52 / cg"
!
+dndMessage:event data:data view:targetView
+ "handle a drag&drop protocol message"
+
+ |sensor property dropType dropValue propertyType|
+
+ dropType := data doubleWordAt:1.
+
+ "/ see def's in DragAndDropTypes.h
+ dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
+
+ property := self
+ getProperty:#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
+ dropValue firstOrNil isString ifFalse:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropValue := dropValue collect:[:nm | nm asFilename].
+ dropType := #files.
+ ] ifFalse:[ (dropType == #DndFile) ifTrue:[
+ dropValue isString ifFalse:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropValue := dropValue asFilename.
+ dropType := #file.
+ ] ifFalse:[ (dropType == #DndDir) ifTrue:[
+ dropValue isString ifFalse:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropValue := dropValue asFilename.
+ dropType := #directory.
+ ] ifFalse:[ (dropType == #DndText) ifTrue:[
+ (dropValue isString or:[dropValue isStringCollection]) ifFalse:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropValue := dropValue asString.
+ dropType := #text.
+ ] ifFalse:[ (dropType == #DndExe) ifTrue:[
+ dropValue isString ifFalse:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropType := #executable.
+ ] ifFalse:[ (dropType == #DndLink) ifTrue:[
+ dropValue isString ifFalse:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropType := #link.
+ ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
+ dropType := #rawData.
+ ] ifFalse:[
+ Logger info:'unsupported dropType: %1 data: %2 ' with:dropType with:dropValue.
+ 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: / 04-04-1997 / 17:59:37 / cg"
+ "Modified (format): / 25-04-2018 / 15:12:04 / stefan"
+!
+
drop:aCollectionOfDropObjects inWindowID:destinationId position:destinationPoint rootPosition:rootPoint
"drop something in some alien view.
Returns false, if the drop could not be performed."
@@ -3639,6 +3723,80 @@
"Modified: 11.4.1997 / 12:44:50 / cg"
! !
+!XWorkstation methodsFor:'drag & drop - xdnd'!
+
+initializeXdnd
+ "Xdnd is an alternative protocol for drag and drop
+ (both modern and standard now)"
+
+ |xDndAware xDndSelection xDndEnter xDndLeave xDndPosition
+ xDndDrop xDndFinished xDndStatus xDndActionCopy xDndActionMove
+ xDndActionLink xDndActionAsk xDndActionPrivate xDndTypeList xDndTextUriList
+ xDndSelectionAtom|
+
+ 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.
+ ].
+
+ "
+ Display initializeXdnd
+ "
+
+ "Created: / 30-10-2018 / 20:56:36 / Claus Gittinger"
+!
+
+setXdndAwarePropertyFor:aWindowOrWindowID
+ "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.
+ ].
+ "/ 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
+
+ "
+ Display setXdndAwarePropertyFor:Transcript
+ Display getProperty:#'XdndAware' from:Transcript delete:false
+ "
+
+ "Created: / 30-10-2018 / 12:59:27 / Claus Gittinger"
+ "Modified (comment): / 30-10-2018 / 21:02:45 / Claus Gittinger"
+!
+
+xdndMessage:event data:data view:targetView
+ "handle a xdnd drag&drop protocol message"
+
+ Logger info:'xdnd: %1 - %2 - %3' with:event with:data with:targetView.
+
+ "Created: / 30-10-2018 / 21:06:49 / Claus Gittinger"
+! !
+
!XWorkstation methodsFor:'drawing'!
clearRectangleX:x y:y width:width height:height in:aDrawableId with:aGCId
@@ -5279,23 +5437,30 @@
|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.
].
"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
- ].
-
- "Created: 4.4.1997 / 17:49:26 / cg"
+ sensor clientMessage:typeAtom format:format eventData:data view:targetView
+ ].
+
+ "Created: / 04-04-1997 / 17:49:26 / cg"
+ "Modified: / 30-10-2018 / 21:05:15 / Claus Gittinger"
!
configure:view relativeTo:anotherViewId x:x y:y width:w height:h borderWidth:borderWidth above:aboveViewId overrideRedirect:overrideBool
@@ -5330,90 +5495,6 @@
"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 propertyType|
-
- dropType := data doubleWordAt:1.
-
- "/ see def's in DragAndDropTypes.h
- dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
-
- property := self
- getProperty:#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
- dropValue firstOrNil isString ifFalse:[
- Logger info:'expected a string propertyValue in drop'.
- ^ self
- ].
- dropValue := dropValue collect:[:nm | nm asFilename].
- dropType := #files.
- ] ifFalse:[ (dropType == #DndFile) ifTrue:[
- dropValue isString ifFalse:[
- Logger info:'expected a string propertyValue in drop'.
- ^ self
- ].
- dropValue := dropValue asFilename.
- dropType := #file.
- ] ifFalse:[ (dropType == #DndDir) ifTrue:[
- dropValue isString ifFalse:[
- Logger info:'expected a string propertyValue in drop'.
- ^ self
- ].
- dropValue := dropValue asFilename.
- dropType := #directory.
- ] ifFalse:[ (dropType == #DndText) ifTrue:[
- (dropValue isString or:[dropValue isStringCollection]) ifFalse:[
- Logger info:'expected a string propertyValue in drop'.
- ^ self
- ].
- dropValue := dropValue asString.
- dropType := #text.
- ] ifFalse:[ (dropType == #DndExe) ifTrue:[
- dropValue isString ifFalse:[
- Logger info:'expected a string propertyValue in drop'.
- ^ self
- ].
- dropType := #executable.
- ] ifFalse:[ (dropType == #DndLink) ifTrue:[
- dropValue isString ifFalse:[
- Logger info:'expected a string propertyValue in drop'.
- ^ self
- ].
- dropType := #link.
- ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
- dropType := #rawData.
- ] ifFalse:[
- Logger info:'unsupported dropType: %1 data: %2 ' with:dropType with:dropValue.
- 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: / 04-04-1997 / 17:59:37 / cg"
- "Modified (format): / 25-04-2018 / 15:12:04 / stefan"
-!
-
expose:view x:x y:y width:w height:h count:count
"forward an expose event for some view"
@@ -10691,64 +10772,68 @@
|val propertyAtomID association windowIDOrNil|
propertySymbolOrAtomID isString ifTrue:[
- propertyAtomID := self atomIDOf:propertySymbolOrAtomID create:false.
- propertyAtomID isNil ifTrue:[^ 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])
"
"Modified: / 31-08-2017 / 22:01:44 / cg"
"Modified: / 26-04-2018 / 10:58:21 / stefan"
+ "Modified (comment): / 30-10-2018 / 20:43:11 / Claus Gittinger"
!
primGetProperty:propertyAtomID from:aWindowIDOrNil delete:doDelete
@@ -11040,26 +11125,35 @@
|propertyAtomID typeAtomID windowIDOrNil|
propertySymbolOrAtomID isString ifTrue:[
- propertyAtomID := self atomIDOf:propertySymbolOrAtomID create:false.
- propertyAtomID isNil ifTrue:[^ 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:[^ 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
"Modified: / 27-04-2018 / 12:20:46 / stefan"
+ "Modified: / 30-10-2018 / 20:44:55 / Claus Gittinger"
! !
!XWorkstation methodsFor:'queries'!
@@ -11107,7 +11201,7 @@
!XWorkstation methodsFor:'resources'!
atomIDOf:aStringOrSymbol
- "return an X11 atoms ID.
+ "return an X11 atom's 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"
@@ -11121,11 +11215,12 @@
Display atomIDOf:#DndSelection
"
- "Modified: 4.4.1997 / 13:38:48 / cg"
+ "Modified: / 04-04-1997 / 13:38:48 / cg"
+ "Modified (comment): / 30-10-2018 / 20:45:47 / Claus Gittinger"
!
atomIDOf:aStringOrSymbol create:create
- "return an Atoms ID given its name.
+ "return an Atom's 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.
@@ -11135,15 +11230,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
@@ -11155,6 +11250,8 @@
Display atomIDOf:'PRIMARY' create:false
Display atomIDOf:'blabla' create:false
"
+
+ "Modified (comment): / 30-10-2018 / 20:45:42 / Claus Gittinger"
!
atomName:anAtomID
@@ -13302,11 +13399,18 @@
| 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"
+ "Modified (format): / 30-10-2018 / 12:58:24 / Claus Gittinger"
!
setWindowShape:aPixmapId in:aWindowId
@@ -13388,22 +13492,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|
@@ -13421,6 +13529,7 @@
"Modified (comment): / 15-05-2012 / 10:49:57 / Jan Vrany <jan.vrany@fit.cvut.cz>"
"Modified (format): / 26-04-2018 / 10:48:59 / stefan"
+ "Modified (format): / 30-10-2018 / 20:57:47 / Claus Gittinger"
!
unmapWindow:aWindowId