diff -r 8a24160002a1 -r 1cc8b8daaff5 XWorkstation.st --- a/XWorkstation.st Tue May 07 17:28:58 2013 +0200 +++ b/XWorkstation.st Mon May 13 09:59:03 2013 +0200 @@ -10475,30 +10475,41 @@ selectionOwnerWindowId := self getSelectionOwnerOf:clipboardAtom. selectionOwnerWindowId isNil ifTrue:[ - "no selection. There is the possibilty that one of our (modal) - views has been closed. Get the selection from the copyBuffer" - ^ copyBuffer. + "no selection. There is the possibilty that one of our (modal) + views has been closed. Get the selection from the copyBuffer" + ^ copyBuffer. ]. selectionOwnerWindowId = selectionOwner ifTrue:[ - "I still hold the selection, so return my locally buffered data" - ^ copyBuffer + "I still hold the selection, so return my locally buffered data" + ^ copyBuffer ]. drawableId notNil ifTrue:[ - "sorry, cannot fetch a selection, if there is now drawableId. - Should I borrow a drawableId from another window?" - - selection := SelectionFetcher - requestSelection:clipboardAtom - type:(self atomIDOf:#'ST_OBJECT') - onDevice:self for:drawableId. - - selection isEmptyOrNil ifTrue:[ - selection := SelectionFetcher - requestSelection:clipboardAtom - type:(self atomIDOf:#'UTF8_STRING') - onDevice:self for:drawableId. - ]. + "sorry, cannot fetch a selection, if there is no drawableId. + Should I borrow a drawableId from another window?" + + selection := SelectionFetcher + requestSelection:clipboardAtom + type:(self atomIDOf:#'ST_OBJECT') + onDevice:self for:drawableId. + + "/ should not happen +false ifTrue:[ + "/ cg: disabled the code below: I don't want any string here (when asking for an object) + selection isEmptyOrNil ifTrue:[ + selection := SelectionFetcher + requestSelection:clipboardAtom + type:(self atomIDOf:#'UTF8_STRING') + onDevice:self for:drawableId. + + selection isNil ifTrue:[ + selection := SelectionFetcher + requestSelection:clipboardAtom + type:(self atomIDOf:#STRING) + onDevice:self for:drawableId. + ]. + ]. +]. ]. selection isEmptyOrNil ifTrue:[ ^ copyBuffer ]. @@ -10516,43 +10527,43 @@ |selectionId selectionOwnerWindowId selection| selectionBufferSymbol == #selection ifTrue:[ - selectionId := primaryAtom. + selectionId := primaryAtom. ] ifFalse:[ - selectionId := clipboardAtom. + selectionId := clipboardAtom. ]. selectionOwnerWindowId := self getSelectionOwnerOf:selectionId. selectionOwnerWindowId isNil ifTrue:[ - "no selection. There is the possibilty that one of our (modal) - views has been closed. Get the selection from the copyBuffer" - ^ self copyBufferAsString. + "no selection. There is the possibilty that one of our (modal) + views has been closed. Get the selection from the copyBuffer" + ^ self copyBufferAsString. ]. selectionOwnerWindowId = selectionOwner ifTrue:[ - "I still hold the selection, so return my locally buffered data" - "JV@2012-04-02: Added support for PRIMARY/SELECTION buffers." - ^ selectionId == primaryAtom ifTrue:[ - self primaryBufferAsString - ] ifFalse:[ - self copyBufferAsString. - ] + "I still hold the selection, so return my locally buffered data" + "JV@2012-04-02: Added support for PRIMARY/SELECTION buffers." + ^ selectionId == primaryAtom ifTrue:[ + self primaryBufferAsString + ] ifFalse:[ + self copyBufferAsString. + ] ]. drawableId notNil ifTrue:[ - "sorry, cannot fetch a selection, if there is now drawableId. - Should I borrow a drawableId from another window?" - - selection := SelectionFetcher - requestSelection:selectionId - type:(self atomIDOf:#'UTF8_STRING') - onDevice:self for:drawableId. - - selection isNil ifTrue:[ - selection := SelectionFetcher - requestSelection:selectionId - type:(self atomIDOf:#STRING) - onDevice:self for:drawableId. - ]. + "sorry, cannot fetch a selection, if there is no drawableId. + Should I borrow a drawableId from another window?" + + selection := SelectionFetcher + requestSelection:selectionId + type:(self atomIDOf:#'UTF8_STRING') + onDevice:self for:drawableId. + + selection isNil ifTrue:[ + selection := SelectionFetcher + requestSelection:selectionId + type:(self atomIDOf:#STRING) + onDevice:self for:drawableId. + ]. ]. ^ selection @@ -10583,44 +10594,51 @@ Answer the converted selection" (aTargetAtom == (self atomIDOf:#STRING)) ifTrue:[ - "the other view wants the selection as string" - ^ self copyBufferAsString. + "/ 'string' printCR. + "the other view wants the selection as string" + ^ self copyBufferAsString. ]. (aTargetAtom == (self atomIDOf:#UTF8_STRING)) ifTrue:[ - "the other view wants the selection as utf8 string" - ^ self copyBufferAsString utf8Encoded. + "/ 'utf string' printCR. + "the other view wants the selection as utf8 string" + ^ self copyBufferAsString utf8Encoded. ]. (aTargetAtom == (self atomIDOf:#TIMESTAMP)) ifTrue:[ - "the other view wants to know when we acquired ownership of the selection" - ^ selectionTime. + "the other view wants to know when we acquired ownership of the selection" + ^ selectionTime. ]. (aTargetAtom == (self atomIDOf:#TARGETS)) ifTrue:[ - "the other view wants to know which targets we support" - ^ self supportedTargetAtoms. + "the other view wants to know which targets we support" + ^ self supportedTargetAtoms. ]. (aTargetAtom == (self atomIDOf:#'ST_OBJECT')) ifTrue:[ - "send the selection in binaryStore format" - "require libboss to be loaded" - (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[^ nil]. - [ - ^ self getCopyBuffer binaryStoreBytes. - ] on:Error do:[:ex| - 'XWorkstation: error on binary store of copy buffer: ' errorPrint. - ex description errorPrintCR. - ^ nil. - ]. + "/ '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 + ]. + + [ + ^ self getCopyBuffer binaryStoreBytes. + ] on:Error do:[:ex| + 'XWorkstation: error on binary store of copy buffer: ' errorPrint. + ex description errorPrintCR. + ^ nil. + ]. ]. aTargetAtom == (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 copyBufferAsString 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 copyBufferAsString size ]. "we do not support the requestet target type" @@ -12575,39 +12593,47 @@ |selection| buffer isNil ifTrue:[ - ^ nil. + ^ nil. ]. targetID == (display atomIDOf:#STRING) ifTrue:[ - display clipboardEncoding notNil ifTrue:[ - selection := buffer decodeFrom:display clipboardEncoding - ]. - selection := buffer. + display clipboardEncoding notNil ifTrue:[ + selection := buffer decodeFrom:display clipboardEncoding + ]. + selection := buffer. ] ifFalse:[targetID == (display atomIDOf:#'UTF8_STRING') ifTrue:[ "/ Transcript show:'UTF8: '; showCR:buffer storeString. - selection := CharacterArray fromUTF8Bytes:buffer + selection := CharacterArray fromUTF8Bytes:buffer ] ifFalse:[targetID == (display atomIDOf:#TEXT) ifTrue:[ "/ Transcript show:'TEXT: '; showCR:buffer storeString. - selection := buffer asString + selection := buffer asString ] ifFalse:[targetID == (display atomIDOf:#'COMPOUND_TEXT') ifTrue:[ "/ Transcript show:'COMPOUND_TEXT: '; showCR:buffer storeString. - selection := buffer asString + selection := buffer asString ]]]]. selection notNil ifTrue:[ - (selection endsWith:Character cr) ifTrue:[ - selection := selection asStringCollection copyWith:'' - ]. - ^ selection. + (selection endsWith:Character cr) ifTrue:[ + selection := selection asStringCollection copyWith:'' + ]. + ^ selection. ]. targetID == (display atomIDOf:#'TARGETS') ifTrue:[ - ^ buffer + ^ buffer ]. targetID == (display atomIDOf:#'ST_OBJECT') ifTrue:[ - "require libboss to be loaded" - (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[^ nil]. - ^ (Object readBinaryFrom:(ReadStream on:buffer) onError:[nil]) + "require libboss to be loaded" + (Smalltalk isClassLibraryLoaded:'libstx_libboss') ifFalse:[ + 'SelectionFetch: cannot decode object (libboss library missing)' errorPrintCR. + ^ nil + ]. + ^ (Object + readBinaryFrom:(ReadStream on:buffer) + onError:[:ex | + ('SelectionFetch: error while decoding binary object: ',ex description) errorPrintCR. + nil + ]) ]. 'XWorkstation: unimplemented property targetID: ' infoPrint. (display atomName:targetID) infoPrint. @@ -12794,15 +12820,15 @@ !XWorkstation class methodsFor:'documentation'! version - ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.564 2013-04-04 21:34:15 cg Exp $' + ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.565 2013-05-13 07:59:03 cg Exp $' ! version_CVS - ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.564 2013-04-04 21:34:15 cg Exp $' + ^ '$Header: /cvs/stx/stx/libview/XWorkstation.st,v 1.565 2013-05-13 07:59:03 cg Exp $' ! version_SVN - ^ '§ Id §' + ^ '$ Id $' ! !