'From MinimalMorphic of 8 December 2006 [latest update: #7246] on 16 February 2010 at 10:58:03 am'! !Object methodsFor: 'error handling' stamp: 'edc 7/31/2008 06:39'! dpsTraceUntilRoot: anObject | reportString context count | Transcript open. reportString := (anObject respondsTo: #asString) ifTrue: [anObject asString] ifFalse: [anObject printString]. (Smalltalk at: #Decompiler ifAbsent: [nil]) ifNil: [Transcript cr; show: reportString] ifNotNil: [context := thisContext. count := 1. [Transcript cr. Transcript show: count printString, ': '. reportString notNil ifTrue: [Transcript show: context home class name , '/' , context sender selector, ' (' , reportString , ')'. context := context sender. reportString := nil] ifFalse: [(context notNil and: [(context := context sender) notNil]) ifTrue: [Transcript show: context receiver class name , '/' , context selector. count := count + 1]]. context sender notNil]whileTrue]! ! !Object methodsFor: 'evaluating' stamp: 'edc 7/18/2005 10:51'! ancestors | nonMetaClass classList | nonMetaClass := self theNonMetaClass. classList := OrderedCollection new. nonMetaClass allSuperclasses reverseDo: [:aClass | classList add: aClass name. ]. ^ classList! ! !Object methodsFor: 'evaluating' stamp: 'edc 7/18/2005 10:51'! othersClassList |classList metodosSospechosos | classList := Set new. metodosSospechosos := self methodDict . metodosSospechosos isEmpty ifFalse: [metodosSospechosos collect: [:cm | cm literals select: [:any | any isVariableBinding] thenCollect: [:each | (Smalltalk at: each key ifAbsent:[]) ifNotNil: [ classList add: each key]]]]. metodosSospechosos := self class methodDict . metodosSospechosos isEmpty ifFalse: [metodosSospechosos collect: [:cm | cm literals select: [:any | any isVariableBinding] thenCollect: [:each | (Smalltalk at: each key ifAbsent:[]) ifNotNil: [classList add: each key]]]]. classList remove: self name ifAbsent: []. ^classList ! ! !Object methodsFor: 'objects from disk' stamp: 'edc 9/6/2008 19:40'! fileOutCompressed | unzipped zipped buffer aFileName | aFileName := self class name asFileName. "do better?" aFileName := UIManager default request: 'File name?' translated initialAnswer: aFileName. aFileName size == 0 ifTrue: [^ Beeper beep]. Cursor write showWhile: [unzipped := RWBinaryOrTextStream on: ''. unzipped fileOutClass: nil andObject: self. unzipped reset. zipped := FileDirectory default newFileNamed: aFileName , 'obz'. zipped binary. zipped := GZipWriteStream on: zipped. buffer := ByteArray new: 50000. 'Compressing ' , self name displayProgressAt: Sensor cursorPoint from: 0 to: unzipped size during: [:bar | [unzipped atEnd] whileFalse: [bar value: unzipped position. zipped nextPutAll: (unzipped nextInto: buffer)]. zipped close. unzipped close]]! ! !Object methodsFor: 'objects from disk' stamp: 'edc 9/5/2008 08:57'! saveOnFileNamed: aString "Ask the user for a filename and save myself on a SmartReferenceStream file. Writes out the version and class structure. The file is fileIn-able. UniClasses will be filed out. This save objects as .obj" | aFileName fileStream | aString isEmpty ifTrue: [^ Beeper beep]. aFileName := ('my {1}' translated format: {self class name}) asFileName. "do better?" aFileName := aString , '.obj'. fileStream := FileStream newFileNamed: aFileName asFileName. fileStream fileOutClass: nil andObject: self! ! !Object class methodsFor: '*services-extras' stamp: 'edc 2/14/2008 08:24'! fileReaderServicesForFile: fullName suffix: suffix | services | services _ OrderedCollection new. (fullName asLowercase endsWith: '.obj') ifTrue: [ services add: self serviceLoadObject ]. ^services! ! !Object class methodsFor: '*services-extras' stamp: 'edc 7/27/2008 08:11'! readCompressedObject: aFileStream self readAndInspect: (MultiByteBinaryOrTextStream with: (GZipReadStream on: aFileStream) upToEnd) reset! ! !Object class methodsFor: '*services-extras' stamp: 'edc 10/25/2006 17:45'! registeredServices ^ { Service new label: 'Open saved objects'; shortLabel: 'object'; description: 'load back saved object '; action: [:stream | self readAndInspect: (FileStream oldFileOrNoneNamed:stream name)]; shortcut: nil; categories: Service worldServiceCat.} ! ! !Object class methodsFor: '*services-extras' stamp: 'edc 7/27/2008 07:40'! serviceCompressedObject "Answer a service for opening a saved Object" ^ (SimpleServiceEntry provider: Object label: 'gz saved Object' selector: #readCompressedObject: description: 'open a gz Object' buttonLabel: 'object') argumentGetter: [:fileList | fileList readOnlyStream]! ! !Object class methodsFor: '*services-extras' stamp: 'edc 2/14/2008 08:26'! serviceLoadObject "Answer a service for opening a saved Object" ^ (SimpleServiceEntry provider: self label: 'saved Object' selector: #readAndInspect: description: 'open a Object' buttonLabel: 'object') argumentGetter: [:fileList | fileList readOnlyStream]! ! !Object class methodsFor: 'instance creation' stamp: 'edc 9/6/2008 08:57'! lookForClass: aClass | path inputStream fcb superPseudo pseudo | path := self lookForClassIn3dot10: aClass. inputStream := HTTPLoader default retrieveContentsFor: path. inputStream := RWBinaryOrTextStream with: inputStream content unzipped. fcb := FilePackage new fullName: aClass; fileInFrom: (MultiByteBinaryOrTextStream with: inputStream contents). pseudo := fcb classes at: aClass. superPseudo := pseudo definition copyUpTo: Character space. Smalltalk at: superPseudo asSymbol ifAbsent: [self lookForClass: superPseudo]. ChangeSorter newChangesFromStream: inputStream named: aClass asString! ! !Object class methodsFor: 'instance creation' stamp: 'edc 9/6/2008 10:54'! lookForClassIn3dot10: aClass | inputStream cat path | Missing3dot10 ifNil: [inputStream := HTTPLoader default retrieveContentsFor: 'ftp.squeak.org/various_images/SqueakLight//SLupdates/Organizer3dot10.obj'. inputStream := (MultiByteBinaryOrTextStream with: inputStream contents) reset. inputStream setConverterForCode. Smalltalk at: #Missing3dot10 put: inputStream fileInObjectAndCode]. cat := Missing3dot10 at: aClass ifAbsent: [^ self lookForClassIn3dot9: aClass]. ^ path := 'http://squeakros.atspace.com/3dot10/' , cat , '/' , aClass asString , '.sqz'! ! !Object class methodsFor: 'instance creation' stamp: 'edc 9/6/2008 10:52'! lookForClassIn3dot9: aClass | inputStream cat path | Missing3dot9 ifNil: [inputStream := HTTPLoader default retrieveContentsFor: 'ftp.squeak.org/various_images/SqueakLight//SLupdates/Organizer3dot9.obj'. inputStream := (MultiByteBinaryOrTextStream with: inputStream contents) reset. inputStream setConverterForCode. Smalltalk at: #Missing3dot9 put: inputStream fileInObjectAndCode]. cat := Missing3dot9 at: aClass ifAbsent: [^ self error: aClass , ' is not on server ']. ^path := 'http://squeakros.atspace.com/3dot9/' , cat , '/' , aClass asString , '.sqz'. ! ! !Object class methodsFor: 'objects from disk' stamp: 'edc 6/11/2008 07:37'! readAndInspect: inputStream inputStream setConverterForCode. (inputStream fileInObjectAndCode ) inspect! ! !Utilities class methodsFor: 'identification' stamp: 'edc 10/6/2008 09:58'! methodsWithInitials: targetInitials inClass: aClass "Based on a do-it contributed to the Squeak mailing list by G¦É¬Žran Hultgen: Browse methods whose initials (in the time-stamp, as logged to disk) match the given initials. Print out the complete time-stamp table to the Transcript. Answer a list of (initials -> count) associations. CAUTION: It may take several minutes for this to complete." "Time millisecondsToRun: [Utilities methodsWithInitials: 'bf']" | methodList methodListClass | methodList := aClass methodDict select:[:cm| cm author = targetInitials]. methodListClass := aClass class methodDict select:[:cm| cm author = targetInitials]. ^methodList,methodListClass ! !