hg/stx-libview: comparison XWorkstation.st

equal deleted inserted replaced

-:4d3a7e94ff48
+:e2d05b756727
 inclusion of the above copyright notice.   This software may not
 be provided or otherwise made available to, or used by, any
 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' }"
 "{ NameSpace: Smalltalk }"
 if (shape == @symbol(bottomLeft)) RETURN (  __MKSMALLINT(XC_ll_angle) );
 if (shape == @symbol(square)) RETURN (  __MKSMALLINT(XC_dotbox) );
 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
 ! !
 !XWorkstation methodsFor:'drag & drop'!
 |msgType dropColl dropCollSize 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
+"/ DND can drop files, file, dir, links, dirLink and text
-	"/ check for this.
+"/ check for this.
-	dropObjects isCollection ifFalse:[
+dropObjects isCollection ifFalse:[
-	    dropColl := Array with:dropObjects
+dropColl := Array with:dropObjects
-	] ifTrue:[
+] ifTrue:[
-	    dropColl := dropObjects
+dropColl := dropObjects
-	].
+].
-	anyFile := anyDir := anyText := anyOther := false.
+anyFile := anyDir := anyText := anyOther := false.
-	dropColl do:[:aDropObject |
+dropColl do:[:aDropObject |
-	    aDropObject isFileObject ifTrue:[
+aDropObject isFileObject ifTrue:[
-		aDropObject theObject isDirectory ifTrue:[
+aDropObject theObject isDirectory ifTrue:[
-		    anyDir := true
+anyDir := true
-		] ifFalse:[
+] ifFalse:[
-		    anyFile := true
+anyFile := true
-		]
+]
-	    ] ifFalse:[
+] ifFalse:[
-		aDropObject isTextObject ifTrue:[
+aDropObject isTextObject ifTrue:[
-		    anyText := true
+anyText := true
-		] ifFalse:[
+] ifFalse:[
-		    anyOther := true
+anyOther := true
-		]
+]
-	    ]
+]
-	].
+].
-	anyOther ifTrue:[
+anyOther ifTrue:[
-	    "/ DND does not support this ...
+"/ DND does not support this ...
-	    'XWorkstation [info]: DND can only drop files or text' infoPrintCR.
+Logger info:'DND can only drop files or text'.
-	    ^ false
+^ false
-	].
+].
-	anyText ifTrue:[
+anyText ifTrue:[
-	    (anyFile or:[anyDir]) ifTrue:[
+(anyFile or:[anyDir]) ifTrue:[
-		"/ DND does not support mixed types
+"/ DND does not support mixed types
-		'XWorkstation [info]: DND cannot drop both files and text' infoPrintCR.
+Logger info:'DND cannot drop both files and text'.
-		^ false
+^ false
-	    ]
+]
-	].
+].
-	dropCollSize := dropColl size.
+dropCollSize := dropColl size.
-	anyFile ifTrue:[
+anyFile ifTrue:[
-	    dropType := #DndFiles.
+dropType := #DndFiles.
-	    dropCollSize == 1 ifTrue:[
+dropCollSize == 1 ifTrue:[
-		dropType := #DndFile
+dropType := #DndFile
-	    ]
+]
-	] ifFalse:[
+] ifFalse:[
-	    anyDir ifTrue:[
+anyDir ifTrue:[
-		dropType := #DndFiles.
+dropType := #DndFiles.
-		dropCollSize == 1 ifTrue:[
+dropCollSize == 1 ifTrue:[
-		    dropType := #DndDir
+dropType := #DndDir
-		]
+]
-	    ] ifFalse:[
+] ifFalse:[
-		anyText ifTrue:[
+anyText ifTrue:[
-		    dropCollSize == 1 ifTrue:[
+dropCollSize == 1 ifTrue:[
-			dropType := #DndText
+dropType := #DndText
-		    ] ifFalse:[
+] ifFalse:[
-			"/ can only drop a single text object
+"/ can only drop a single text object
-			'XWorkstation [info]: DND can only drop a single text' infoPrintCR.
+Logger info:'DND can only drop a single text'.
-			^ false
+^ false
-		    ]
+]
-		] ifFalse:[
+] ifFalse:[
-		    "/ mhmh ...
+"/ mhmh ...
-		    'XWorkstation [info]: DND cannot drop this' infoPrintCR.
+Logger info:'DND cannot drop this'.
-		    ^ false
+^ false
-		]
+]
-	    ]
+]
-	].
+].
-	dropTypeCode := self dndDropTypes indexOf:dropType.
+dropTypeCode := self dndDropTypes indexOf:dropType.
-	dropTypeCode == 0 ifTrue:[
+dropTypeCode == 0 ifTrue:[
-	    'XWorkstation [info]: DND cannot drop this' infoPrintCR.
+Logger info:'DND cannot drop this'.
-	    ^ false
+^ false
-	].
+].
-	dropTypeCode := dropTypeCode - 1.
+dropTypeCode := dropTypeCode - 1.
-	"/ place the selection inTo the DndSelection property
+"/ place the selection inTo the DndSelection property
-	"/ of the rootView ...
+"/ of the rootView ...
-	"/ ... need a single string, with 0-terminated parts.
+"/ ... need a single string, with 0-terminated parts.
-	strings := OrderedCollection new.
+strings := OrderedCollection new.
-	sz := 0.
+sz := 0.
-	dropColl do:[:anObject |
+dropColl do:[:anObject |
-	    |s o|
+|s o|
-	    o := anObject theObject.
+o := anObject theObject.
-	    anObject isFileObject ifTrue:[
+anObject isFileObject ifTrue:[
-		o := o pathName
+o := o pathName
-	    ].
+].
-	    s := o asString.
+s := o asString.
-	    strings add:s.
+strings add:s.
-	    sz := sz + (s size) + 1.
+sz := sz + (s size) + 1.
-	].
+].
-	val := String new:sz.
+val := String new:sz.
-	idx := 1.
+idx := 1.
-	strings do:[:aString |
+strings do:[:aString |
-	    |sz|
+|sz|
-	    sz := aString size.
+sz := aString size.
-	    val replaceFrom:idx to:(idx + sz - 1) with:aString startingAt:1.
+val replaceFrom:idx to:(idx + sz - 1) with:aString startingAt:1.
-	    idx := idx + sz.
+idx := idx + sz.
-	    val at:idx put:(Character value:0).
+val at:idx put:(Character value:0).
-	    idx := idx + 1
+idx := idx + 1
-	].
+].
-	self
+self
-	    setProperty:(self atomIDOf:#DndSelection)
+setProperty:(self atomIDOf:#DndSelection)
-	    type:(self atomIDOf:#STRING)
+type:(self atomIDOf:#STRING)
-	    value:val
+value:val
-	    for:rootId.
+for:rootId.
-	^ self
+^ self
-	    sendClientEvent:msgType
+sendClientEvent:msgType
-	    format:32
+format:32
-	    to:destinationId
+to:destinationId
-	    propagate:true
+propagate:true
-	    eventMask:nil
+eventMask:nil
-	    window:destinationId
+window:destinationId
-	    data1:dropTypeCode
+data1:dropTypeCode
-	    data2:0
+data2:0
-	    data3:destinationId
+data3:destinationId
-	    data4:nil
+data4:nil
-	    data5:nil.
+data5:nil.
 ].
 ^ false
 "Created: 6.4.1997 / 13:39:37 / cg"
 "/ see def's in DragAndDropTypes.h
 dropType := (self dndDropTypes) at:dropType+1 ifAbsent:#DndNotDnd.
 property := self
-	getProperty:(self atomIDOf:#DndSelection)
+getProperty:(self atomIDOf:#DndSelection)
-	from:rootId
+from:rootId
-	delete:false.
+delete:false.
 propertyType := property key.
 dropValue := property value.
 "/ preconvert into a collection
 "/ 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
+"/ actually, a list of fileNames
-	propertyType ~~ stringAtom ifTrue:[
+propertyType ~~ stringAtom ifTrue:[
-	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+Logger info:'expected a string propertyValue in drop'.
-	    ^ self
+^ self
-	].
+].
-	names := OrderedCollection new.
+names := OrderedCollection new.
-	i1 := 1.
+i1 := 1.
-	[i1 ~~ 0] whileTrue:[
+[i1 ~~ 0] whileTrue:[
-	    i2 := dropValue indexOf:(Character value:0) startingAt:i1.
+i2 := dropValue indexOf:(Character value:0) startingAt:i1.
-	    i2 ~~ 0 ifTrue:[
+i2 ~~ 0 ifTrue:[
-		names add:(dropValue copyFrom:i1 to:(i2-1)).
+names add:(dropValue copyFrom:i1 to:(i2-1)).
-		i1 := i2 + 1.
+i1 := i2 + 1.
-	    ] ifFalse:[
+] ifFalse:[
-		i1 := i2
+i1 := i2
-	    ].
+].
-	].
+].
-	dropValue := names.
+dropValue := names.
-	dropValue := dropValue collect:[:nm | nm asFilename].
+dropValue := dropValue collect:[:nm | nm asFilename].
-	dropType := #files.
+dropType := #files.
 ] ifFalse:[ (dropType == #DndFile) ifTrue:[
-	propertyType ~~ stringAtom ifTrue:[
+propertyType ~~ stringAtom ifTrue:[
-	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+Logger info:'expected a string propertyValue in drop'.
-	    ^ self
+^ self
-	].
+].
-	dropValue := dropValue asFilename.
+dropValue := dropValue asFilename.
-	dropType := #file.
+dropType := #file.
 ] ifFalse:[ (dropType == #DndDir) ifTrue:[
-	propertyType ~~ stringAtom ifTrue:[
+propertyType ~~ stringAtom ifTrue:[
-	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+Logger info:'expected a string propertyValue in drop'.
-	    ^ self
+^ self
-	].
+].
-	dropValue := dropValue asFilename.
+dropValue := dropValue asFilename.
-	dropType := #directory.
+dropType := #directory.
 ] ifFalse:[ (dropType == #DndText) ifTrue:[
-	propertyType ~~ stringAtom ifTrue:[
+propertyType ~~ stringAtom ifTrue:[
-	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+Logger info:'expected a string propertyValue in drop'.
-	    ^ self
+^ self
-	].
+].
-	dropType := #text.
+dropType := #text.
 ] ifFalse:[ (dropType == #DndExe) ifTrue:[
-	propertyType ~~ stringAtom ifTrue:[
+propertyType ~~ stringAtom ifTrue:[
-	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+Logger info:'expected a string propertyValue in drop'.
-	    ^ self
+^ self
-	].
+].
-	dropType := #executable.
+dropType := #executable.
 ] ifFalse:[ (dropType == #DndLink) ifTrue:[
-	propertyType ~~ stringAtom ifTrue:[
+propertyType ~~ stringAtom ifTrue:[
-	    'XWorkstation [info]: expected a string propertyValue in drop' infoPrintCR.
+Logger info:'expected a string propertyValue in drop'.
-	    ^ self
+^ self
-	].
+].
-	dropType := #link.
+dropType := #link.
 ] ifFalse:[ (dropType == #DndRawData) ifTrue:[
-	dropType := #rawData.
+dropType := #rawData.
 ] ifFalse:[
-	'XWorkstation [info]: unsupported dropType: ' infoPrint. dropType infoPrintCR.
+Logger info:'unsupported dropType: %1 data: %2 ' with:dropType with:dropValue.
-	'XWorkstation [info]: data: ' infoPrint. dropValue infoPrintCR.
+dropType := #unknown.
-	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"
 !
 |buffer bufferAsString|
 buffer := self perform:bufferGetSelector.
 (aTargetAtomID == (self atomIDOf:#'ST_OBJECT')) ifTrue:[
-	"/ 'st-object' printCR.
+"/ 'st-object' printCR.
-	"send the selection in binaryStore format"
+"send the selection in binaryStore format"
-	"require libboss to be loaded"
+"require libboss to be loaded"
-	(Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
+(Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[
-	    'XWorkstation: cannot use binary store for copy buffer (libboss missing)' errorPrintCR.
+Logger error:'cannot use binary store for copy buffer (libboss missing)'.
-	    ^ nil -> nil.
+^ nil -> nil.
-	].
+].
-	[
+[
-	    ^ aTargetAtomID -> (buffer binaryStoreBytes).
+^ aTargetAtomID -> (buffer binaryStoreBytes).
-	] on:Error do:[:ex|
+] on:Error do:[:ex|
-	    'XWorkstation: error on binary store of copy buffer: ' infoPrint.
+Logger info:'error on binary store of copy buffer: %1' with: ex description.
-	    ex description infoPrintCR.
+^ nil -> nil.
-	    ^ nil -> nil.
+].
-	].
 ].
 bufferAsString := self class bufferAsString:buffer.
 (aTargetAtomID == (self atomIDOf:#STRING)
 or:[aTargetAtomID == (self atomIDOf:#'text/plain')]
 ) ifTrue:[
-	"/ 'string' printCR.
+"/ 'string' printCR.
-	"the other view wants the selection as string"
+"the other view wants the selection as string"
-	^ aTargetAtomID -> (bufferAsString asSingleByteStringReplaceInvalidWith:$#).
+^ aTargetAtomID -> (bufferAsString asSingleByteStringReplaceInvalidWith:$#).
 ].
 (aTargetAtomID == (self atomIDOf:#UTF8_STRING)
 or:[aTargetAtomID == (self atomIDOf:#'text/plain;codeset=utf-8')]
 ) ifTrue:[
-	"/ 'utf string' printCR.
+"/ 'utf string' printCR.
-	"the other view wants the selection as utf8 string"
+"the other view wants the selection as utf8 string"
-	^ aTargetAtomID -> (bufferAsString utf8Encoded).
+^ aTargetAtomID -> (bufferAsString utf8Encoded).
 ].
 aTargetAtomID == (self atomIDOf:#LENGTH) ifTrue:[
-	"the other one wants to know the size of our selection.
+"the other one wants to know the size of our selection.
-	 LENGTH is deprecated, since we do not know how the selection is
+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"
+going to be converted. The client must not rely on the length returned"
-	^ (self atomIDOf:#INTEGER) -> (bufferAsString size).
+^ (self atomIDOf:#INTEGER) -> (bufferAsString size).
 ].
 "we do not support the requestet target type"
 ^ nil -> nil.
 screen := device screen.
 self isPixmap ifTrue:[
 pixmapDepth := depth.
 ].
-fontId := font getFontId.
+fontId := font getXftFontId.
 %{ /* STACK: 64000 */
 #ifdef XFT
 XftColor color;
 XGlyphInfo extents;

changeset 7443	e2d05b756727
parent 7416	bd3b9e9edd9e
child 7478	4865dd2c05c9