[squeak-dev] The Trunk: System-eem.1394.mczcommits at source.squeak.org commits at source.squeak.orgThu Mar 23 22:29:26 UTC 2023
Eliot Miranda uploaded a new version of System to project The Trunk: http://source.squeak.org/trunk/System-eem.1394.mcz ==================== Summary ==================== Name: System-eem.1394 Author: eem Time: 23 March 2023, 3:29:19.403623 pm UUID: ad7fcbb9-b648-47c3-850d-d4ea3ea3f466 Ancestors: System-mt.1393 Add ExtendedClipboardInterface code from Virtend that allows importing unicode text, filenames and images. This uses the deprecated DropFilesEvent, but I don't know how to fix the import, so I'll leave it up to those that do (hi Maercle!) to fix the code in situ. N.B. pasting text in multiple formats to follow, but see ExtendedClipboardWinInterface>>packageAsHTML: as busy work necessary on Windows. =============== Diff against System-mt.1393 =============== Item was added: + (PackageInfo named: 'System') preamble: 'ExtendedClipboardWinInterface initializeClipboardFormatMap'! Item was added: + ----- Method: Array>>objectsAccessibleFromRoots (in category '*System-Object Storage-file in/out') ----- + objectsAccessibleFromRoots + "This primitive will answer an array of the receiver and every object in its proper tree of subParts + (ie, that is not refered to from anywhere else outside the tree). Note: all elements of the reciever + are treated as roots in determining the extent of the tree." + + <primitive: 96 error: ec> + self primitiveFailed + + "{ Object } objectsAccessibleFromRoots"! Item was added: + Association ephemeronSubclass: #Ephemeron + instanceVariableNames: 'container' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Finalization'! + + !Ephemeron commentStamp: 'eem 6/7/2022 15:45' prior: 0! + An Ephemeron is an association known to the garbage collection system, allowing it to function as a pre-mortem finalizer. + + An Ephemeron is intended for uses such as associating an object's dependents with an object without preventing garbage collection. + + Consider a traditional implementation of dependents in non-Model classes. There is a Dictionary in Object, DependentsFields, into which objects wishing to have dependents are entered as keys, with the value being the sequence of their dependents. Since a key's dependents (if they are like views/morphs, etc in MVC) will refer directly back to the key (e.g. in their model inst var etc), the key remains srongly referenced; there is no way to use weak collections in DependentsFields to allow the cycle of an object and its dependents to be collected. If DependentsFields were to use a WeakArray to hold the associations from objects to their dependents then those associations, and the dependencies they record, would simply be lost since the only reference to the associations is from DependentsFields. + + Ephemeron differs from a normal association in that it is known to the garbage collector and it is involved in tracing. First, note that an Ephemeron is a *strong* referrer. The objects it refers to cannot be garbage collected. It is not weak. But it is able to discover when it is the *only* reference to an object. To be accurate, an Ephemeron is notified by the collector when its key is only referenced from the transitive closure of references from ephemerons. i.e. when an ephemeron is notified we know that there are no reference paths to the ephemeron's key other than through ephemerons; the ephemeron's key is not otherwise reachable from the roots. + + Ephemerons are notified by the garage collector placing them in a queue and signalling a semaphore for each element in the queue. An image level process (the extended finalization process) extracts them from the queue and sends mourn to each ephemeron (since their keys are effectively dead). What an Ephemeron does in response to the notification is programmable (one can add subclasses of Ephemeron). But the default behaviour is to send finalize to the key, and then to remove itself from the dictionary it is in, allowing it and the transitive closure of objects reachable from it, to be collected in a subsequent garbage collection. + + Implementation: both in scavenging, and in scan-mark, if an ephemeron is encountered its key is examined. If the key is reachable from the roots (has already been scavenged, or is already marked), then the ephemeron marked and treated as an ordinary object. If the key is not yet known to be reachable the ephemeron is held in an internal queue of maybe triggerable ephemerons, and its objects are not traced. + + At the end of the initial scavenge or scan-mark phase, this queue of triggerable ephemerons is examined. All ephemerons in the list whose key is reachable are traced, and removed from the list. i.e. what has happened was that their key was found reachable form the roots after they were added in the list (the garbage collector traces the object graph in an arbitrary order, typically breadth first in the scavenger, depth-dirst in teh scan-mark). This then leaves the list populated only with ephemerons whose keys are as yet untraced, and hence only referenced from the ephemerons in the triggerable ephemeron queue, which now becomes the triggered ephemeron queue. All these ephemerons are placed in the finalization queue for processing in the image above, and all objects reachable from these ephemerons are traced (scavenged, marked). This tracing phase may encounter new potentially triggerable ephemerons which will be added to the triggerable ephemeron queue (not likely in practice , but essential for sound semantics). So the triggering phase continues until the system reaches a fixed point with an empty triggerable ephemeron queue. + + Implications and advantages: + Because ephemerons do not allow their object to be collected, they can be, and are, used to implement pre-mortem finalization. So e.g. a file can flush its buffers and then close its file descriptor before being collected (which may also imply that the system runs the garbage collector *before* snapshotting, not as part of the snapshot primitive). Ephemerons are conceptually more simple than WeakKeyDictionary et al, since they are about reference paths, not merely the existence of strong references. They accurately identify when an object is no longer reachable from the roots, no matter how many ephemerons are attached to a specific object for whatever purpose. Note that the back reference from a dependent to an object renders a weak key dictionary useless in enabling an isolated cycle to be collected since the back reference is string, and keeps the reference from the weak key alive. + + History: Ephemerons are like guardians. They were invented by George Bosworth in the early '90's, to provide pre-mortem finalization and to solve the problem of DependentsFields retaining garbage. + + Instance Variables (inherited) + container <Dictionary|Set> - the container in which the Ephemeron resides. + ! Item was added: + ----- Method: Ephemeron>>container (in category 'accessing') ----- + container + "Answer the Dictionary containing the receiver, if any." + ^container! Item was added: + ----- Method: Ephemeron>>container: (in category 'accessing') ----- + container: aDictionarySetOrNil + "Set the Dictionary containing the receiver, or nil it." + container := aDictionarySetOrNil! Item was added: + ----- Method: Ephemeron>>isEphemeron (in category 'testing') ----- + isEphemeron + ^true! Item was added: + ----- Method: Ephemeron>>mourn (in category 'mourning') ----- + mourn + "Triggered ephemerons get sent mourn by WeakArray class's finalizationProcess + (via mournLoopWith:) when the only reference(s) to an ephemeron's key is through + one or more ephemerons. i.e. the key is not reachable from the roots of the system, + only through ephemerons. So ephemerons get sent mourn when their key would + otherwise have been garbage collected. Respond to the information that the key + would have been garbage collected other than through ephemeron references by + sending finalize to the key." + container ifNotNil: [container removeKey: key ifAbsent: nil]. + key finalize! Item was added: + Dictionary subclass: #EphemeronDictionary + instanceVariableNames: 'mutex' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Finalization'! + + !EphemeronDictionary commentStamp: 'eem 10/1/2020 16:31' prior: 0! + An EphemeronDictionary is a dictionary that uses ephemerons for its associations, and hence is able to arrange that its keys are finalizable. See Phemeron's class comment. + + Instance Variables + mutex: <Mutex> + + mutex + - an access protect that prevents the receiver getting corrupted as finalization occurs while lower priority processes are adding and/or rremoving ephemerons. + ! Item was added: + ----- Method: EphemeronDictionary>>add: (in category 'adding') ----- + add: anAssociation + anAssociation class ~~ self associationClass ifTrue: + [self error: self class name, 's hold only ', self associationClass name, ' instances']. + ^super add: anAssociation! Item was added: + ----- Method: EphemeronDictionary>>associationClass (in category 'accessing') ----- + associationClass + ^Ephemeron! Item was added: + ----- Method: EphemeronDictionary>>atNewIndex:put: (in category 'private') ----- + atNewIndex: index put: anEphemeron + + anEphemeron container: self. + ^super atNewIndex: index put: anEphemeron! Item was added: + ----- Method: EphemeronDictionary>>initialize: (in category 'initialize-release') ----- + initialize: n + mutex := Mutex new. + super initialize: n! Item was added: + IdentitySet subclass: #EphemeronRegistry + instanceVariableNames: '' + classVariableNames: '' + poolDictionaries: '' + category: 'System-Finalization'! Item was changed: ----- Method: ExtendedClipboardInterface class>>current (in category 'accessing') ----- current + + ^Current ifNil: + [Current := (Smalltalk classNamed: #CPlatform) + ifNotNil: [:cPlatform| cPlatform current extendedClipboardInterfaceClass new] + ifNil: [SmalltalkImage current platformName + caseOf: { + ['Mac OS'] -> [ExtendedClipboardMacInterface new]. + ['unix'] -> [ExtendedClipboardUnixInterface new]. + ['Win32'] -> [ExtendedClipboardWinInterface new] } + otherwise: [nil]]]! - - | platform | - Current ifNil: [ - platform := SmalltalkImage current platformName. - Current := (platform = 'unix' - ifTrue: [ExtendedClipboardUnixInterface new] - ifFalse: [platform = 'Win32' - ifTrue: [ExtendedClipboardWinInterface new] - ifFalse: [ExtendedClipboardMacInterface new]])]. - ^ Current! Item was changed: ----- Method: ExtendedClipboardInterface class>>initialize (in category 'class initialization') ----- initialize "ExtendedClipboardInterface initialize" Current := nil. + (Smalltalk classNamed: #CPlatform) + ifNil: [Smalltalk addToStartUpList: self] + ifNotNil: [:cPlatformClass| Smalltalk addToStartUpList: self after: cPlatformClass]. + Smalltalk addToShutDownList: self! - Smalltalk - addToStartUpList: self; - addToShutDownList: self.! Item was changed: ----- Method: ExtendedClipboardInterface class>>startUp: (in category 'system startup') ----- startUp: resuming "The image is either being newly started (resuming is true), or it's just been snapshotted" + Current := nil! - resuming ifTrue: [ - Current := nil. - self current].! Item was added: + ----- Method: ExtendedClipboardInterface>>addFormClipboardData: (in category 'general-api-add') ----- + addFormClipboardData: aForm + ^self subclassResponsibility! Item was added: + ----- Method: ExtendedClipboardInterface>>cleanupToCopyMorphic (in category 'general-api-add') ----- + cleanupToCopyMorphic + "For some very complicated issue, this method is called when you copy a morph. + The morph is stored into PasteBuffer class variable. So text clipboard should not be + referenced. That's why this is needed. I'll re-implement it more straightforward way." + Clipboard clipboardText: ''. + ! Item was added: + ----- Method: ExtendedClipboardInterface>>convertUTF8BytesToSqueakString: (in category 'private') ----- + convertUTF8BytesToSqueakString: aByteArrayOrNil + ^aByteArrayOrNil ifNotNil: + [aByteArrayOrNil changeClassTo: ByteString. + [aByteArrayOrNil utf8ToSqueak] ifError: [aByteArrayOrNil]]! Item was added: + ----- Method: ExtendedClipboardInterface>>createClipboard (in category 'general-api-utility') ----- + createClipboard + clipboard = 0 ifTrue: [^self]. + ^ self primCreateClipboard.! Item was added: + ----- Method: ExtendedClipboardInterface>>hasClipboardDataInFormat: (in category 'testing') ----- + hasClipboardDataInFormat: integerCodeOrMIMETypeString + ^self primClipboard: clipboard hasDataInFormat: integerCodeOrMIMETypeString + + "ExtendedClipboardInterface current hasClipboardDataInFormat: 'public.file-url'" + "ExtendedClipboardInterface current hasClipboardDataInFormat: 'NSFilenamesPboardType'" + "ExtendedClipboardInterface current hasClipboardDataInFormat: 'Apple URL pasteboard type'" + "ExtendedClipboardInterface current hasClipboardDataInFormat: 'com.apple.finder.noderef'"! Item was added: + ----- Method: ExtendedClipboardInterface>>hasFileOrBitmap (in category 'testing') ----- + hasFileOrBitmap + "Answer if the clipboard contains a file (e.g. Copy in Finder/Explorer et al) or a bitmap. + Subclasses (should) override as appropriate." + + ^false! Item was added: + ----- Method: ExtendedClipboardInterface>>isInstalled (in category 'testing') ----- + isInstalled + ^self primCreateClipboardNoFail isInteger! Item was changed: ----- Method: ExtendedClipboardInterface>>primAddClipboardData:data:dataFormat: (in category 'system primitives') ----- + primAddClipboardData: clipboard data: data dataFormat: aFormat + + <primitive:'ioAddClipboardData' module: 'ClipboardExtendedPlugin' error: ec> + ^self primitiveFailed! - primAddClipboardData: clipboard "<Integer>" data: data "<ByteArray>" dataFormat: aFormat "<Integer | ByteArray>" - <primitive:'ioAddClipboardData' module: 'ClipboardExtendedPlugin'> - self primitiveFailed! Item was changed: ----- Method: ExtendedClipboardInterface>>primClearClipboard: (in category 'system primitives') ----- + primClearClipboard: clipboard + + <primitive:'ioClearClipboard' module: 'ClipboardExtendedPlugin' error: ec> + ^self primitiveFailed! - primClearClipboard: clipboard "<Integer>" - <primitive:'ioClearClipboard' module: 'ClipboardExtendedPlugin'> - self primitiveFailed.! Item was added: + ----- Method: ExtendedClipboardInterface>>primClipboard:hasDataInFormat: (in category 'system primitives') ----- + primClipboard: aClipboardAddress hasDataInFormat: integerCodeOrMIMETypeString + <primitive: 'ioHasClipboardDataInFormat' module: #ClipboardExtendedPlugin error: ec> + ^self primitiveFailed + + "ExtendedClipboardInterface current hasClipboardFormat: 'public.file-url'" + "ExtendedClipboardInterface current hasClipboardFormat: 'NSFilenamesPboardType'" + "ExtendedClipboardInterface current hasClipboardFormat: 'Apple URL pasteboard type'" + "ExtendedClipboardInterface current hasClipboardFormat: 'com.apple.finder.noderef'"! Item was changed: ----- Method: ExtendedClipboardInterface>>primCreateClipboard (in category 'system primitives') ----- + primCreateClipboard + + <primitive:'ioCreateClipboard' module: 'ClipboardExtendedPlugin' error: ec> + ^self primitiveFailed! - primCreateClipboard "^<Integer>" - <primitive:'ioCreateClipboard' module: 'ClipboardExtendedPlugin'> - ^ self primitiveFailed - ! Item was added: + ----- Method: ExtendedClipboardInterface>>primCreateClipboardNoFail (in category 'system primitives') ----- + primCreateClipboardNoFail + + <primitive:'ioCreateClipboard' module: 'ClipboardExtendedPlugin' error: ec> + ^ec! Item was changed: ----- Method: ExtendedClipboardInterface>>primGetClipboardFormat:formatNumber: (in category 'system primitives') ----- + primGetClipboardFormat: clipboard formatNumber: formatNumber + + <primitive:'ioGetClipboardFormat' module: 'ClipboardExtendedPlugin' error: ec> + ^self primitiveFailed! - primGetClipboardFormat: clipboard "<Integer>" formatNumber: formatNumber "<Integer> ^<Integer>" - "Enumerate available formats in the clipboard." - <primitive:'ioGetClipboardFormat' module: 'ClipboardExtendedPlugin'> - ^ self primitiveFailed. - ! Item was added: + ----- Method: ExtendedClipboardInterface>>primNoFailReadClipboardData:format: (in category 'system primitives') ----- + primNoFailReadClipboardData: clipboard format: format + + <primitive:'ioReadClipboardData' module: 'ClipboardExtendedPlugin' error: ec> + ^nil! Item was changed: ----- Method: ExtendedClipboardInterface>>primReadClipboardData:format: (in category 'system primitives') ----- + primReadClipboardData: clipboard format: format + + <primitive:'ioReadClipboardData' module: 'ClipboardExtendedPlugin' error: ec> + ^self primitiveFailed! - primReadClipboardData: clipboard "<Integer>" format: format "<Integer | ByteArray> ^<ByteArray>" - <primitive:'ioReadClipboardData' module: 'ClipboardExtendedPlugin'> - ^ self primitiveFailed - ! Item was added: + ----- Method: ExtendedClipboardInterface>>readAvailableFormats (in category 'general-api-read') ----- + readAvailableFormats + | rawFormats | + rawFormats := self readAvailableRawFormats. + ^self class clipboardFormatMap + ifNil: [rawFormats] + ifNotNil: + [:map| + rawFormats + select: [:rawFormat | map includesKey: rawFormat] + thenCollect: [:rawFormat| map at: rawFormat]]! Item was added: + ----- Method: ExtendedClipboardInterface>>readAvailableRawFormats (in category 'general-api-read') ----- + readAvailableRawFormats + | availableFormats formatIndex formatData | + availableFormats := OrderedCollection new: 10. + formatIndex := 1. + [formatData := self getClipboardFormat: formatIndex. + formatData notNil] + whileTrue: + [availableFormats addLast: formatData. + formatIndex := formatIndex +1]. + ^availableFormats! Item was added: + ----- Method: ExtendedClipboardInterface>>readContentsOrNil (in category 'general-api-read') ----- + readContentsOrNil + "Answer a Form, CDropFilesEvent or String for the selection on the clipboard, + or nil if no such data is available (data in another format or the clipboard is empty)." + ^self subclassResponsibility! Item was added: + ----- Method: ExtendedClipboardMacInterface>>addFormClipboardData: (in category 'general-api-add') ----- + addFormClipboardData: aForm + self addClipboardDataConvertFormToPNG: aForm! Item was added: + ----- Method: ExtendedClipboardMacInterface>>hasFileOrBitmap (in category 'testing') ----- + hasFileOrBitmap + ^#('public.file-url' 'com.apple.finder.noderef' 'public.jpeg' 'public.png') anySatisfy: [:format| self hasClipboardDataInFormat: format]! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readAvailableRawFormats (in category 'general-api-read') ----- + readAvailableRawFormats + | currentFormat availableFormats formatData | + availableFormats := OrderedCollection new: 10. + currentFormat := 1. + [formatData := self getClipboardFormat: currentFormat. + formatData notNil] whileTrue: + [availableFormats add: formatData. + currentFormat := currentFormat + 1]. + ^availableFormats! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readContentsOrNil (in category 'general-api-read') ----- + readContentsOrNil + "Answer a Form, CDropFilesEvent or String for the selection on the clipboard, + or nil if no such data is available (data in another format or the clipboard is empty)." + #('public.file-url' 'com.apple.finder.noderef' "'com.adobe.pdf'" 'public.jpeg' 'public.png' 'public.utf8-plain-text') + with: #(readFilenameDataAsDropFilesEvent: readFilenameDataAsDropFilesEvent: "readPDFClipboardDataAsForm" readJPEGClipboardDataAsForm readPNGClipboardDataAsForm readUTF8StringClipboardData) + do: [:format :reader| + (self hasClipboardDataInFormat: format) ifTrue: + [((MessageSend receiver: self selector: reader) cull: format) ifNotNil: + [:data| ^data]]]. + ^nil! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readFileOrBitmap (in category 'general-api-read') ----- + readFileOrBitmap + #('public.file-url' 'com.apple.finder.noderef' "'com.adobe.pdf'" 'public.jpeg' 'public.png') + with: #(readFilenameDataAsDropFilesEvent: readFilenameDataAsDropFilesEvent: "readPDFClipboardDataAsForm" readJPEGClipboardDataAsForm readPNGClipboardDataAsForm) + do: [:format :reader| + (self hasClipboardDataInFormat: format) ifTrue: + [((MessageSend receiver: self selector: reader) cull: format) ifNotNil: + [:data| ^data]]]. + ^nil! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readFilenameDataAsDropFilesEvent: (in category 'general-api-read') ----- + readFilenameDataAsDropFilesEvent: format + ^(self primNoFailReadClipboardData: clipboard format: format) ifNotNil: + [:fileNameBytes| + DropFilesEvent new + setPosition: EventSensor default cursorPoint + contents: (FileDirectory pathFromURI: ([fileNameBytes asString utf8ToSqueak] ifError: [fileNameBytes asString])) + hand: self]! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readJPEGClipboardDataAsForm (in category 'general-api-read') ----- + readJPEGClipboardDataAsForm + ^self readJPEGClipboardData ifNotNil: + [:bytes| (JPEGReadWriter2 on: bytes readStream) nextImage]! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readPDFClipboardData (in category 'general-api-read') ----- + readPDFClipboardData + ^self readClipboardData: 'com.adobe.pdf'! Item was added: + ----- Method: ExtendedClipboardMacInterface>>readPNGClipboardDataAsForm (in category 'general-api-read') ----- + readPNGClipboardDataAsForm + ^self readPNGClipboardData ifNotNil: + [:bytes| (PNGReadWriter on: bytes readStream) nextImage]! Item was changed: ----- Method: ExtendedClipboardMacInterface>>readUTF8StringClipboardData (in category 'general-api-read') ----- readUTF8StringClipboardData + ^(self readClipboardData: 'public.utf8-plain-text') ifNotNil: + [:stringBytes | + stringBytes changeClassTo: ByteString. + [stringBytes utf8ToSqueak] ifError: [stringBytes]]! - ^(self readClipboardData: 'public.utf8-plain-text') - ifNotNil: [:bytes | - [bytes asString utf8ToSqueak] ifError: [bytes asString] ] - ! Item was added: + ----- Method: ExtendedClipboardUnixInterface>>addFormClipboardData: (in category 'general-api-add') ----- + addFormClipboardData: aForm + self addClipboardDataConvertFormToPNG: aForm! Item was added: + ----- Method: ExtendedClipboardUnixInterface>>cleanupToCopyMorphic (in category 'general-api-add') ----- + cleanupToCopyMorphic + Clipboard default reset. + ! Item was changed: ExtendedClipboardInterface subclass: #ExtendedClipboardWinInterface instanceVariableNames: '' + classVariableNames: 'CF_BITMAP CF_DIB CF_DIBV5 CF_HDROP CF_LOCALE CF_OEMTEXT CF_PALETTE CF_PENDATA CF_PRIVATELAST CF_RIFF CF_TEXT CF_TIFF CF_UNICODETEXT CF_UTF8TEXT CF_WAVE' - classVariableNames: '' poolDictionaries: '' category: 'System-Clipboard'! Item was changed: ----- Method: ExtendedClipboardWinInterface class>>initializeClipboardFormatMap (in category 'class initialization') ----- initializeClipboardFormatMap "ExtendedClipboardWinInterface initializeClipboardFormatMap" + CF_TEXT := 1. + CF_BITMAP := 2. + "CF_METAFILEPICT := 3. + CF_SYLK := 4. + CF_DIF := 5." + CF_TIFF := 6. + CF_OEMTEXT := 7. + CF_DIB := 8. + CF_PALETTE := 9. + CF_PENDATA := 10. + CF_RIFF := 11. + CF_WAVE := 12. + CF_UNICODETEXT := 13. + "CF_ENHMETAFILE := 14." + CF_HDROP := 15. + CF_LOCALE := 16. + CF_DIBV5 := 17. + "CF_OWNERDISPLAY := 16r0080. + CF_DSPTEXT := 16r0081. + CF_DSPBITMAP := 16r0082. + CF_DSPMETAFILEPICT := 16r0083. + CF_DSPENHMETAFILE := 16r008E. + CF_PRIVATEFIRST := 16r0200." + CF_PRIVATELAST := 16r02FF. + CF_UTF8TEXT := CF_PRIVATELAST. "extension to the Windows ClipboardExtendedPlugin..." + "CF_GDIOBJFIRST := 16r0300. + CF_GDIOBJLAST := 16r03FF." + clipboardFormatMap := Dictionary new. "at: 6 put: 'image/tiff' asMIMEType; CF_TIFF" clipboardFormatMap at: 49510 put: 'text/rtf' asMIMEType; at: 1 put: 'text/plain' asMIMEType; "CF_TEXT" at: 2 put: 'image/bmp' asMIMEType; "CF_BITMAP" at: 12 put: 'audio/wave'; "CF_WAVE" at: 13 put: 'text/unicode' asMIMEType; "CF_UNICODETEXT" at: 16 put: 'CF_LOCALE'; "CF_LOCALE" yourself. ! Item was added: + ----- Method: ExtendedClipboardWinInterface>>addClipboardDataConvertFormToDIB: (in category 'general-api-add') ----- + addClipboardDataConvertFormToDIB: aForm + | bitmapSize headerSize colorMapSize bytes bitsClass | + bitmapSize := (aForm depth * aForm width + 7) // 8 * aForm height. + headerSize := 6 * 4. + "colorMapSize := aForm depth >= 24 + ifTrue: [aForm depth * 4 / 8] + ifFalse: [self error: 'pasting forms with palettes as yet unimplemented']." + colorMapSize := 0. + bytes := ByteArray new: headerSize + colorMapSize + bitmapSize. + bytes + "bmType uint32At: 1 put: 0;" + "bmWidth" uint32At: 5 put: aForm width; + "bmHeight" int32At: 9 put: aForm height negated; "i.e. top-down, not bottom-up" + "bmWidthBytes" uint32At: 13 put: aForm width * aForm depth + 7 // 8; + "bmPlanes" uint16At: 17 put: 1; + "bmBitsPixel" uint16At: 19 put: aForm depth; + "bmBits" uint32At: 21 put: 0. + bitsClass := aForm bits class. + bitsClass isBytes + ifTrue: + [bytes + replaceFrom: 25 + to: bytes size + with: aForm bits + startingAt: 1] ifFalse: + [bitsClass isWords + ifTrue: + [bitsClass adoptInstance: bytes. + bytes + replaceFrom: 7 + to: bytes size + with: aForm bits + startingAt: 1. + ByteArray adoptInstance: bytes] + ifFalse: + [self error: 'unhandled form bits format']]. + self addClipboardData: bytes dataFormat: CF_DIB! Item was added: + ----- Method: ExtendedClipboardWinInterface>>addClipboardDataConvertFormToDIBV5: (in category 'general-api-add') ----- + addClipboardDataConvertFormToDIBV5: aForm + self addClipboardData: (self convertFormToDIBV5: aForm) dataFormat: CF_DIBV5! Item was added: + ----- Method: ExtendedClipboardWinInterface>>addFormClipboardData: (in category 'general-api-add') ----- + addFormClipboardData: aForm + self addClipboardDataConvertFormToDIBV5: aForm! Item was added: + ----- Method: ExtendedClipboardWinInterface>>convertDIBV5BytesToForm: (in category 'private') ----- + convertDIBV5BytesToForm: aByteArray + "Convert from a DIBV5 bitmap. There are issues; Not every paster appears to paste a valid sizeImage + field, so compute it if zero. The plugin guarantees that height is negative, i.e. that scan-lines are + in Squeak order." + | bitCount bits compression height planes size sizeImage width widthBytes | + size := aByteArray uint32At: 1. + width := aByteArray int32At: 5. + height := aByteArray int32At: 9. + self assert: height < 0. + height := 0 - height. + planes := aByteArray int16At: 13. + bitCount := aByteArray int16At: 15. + compression := aByteArray uint32At: 17. + sizeImage := aByteArray uint32At: 21. + widthBytes := width * bitCount + 31 // 32 * 4. "number of bytes in a scan line for any depth" + sizeImage isZero ifTrue: + [sizeImage := widthBytes * height]. + "xppm := aByteArray int32At: 25. + yppm := aByteArray int32At: 29. + colorUsed := aByteArray uint32At: 33. + colorImportant := aByteArray uint32At: 37." + bits := aByteArray last: sizeImage. + "Squeak bitmaps use 4 bytes per pixel for 32 and 24 bit depths, so 24 bit deep images + must be stretched to 4 bytes per pixel. BTW this should be a primitive, or be in the + + ioReadClipboardData primitive..." + + bitCount = 24 ifTrue: + [| stretchBits ox | + stretchBits := ByteArray new: width * 4 * height. + ox := 1. + 1 to: height do: + [:y| + y - 1 * widthBytes + 1 to: y * widthBytes - 3 by: 3 do: + [:ix| + stretchBits at: ox put: (bits at: ix). + stretchBits at: ox + 1 put: (bits at: ix + 1). + stretchBits at: ox + 2 put: (bits at: ix + 2). + stretchBits at: ox + 3 put: 255. + ox := ox + 4]]. + bits := stretchBits]. + Bitmap adoptInstance: bits. + ^compression + caseOf: { + [3] -> [Form extent: width at height depth: bitCount bits: bits]. "i.e. throw away colours" + [0] -> [Form extent: width at height depth: bitCount bits: bits] + } + otherwise: [Transcript show: 'unhandled clipboard DIBV5 compression scheme ', compression printString. nil]! Item was added: + ----- Method: ExtendedClipboardWinInterface>>convertFilenameDataAsDropFilesEvent: (in category 'private') ----- + convertFilenameDataAsDropFilesEvent: fileNameBytes + "The explorer's format is unpublished. It is a sequence of 20 bytes, starting with the digit 20 (presumably the size of the struct), + folowed by concatenated null-terminated 16-bit character strings for each file name, and a terminating null byte." + | input fileNames fileName charCode | + input := fileNameBytes readStream. + fileNames := Array new writeStream. + fileName := String new writeStream. + input next: 20. + [input atEnd] whileFalse: + [charCode := input nextInt16LE. + charCode = 0 + ifTrue: + [fileName contents ifNotEmpty: [:theName| fileNames nextPut: theName. fileName reset]] + ifFalse: + [fileName nextPut: charCode asCharacter]]. + fileNames := fileNames contents. + ^DropFilesEvent new + setPosition: EventSensor default cursorPoint + contents: (fileNames size = 1 ifTrue: [fileNames first] ifFalse: [fileNames]) + hand: self! Item was added: + ----- Method: ExtendedClipboardWinInterface>>convertFormToDIBV5: (in category 'general-api-add') ----- + convertFormToDIBV5: aForm + | bitmapSize headerSize colorMapSize bytes bitsClass | + bitmapSize := (aForm depth * aForm width + 7) // 8 * aForm height. + headerSize := 124. "a.k.a. sizeof(BITMAPV5HEADER)" + colorMapSize := aForm depth >= 16 + ifTrue: [12] "incoming 32-bit deep forms appear to have no alpha..." + ifFalse: [self error: 'pasting forms with palettes as yet unimplemented']. + bytes := ByteArray new: headerSize + colorMapSize + bitmapSize. + bytes + "DWORD bV5Size" uint32At: 1 put: headerSize; + "LONG bV5Width" uint32At: 5 put: aForm width; + "LONG bV5Height" int32At: 9 put: aForm height negated; "Squeak bitmaps are top-down..." + "WORD bV5Planes" uint16At: 13 put: 1; + "WORD bV5BitCount" uint16At: 15 put: aForm depth; + "DWORD bV5Compression" uint32At: 17 put: 3; "BI_BITFIELDS" + "DWORD bV5SizeImage" uint32At: 21 put: aForm bits byteSize; + "LONG bV5XPelsPerMeter uint32At: 25 put: 0;" + "LONG bV5YPelsPerMeter uint32At: 29 put: 0;" + "DWORD bV5ClrUsed uint32At: 33 put: 0;" + "DWORD bV5ClrImportant uint32At: 37 put: 0;" + "DWORD bV5RedMask" uint32At: 41 put: (aForm depth = 16 ifTrue: [16r7C00] ifFalse: [16rFF0000]); "see Color>>#pixelValueForDepth:" + "DWORD bV5GreenMask" uint32At: 45 put: (aForm depth = 16 ifTrue: [16r03E0] ifFalse: [16r00FF00]); + "DWORD bV5BlueMask" uint32At: 49 put: (aForm depth = 16 ifTrue: [16r001F] ifFalse: [16r0000FF]); + "DWORD bV5AlphaMask" uint32At: 53 put: (aForm depth = 32 ifTrue: [16rFF000000] ifFalse: [0]); + "DWORD bV5CSType" uint32At: 57 put: 16r73524742 "sRGB"; + "typedef long FXPT2DOT30; + typedef struct tagCIEXYZ { FXPT2DOT30 ciexyzX; FXPT2DOT30 ciexyzY; FXPT2DOT30 ciexyzZ; } CIEXYZ; + typedef struct tagICEXYZTRIPLE { CIEXYZ ciexyzRed; CIEXYZ ciexyzGreen; CIEXYZ ciexyzBlue; } CIEXYZTRIPLE;" + "CIEXYZTRIPLE bV5Endpoints uint32At: n put: 0; ignored unless bV5CSType is LCS_CALIBRATED_RGB." + "DWORD bV5GammaRed uint32At: 97 put: 0;" + "DWORD bV5GammaGreen uint32At: 101 put: 0;" + "DWORD bV5GammaBlue uint32At: 105 put: 0;" + "DWORD bV5Intent" uint32At: 109 put: 4. "LCS_GM_IMAGES" + "DWORD bV5ProfileData uint32At: n put: 0;" + "DWORD bV5ProfileSize uint32At: n put: 0;" + "DWORD bV5Reserved uint32At: n put: 0." + "fill in the palette entries, copying them from bV5RedMask et al" + bytes + replaceFrom: 125 + to: 137 + with: bytes + startingAt: 41. + bitsClass := aForm bits class. + bitsClass isBytes + ifTrue: + [bytes + replaceFrom: headerSize + colorMapSize + 1 + to: bytes size + with: aForm bits + startingAt: 1] ifFalse: + [bitsClass isWords + ifTrue: + [bitsClass adoptInstance: bytes. + bytes + replaceFrom: (headerSize + colorMapSize / 4) + 1 + to: bytes size + with: aForm bits + startingAt: 1. + ByteArray adoptInstance: bytes] + ifFalse: + [self error: 'unhandled form bits format']]. + ^bytes! Item was added: + ----- Method: ExtendedClipboardWinInterface>>decomposeDIBBytes: (in category 'private') ----- + decomposeDIBBytes: aByteArray + "Answer a tuple of biSize, biWidth, biHeight biPlanes biBitCount biCompression biSizeImage and biBits, + derived from aDIBByteArray, a byte array containing a Device-Independent Bitmap from the clipboard." + | sizeImage | + ^{ "size:" aByteArray uint32At: 1. + "width" aByteArray int32At: 5. + "height" aByteArray int32At: 9. + "planes:" aByteArray int16At: 13. + "bitCount" aByteArray int16At: 15. + "compression:" aByteArray uint32At: 17. + sizeImage := aByteArray uint32At: 21. + "xppm:" aByteArray int32At: 25. + "yppm:" aByteArray int32At: 29. + "colorUsed:" aByteArray uint32At: 33. + "colorImportant:" aByteArray uint32At: 37. + "bits:" aByteArray last: sizeImage "width * height * bitCount / 8". + aByteArray. + aByteArray size }! Item was added: + ----- Method: ExtendedClipboardWinInterface>>decomposeDIBV5Bytes: (in category 'private') ----- + decomposeDIBV5Bytes: aByteArray + "Answer a tuple of biSize, biWidth, biHeight biPlanes biBitCount biCompression biSizeImage and biBits, + derived from aDIBByteArray, a byte array containing a V5 Device-Independent Bitmap from the clipboard." + ^{ "DWORD bV5Size" aByteArray uint32At: 1. + "LONG bV5Width" aByteArray int32At: 5. + "LONG bV5Height" aByteArray int32At: 9. + "WORD bV5Planes" aByteArray uint16At: 13. + "WORD bV5BitCount" aByteArray uint16At: 15. + "DWORD bV5Compression" aByteArray uint32At: 17. + "DWORD bV5SizeImage" aByteArray uint32At: 21. + "LONG bV5XPelsPerMeter" aByteArray int32At: 25. + "LONG bV5YPelsPerMeter" aByteArray int32At: 29. + "DWORD bV5ClrUsed" aByteArray uint32At: 33. + "DWORD bV5ClrImportant" aByteArray uint32At: 37. + "DWORD bV5RedMask" aByteArray uint32At: 41. + "DWORD bV5GreenMask" aByteArray uint32At: 45. + "DWORD bV5BlueMask" aByteArray uint32At: 49. + "DWORD bV5AlphaMask" aByteArray uint32At: 53. + "DWORD bV5CSType" aByteArray uint32At: 57. + "typedef long FXPT2DOT30; + typedef struct tagCIEXYZ { FXPT2DOT30 ciexyzX; FXPT2DOT30 ciexyzY; FXPT2DOT30 ciexyzZ; } CIEXYZ; + typedef struct tagICEXYZTRIPLE { CIEXYZ ciexyzRed; CIEXYZ ciexyzGreen; CIEXYZ ciexyzBlue; } CIEXYZTRIPLE;" + "CIEXYZTRIPLE bV5Endpoints:" (1 to: 4 * 9 by: 4) collect: [:i| aByteArray int32At: i + 60]. "ignored unless bV5CSType is LCS_CALIBRATED_RGB." + "DWORD bV5GammaRed" aByteArray uint32At: 97. + "DWORD bV5GammaGreen" aByteArray uint32At: 101. + "DWORD bV5GammaBlue" aByteArray uint32At: 105. + "DWORD bV5Intent" aByteArray uint32At: 109. + "DWORD bV5ProfileData" aByteArray uint32At: 113. + "DWORD bV5ProfileSize" aByteArray uint32At: 117. + "DWORD bV5Reserved" aByteArray uint32At: 121 }! Item was added: + ----- Method: ExtendedClipboardWinInterface>>packageAsHTML: (in category 'private') ----- + packageAsHTML: htmlString + "Surround some HTML with the necessary header & footer that makes it palatable to the system clipboard." + | header payload trailer | + header := 'Version:0.9\StartHTML:0000000100\EndHTML:NNNNNNNNNN\StartFragment:0000000134\EndFragment:NNNNNNNNNN\<html>\<body>\<!!--StartFragment-->'. + trailer := '<!!--EndFragment-->\</body>\</html>0'. + payload := header withCRs, htmlString, trailer withCRs. "Chrome appears to use cr as a newline character" + payload + at: payload size put: 0 asCharacter; + replaceFrom: 42 to: 51 with: (payload size - 1 printStringBase: 10 length: 10 padded: true); + replaceFrom: 90 to: 99 with: (payload size - 35 printStringBase: 10 length: 10 padded: true). + ^payload! Item was changed: ----- Method: ExtendedClipboardWinInterface>>readBMPClipboardData (in category 'general-api-read') ----- readBMPClipboardData + ^self getClipboardData: CF_BITMAP! - | string | - self openClipboard. - [string := (self getClipboardData: (self class mimeTypeMap at: 'image/*' asMIMEType)) fromCString] - ensure: [self closeClipboard]. - ^string! Item was added: + ----- Method: ExtendedClipboardWinInterface>>readContentsOrNil (in category 'general-api-read') ----- + readContentsOrNil + "Answer a Form, CDropFilesEvent or String for the selection on the clipboard, + or nil if no such data is available (data in another format or the clipboard is empty)." + + #(15 "CF_DROP" 17 "CF_DIBV5" 8 "CF_DIB" 2 "CF_BITMAP" 767 "CF_UTF8TEXT") + with: #(convertFilenameDataAsDropFilesEvent: convertDIBV5BytesToForm: convertDIBBytesToForm: convertBitmapBytesToForm: convertUTF8BytesToSqueakString:) + do: [:format :converter| + (self primNoFailReadClipboardData: clipboard format: format) ifNotNil: + [:data| ^self perform: converter with: data]]. + ^nil! Item was added: + ----- Method: ExtendedClipboardWinInterface>>readFilenameDataAsDropFilesEvent: (in category 'general-api-read') ----- + readFilenameDataAsDropFilesEvent: format + "Read one or more file names from the clipboard, wrapped in a drop event." + ^(self primNoFailReadClipboardData: clipboard format: format) ifNotNil: + [:fileNameBytes| self convertFilenameDataAsDropFilesEvent: fileNameBytes]! Item was changed: ----- Method: ExtendedClipboardWinInterface>>readFormClipboardData (in category 'general-api-read') ----- readFormClipboardData + self readAvailableRawFormats sorted reverseDo: + [:format| + format + caseOf: { + [CF_DIBV5] -> [^self convertDIBV5BytesToForm: (self readClipboardData: format)]. + [CF_DIB] -> [^self convertDIBBytesToForm: (self readClipboardData: format)]. + [CF_BITMAP] -> [^self convertBitmapBytesToForm: (self readClipboardData: format)] + } + otherwise: []]. + ^nil! - | bytes formats | - formats := self readAvailableFormats. - (formats includes: 'image/bmp' asMIMEType) - ifTrue: [bytes := self readBMPClipboardData. - ^ (BMPReadWriter on: bytes readStream) nextImage]. - ^ nil! Item was changed: ----- Method: ExtendedClipboardWinInterface>>readTIFFClipboardData (in category 'general-api-read') ----- readTIFFClipboardData + ^self getClipboardData: CF_TIFF! - | string | - self openClipboard. - [string := (self getClipboardData: (self class mimeTypeMap at: 'image/tiff' asMIMEType)) fromCString] - ensure: [self closeClipboard]. - ^string! Item was changed: ----- Method: ExtendedClipboardWinInterface>>readWideStringClipboardData (in category 'general-api-read') ----- readWideStringClipboardData (self hasClipboardData: 13) "CF_UNICODETEXT" ifFalse: [^ nil]. + ^((self getClipboardData: CF_UTF8TEXT) changeClassTo: ByteString) utf8ToSqueak! - "HACK!! Use CF_PRIVATELAST to handle UTF16-encoded UTF8. See platform code." - ^ (self readClipboardData: 16r02FF) "CF_PRIVATELAST" - ifNotNil: [:bytes | [bytes asString utf8ToSqueak] ifError: [bytes asString] ]! Item was added: + ----- Method: Object>>isEphemeron (in category '*System-Finalization-testing') ----- + isEphemeron + ^false! Item was added: + ----- Method: Preferences class>>vmProfilerFillInIntegral (in category 'standard queries') ----- + vmProfilerFillInIntegral + ^ self + valueOfFlag: #vmProfilerFillInIntegral + ifAbsent: [false]! Item was added: + ----- Method: WeakArray class>>doOldFinalization (in category '*System-Finalization') ----- + doOldFinalization + "Process the weak registries, in the old finalization style. Hopefully this will + eventually go away when all clients have adopted the new finalization scheme." + FinalizationLock + critical: + [FinalizationDependents do: + [ :weakDependent | + weakDependent ifNotNil: + [weakDependent finalizeValues]]] + ifError: + [:msg :rcvr | rcvr error: msg]! Item was changed: ----- Method: WeakArray class>>finalizationProcess (in category '*System-Finalization') ----- finalizationProcess + "The finalization process arranges to send mourn to each element of the VM's finalization queue, + which is accessed via primitiveFetchMourner. The VM signals FinalizationSemaphore whenever + the queue is non-empty. This process loops, waiting on the semaphore, fetches the first element + of the queue and then spawns a process at a higher priority to actually send the mourn messages. + If an error occurs in the higher priority mourn loop process then this process will simply spawn + another process, hence ensuring that errors in finalization methods don't break finalization. + In addition this process also runs the old finalization scheme, supporting clients of the older, + WeakRegistry based scheme. Hopefully this will go away when all cleints have moved over." + | throttle firstMourner | + throttle := Semaphore new. + [FinalizationSemaphore wait; initSignals. + "Support the old scheme until things have changed over..." + self doOldFinalization. + [firstMourner := self primitiveFetchMourner. + firstMourner notNil] whileTrue: + [[throttle signal. + self mournLoopWith: firstMourner] forkAt: Processor activePriority + 1. + throttle wait]] repeat! - [FinalizationSemaphore wait. - FinalizationLock - critical: - [FinalizationDependents do: - [ :weakDependent | - weakDependent ifNotNil: - [weakDependent finalizeValues]]] - ifError: - [:msg :rcvr | rcvr error: msg]] repeat! Item was added: + ----- Method: WeakArray class>>mournLoopWith: (in category '*System-Finalization') ----- + mournLoopWith: firstMourner + "Send mourn to all the objects available in the mourn queue, starting + with firstMourner which the sender has already extraced for us. If + an error occurs here, it will break this loop but the sender will spawn + another mournLoopWith: so that finalization is not broken by errors in + individual cases." + | mourner | + mourner := firstMourner. + [mourner isEphemeron ifTrue: + [mourner mourn]. + (mourner := self primitiveFetchMourner) notNil] whileTrue!
More information about the Squeak-dev mailing list |