--- a/XWorkstation.st Wed Jul 20 17:07:38 2016 +0200
+++ b/XWorkstation.st Wed Jul 20 18:26:01 2016 +0200
@@ -11,7 +11,7 @@
other person. No title to or ownership of the software is
hereby transferred.
"
-'From Smalltalk/X, Version:7.1.0.0 on 19-07-2016 at 15:46:14' !
+'From Smalltalk/X, Version:7.1.0.0 on 20-07-2016 at 15:21:49' !
"{ Package: 'stx:libview' }"
@@ -3402,7 +3402,7 @@
if (shape == @symbol(fourWay)) RETURN ( __MKSMALLINT(XC_fleur) );
if (shape == @symbol(crossCursor)) RETURN ( __MKSMALLINT(XC_X_cursor) );
%}.
-"/ ('XWorkstation [info]: invalid cursorShape:' , shape printString) infoPrintNL.
+"/ Logger info:'invalid cursorShape: %1' with:shape.
^ nil
! !
@@ -3417,128 +3417,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 ...
+ Logger info:'DND can only drop files or text'.
+ ^ false
+ ].
+ anyText ifTrue:[
+ (anyFile or:[anyDir]) ifTrue:[
+ "/ DND does not support mixed types
+ Logger info:'DND cannot drop both files and text'.
+ ^ 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
+ Logger info:'DND can only drop a single text'.
+ ^ false
+ ]
+ ] ifFalse:[
+ "/ mhmh ...
+ Logger info:'DND cannot drop this'.
+ ^ false
+ ]
+ ]
+ ].
+
+ dropTypeCode := self dndDropTypes indexOf:dropType.
+ dropTypeCode == 0 ifTrue:[
+ Logger info:'DND cannot drop this'.
+ ^ 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
@@ -5247,9 +5247,9 @@
dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
property := self
- getProperty:(self atomIDOf:#DndSelection)
- from:rootId
- delete:false.
+ getProperty:(self atomIDOf:#DndSelection)
+ from:rootId
+ delete:false.
propertyType := property key.
dropValue := property value.
@@ -5263,70 +5263,69 @@
"/ 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.
+ "/ actually, a list of fileNames
+ propertyType ~~ stringAtom ifTrue:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ 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.
+ propertyType ~~ stringAtom ifTrue:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ 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.
+ propertyType ~~ stringAtom ifTrue:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ 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.
+ propertyType ~~ stringAtom ifTrue:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropType := #text.
] ifFalse:[ (dropType == #DndExe) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropType := #executable.
+ propertyType ~~ stringAtom ifTrue:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropType := #executable.
] ifFalse:[ (dropType == #DndLink) ifTrue:[
- propertyType ~~ stringAtom ifTrue:[
- 'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
- ^ self
- ].
- dropType := #link.
+ propertyType ~~ stringAtom ifTrue:[
+ Logger info:'expected a string propertyValue in drop'.
+ ^ self
+ ].
+ dropType := #link.
] ifFalse:[ (dropType == #DndRawData) ifTrue:[
- dropType := #rawData.
+ dropType := #rawData.
] ifFalse:[
- 'XWorkstation [info]: unsupported dropType: ' infoPrint. dropType infoPrintCR.
- 'XWorkstation [info]: data: ' infoPrint. dropValue infoPrintCR.
- dropType := #unknown.
+ 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
+ sensor dropMessage:dropType data:dropValue view:targetView position:nil handle:nil
].
"Created: 4.4.1997 / 17:59:37 / cg"
@@ -11593,21 +11592,20 @@
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.
- ].
+ "/ 'st-object' printCR.
+ "send the selection in binaryStore format"
+ "require libboss to be loaded"
+ (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
+ Logger error:'cannot use binary store for copy buffer (libboss missing)'.
+ ^ nil -> nil.
+ ].
+
+ [
+ ^ aTargetAtomID -> (buffer binaryStoreBytes).
+ ] on:Error do:[:ex|
+ Logger info:'error on binary store of copy buffer: %1' with: ex description.
+ ^ nil -> nil.
+ ].
].
bufferAsString := self class bufferAsString:buffer.
@@ -11615,25 +11613,25 @@
(aTargetAtomID == (self atomIDOf:#STRING)
or:[aTargetAtomID == (self atomIDOf:#'text/plain')]
) ifTrue:[
- "/ 'string' printCR.
- "the other view wants the selection as string"
- ^ aTargetAtomID -> (bufferAsString asSingleByteStringReplaceInvalidWith:$#).
+ "/ '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).
+ "/ '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).
+ "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"
@@ -14114,7 +14112,7 @@
self isPixmap ifTrue:[
pixmapDepth := depth.
].
- fontId := font getFontId.
+ fontId := font getXftFontId.
%{ /* STACK: 64000 */
#ifdef XFT