[squeak-dev] Squeak 4.6: 45Deprecated-fbs.24.mcz

commits at source.squeak.org commits at source.squeak.org
Fri Jun 5 20:28:48 UTC 2015


Chris Muller uploaded a new version of 45Deprecated to project Squeak 4.6:
http://source.squeak.org/squeak46/45Deprecated-fbs.24.mcz

==================== Summary ====================

Name: 45Deprecated-fbs.24
Author: fbs
Time: 11 January 2014, 4:41:18.972 pm
UUID: 4033c169-94c6-7741-9aee-5a7570a7ec7a
Ancestors: 45Deprecated-nice.23

This stuff has rotted. It probably ought to simply be deleted, but let's hedge our bets and move it to 45Deprecated.

==================== Snapshot ====================

SystemOrganization addCategory: #'45Deprecated-Installer-Core'!

----- Method: CompiledMethod>>setMySourcePointer: (in category '*45Deprecated') -----
setMySourcePointer: srcPointer

	self deprecated: 'Use #setSourcePointer: '.
	
	^ self setSourcePointer: srcPointer!

----- Method: SmalltalkImage>>cleanUpUndoCommands (in category '*45Deprecated') -----
cleanUpUndoCommands
	
	self deprecated: 'This method was superseded by Command class >> #cleanUp'.
	globals at: #Command ifPresent: [ :command | command cleanUp ]!

----- Method: SmalltalkImage>>do: (in category '*45Deprecated') -----
do: aBlock
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals do: aBlock!

----- Method: SmalltalkImage>>forgetDoIts (in category '*45Deprecated') -----
forgetDoIts	
	
	self deprecated: 'This method does not have to be sent anymore!!'
!

----- Method: SmalltalkImage>>includes: (in category '*45Deprecated') -----
includes: element
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals includes: element!

----- Method: SmalltalkImage>>keyAtIdentityValue:ifAbsent: (in category '*45Deprecated') -----
keyAtIdentityValue: anObject ifAbsent: aBlock
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals keyAtIdentityValue: anObject ifAbsent: aBlock!

----- Method: SmalltalkImage>>keyAtValue: (in category '*45Deprecated') -----
keyAtValue: value
	"Answer the key that is the external name for the argument, value. If
	there is none, answer nil."

	self deprecated: 'Use Smalltalk globals'.
	^globals keyAtValue: value
!

----- Method: SmalltalkImage>>keys (in category '*45Deprecated') -----
keys
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals keys!

----- Method: SmalltalkImage>>keysAndValuesDo: (in category '*45Deprecated') -----
keysAndValuesDo: aBlock
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals keysAndValuesDo: aBlock!

----- Method: SmalltalkImage>>removeKey: (in category '*45Deprecated') -----
removeKey: key
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals removeKey: key!

----- Method: SmalltalkImage>>removeKey:ifAbsent: (in category '*45Deprecated') -----
removeKey: key ifAbsent: aBlock
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals removeKey: key ifAbsent: aBlock!

----- Method: SmalltalkImage>>scopeFor:from:envtAndPathIfFound: (in category '*45Deprecated') -----
scopeFor: varName from: lower envtAndPathIfFound: envtAndPathBlock
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	(globals includesKey: varName)
		ifTrue: [^ envtAndPathBlock value: self value: String new]
		ifFalse: [^ nil]!

----- Method: SmalltalkImage>>size (in category '*45Deprecated') -----
size
	"Obsoleted."

	self deprecated: 'Use Smalltalk globals'.
	^globals size!

----- Method: SocketStream class>>finger: (in category '*45Deprecated-example') -----
finger: userName
	self error: 'Use SocketStream >> #finger:at:'.!

----- Method: MessageTally>>close (in category '*45Deprecated') -----
close

	self deprecated: 'Use MessageTally >> #terminateTimerProcess'.
	Timer ifNotNil: [ Timer terminate ].
	Timer := nil.
	class := method := tally := receivers := nil!

----- Method: Integer>>asStringWithCommasSigned (in category '*45Deprecated') -----
asStringWithCommasSigned
	"123456789 asStringWithCommasSigned"
	"-123456789 asStringWithCommasSigned"
	| digits |
self deprecated: 'Use #asStringWithCommasSigned:'.
	digits := self abs printString.
	^ String streamContents:
		[:strm | 
		self sign = -1 ifTrue: [strm nextPut: $-] ifFalse:[strm nextPut: $+].
		1 to: digits size do: 
			[:i | strm nextPut: (digits at: i).
			(i < digits size and: [(i - digits size) \\ 3 = 0])
				ifTrue: [strm nextPut: $,]]]!

----- Method: Integer>>raisedToInteger:modulo: (in category '*45Deprecated') -----
raisedToInteger: exp modulo: m
	self deprecated: 'rather use #raisedTo:modulo: for efficiency'.
	(exp = 0) ifTrue: [^ 1].
	exp even
		ifTrue: [^ (self raisedToInteger: (exp // 2) modulo: m) squared \\ m]
		ifFalse: [^ (self * (self raisedToInteger: (exp - 1) modulo: m)) \\ m].!

----- Method: BitBlt>>displayString:from:to:at:kern:baselineY:font: (in category '*45Deprecated') -----
displayString: aString from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY font: aFont
	"Double dispatch into the font. This method is present so that other-than-bitblt entities can be used by CharacterScanner and friends to display text."
	^ aFont displayString: aString on: self from: startIndex to: stopIndex at: aPoint kern: kernDelta baselineY: baselineY!

----- Method: BitBlt>>displayString:from:to:at:kern:font: (in category '*45Deprecated') -----
displayString: aString from: startIndex to: stopIndex at: aPoint kern: kernDelta font: aFont
	"Double dispatch into the font. This method is present so that other-than-bitblt entities can be used by CharacterScanner and friends to display text."
	^ aFont displayString: aString on: self from: startIndex to: stopIndex at: aPoint kern: kernDelta!

----- Method: BitBlt>>installFont:foregroundColor:backgroundColor: (in category '*45Deprecated') -----
installFont: aFont foregroundColor: foregroundColor backgroundColor: backgroundColor
	"Double dispatch into the font. This method is present so that other-than-bitblt entities can be used by CharacterScanner and friends to display text."
	^aFont installOn: self foregroundColor: foregroundColor backgroundColor: backgroundColor!

----- Method: LanguageEnvironment>>setupSqueaklandSpecifics (in category '*45Deprecated-utilities') -----
setupSqueaklandSpecifics
	"Write language specific settings here"!

----- Method: SystemNavigation>>allMethodsNoDoitsSelect: (in category '*45Deprecated') -----
allMethodsNoDoitsSelect: aBlock 
	"Like allSelect:, but strip out Doits"
	
	self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'.
	^self allMethodsSelect: aBlock!

----- Method: SystemNavigation>>selectAllMethods: (in category '*45Deprecated') -----
selectAllMethods: aBlock 
	"Answer a SortedCollection of each method that, when used as the block  
	argument to aBlock, gives a true result."
	
	self deprecated: 'Use #allMethodsSelect:'.
	^self allMethodsSelect: aBlock!

----- Method: SystemNavigation>>selectAllMethodsNoDoits: (in category '*45Deprecated') -----
selectAllMethodsNoDoits: aBlock 
	"Like allSelect:, but strip out Doits"
	
	self deprecated: 'Doits are not present in MethodDictionaries anymore. Use #allMethodsSelect:'.
	^self allMethodsSelect: aBlock!

----- Method: CharacterScanner>>initializeStringMeasurer (in category '*45Deprecated') -----
initializeStringMeasurer
	"This method was once required to measure String but is now obsolescent."
	
	self deprecated: 'initializeStringMeasurer is no longer required'
!

----- Method: Parser>>initPattern:notifying:return: (in category '*45Deprecated') -----
initPattern: aString notifying: req return: aBlock

	req
		ifNil:
			[self deprecated: 'Notifying nil is unnecessary, simply use #initPattern:return:'.
			^self initPattern: aString return: aBlock]
		ifNotNil:
			[| result |
			self deprecated: '#initPattern:return: was preferred because everybody was notifying nil, but you.
You could ask for re-integration of this message'.
			self
				init: (ReadStream on: aString asString)
				cue: (CompilationCue source: aString requestor: req)
				failBlock: [^nil].
			encoder := self.
			result := aBlock value: (self pattern: false inContext: nil).
			encoder := failBlock := nil.  "break cycles"
			^result]!

----- Method: TextDiffBuilder class>>buildDisplayPatchFrom:to:inClass: (in category '*45Deprecated') -----
buildDisplayPatchFrom: sourceText to: destinationText inClass: sourceClass 
	
	self deprecated: 'Use #buildDisplayPatchFrom:to:inClass:prettyDiffs:'.
	^self 
		buildDisplayPatchFrom: sourceText 
		to: destinationText
		inClass: sourceClass
		prettyDiffs: (Preferences valueOfFlag: #diffsWithPrettyPrint)!

----- Method: SystemDictionary>>hasSpecialSelector:ifTrueSetByte: (in category '*45Deprecated') -----
hasSpecialSelector: aLiteral ifTrueSetByte: aBlock

	self deprecated: 'Use Smalltalk'.
	^Smalltalk hasSpecialSelector: aLiteral ifTrueSetByte: aBlock!

----- Method: InputSensor>>currentCursor (in category '*45Deprecated') -----
currentCursor
	"The current cursor is maintained in class Cursor."
	self deprecated: 'Use Cursor >> #currentCursor'.
	^ Cursor currentCursor!

----- Method: InputSensor>>currentCursor: (in category '*45Deprecated') -----
currentCursor: newCursor 
	"The current cursor is maintained in class Cursor."
	self deprecated: 'Use Cursor >> #currentCursor:'.
	Cursor currentCursor: newCursor.!

----- Method: Behavior>>compile:classified:notifying:trailer:ifFail: (in category '*45Deprecated') -----
compile: code classified: category notifying: requestor trailer: bytes ifFail: failBlock
	self deprecated: 'Use #compile:notifying:trailer:ifFail:'.
	^self compile: code notifying: requestor trailer: bytes ifFail: failBlock!

----- Method: Behavior>>whichSelectorsAssign: (in category '*45Deprecated') -----
whichSelectorsAssign: instVarName 
	"Answer a Set of selectors whose methods store into the argument, 
	instVarName, as a named instance variable."
	
	self deprecated: 'Use #whichSelectorsStoreInto:.'.
	^self whichSelectorsStoreInto: instVarName!

Installer subclass: #InstallerCruft
	instanceVariableNames: ''
	classVariableNames: ''
	poolDictionaries: ''
	category: '45Deprecated-Installer-Core'!

!InstallerCruft commentStamp: 'mtf 10/1/2008 22:24' prior: 0!
I am a copy of Installer as of Installer-Core-kph.232. I am being split up.
I  am called InstallerCruft because I stand-in for Sake{MC,SM,Mantis,Web,etc}Installer!

----- Method: InstallerCruft class>>classProjectLauncher (in category 'accessing system') -----
classProjectLauncher

	^Smalltalk at: #ProjectLauncher ifAbsent: [ self error: 'ProjectLauncher not present' ]!

----- Method: InstallerCruft class>>classSakePackages (in category 'accessing system') -----
classSakePackages

	^Smalltalk at: #SakePackages  ifAbsent: [ self error: 'Sake Packages code not present' ]!

----- Method: InstallerCruft class>>classes (in category 'accessing system') -----
classes

	^ Smalltalk!

----- Method: InstallerCruft class>>history (in category 'documentation') -----
history

"
7 Jan 2007  
!!Installer fixBug: <aBugNo>

aBugNo can now be a number or a string, beginning with a number. 
This allows the mantis bug report summary to be used verbatim.
It also provides more infomarion for Installer to support self documentation.

!!Install fix if not already installed
 Installer ensureFix: <aBugNoOrString>
 Installer ensureFixes: #(1 2 3 4)

Installer now keeps a list of fix <aBugNoOrString> that have been installed up to this point.
#ensureFix: will only install the fix if it has not already been loaded.
note that only the bugNumber not the description is significant in the check.

8 Jan 2007
!!Installer view: <webPageNameOrUrl>

Provided that web page based scripts follow some simple rules, installer can collate the scripts from 
web pages into a single workspace where you can manually 'doit' portions as you wish.

The report generation is not very clever, it only matches on:
 'Installer install:' ,  'Installer installUrl:', and 'Installer mantis fixBug:'
 note these lines must be properly completed with an ending $. (period).

also invoked by commandline option VIEW=<webPageNameOrUrl>

10 Jan 2007
!!Now matches simpler html

Check for an html page, now matches
'<!!DOCTYPE HTML' and <html> 
the allows use of pbwiki's raw=bare option which returns iframe 
embeddable html without the usual headers.

8 May 2007
Modified bug:fix:date: so that the fixesApplied history does not contain unnecessary duplicate entries.
Fixed changeset naming for mantis bugs.

25 July 2007
Added Universes  Support
"!

----- Method: InstallerCruft class>>mczInstall: (in category 'documentation') -----
mczInstall: urlOrFile

	^ self new mczInstall: urlOrFile
!

----- Method: InstallerCruft class>>smalltalkImage (in category 'accessing system') -----
smalltalkImage
	^ Smalltalk!

----- Method: InstallerCruft class>>sourceFiles (in category 'accessing system') -----
sourceFiles

	^ SourceFiles!

----- Method: InstallerCruft class>>unload: (in category 'unload') -----
unload: categoryMatchesString 

	^ self error: 'deprecated, use Installer mc unload: ''pkgname''.'!

----- Method: InstallerCruft>>classMCMczReader (in category 'class references') -----
classMCMczReader

	^Smalltalk at: #MCMczReader ifAbsent: [ nil ]
	!

----- Method: InstallerCruft>>createRBforBug: (in category 'mantis') -----
createRBforBug: aBugNo 
	| aStream  fileList selFile aFileName suffix |

	self setBug: aBugNo.
fileList := self maFiles keys asOrderedCollection.
fileList  addLast: 'none'.
(Smalltalk classNamed: #ReleaseBuilderFor3dot10) clear.
[selFile := UIManager default chooseFrom: fileList title: 'Choose what files load '.
selFile = fileList size ifFalse:[
aFileName := fileList at: selFile.
	self logCR: 'obtaining ', aFileName, '...'.

	aStream := self maStreamForFile: aFileName .suffix := (FileDirectory extensionFor: aFileName) asLowercase.
	
	suffix caseOf:
	{
['gz'] -> [self installGZ: aFileName from: aStream ].
['cs' ] -> [self installCS: aFileName from: aStream].
['st' ] -> [self installCS: aFileName from: aStream].
['mcz' ] -> [self installMCZ: aFileName from: aStream ].
['sar'] -> [self installSAR: aFileName from: aStream ].
}otherwise: [Error].
].selFile = fileList size]whileFalse.
	
	
	
	(Smalltalk classNamed: #ReleaseBuilderFor3dot10) current newUpdateFor: aBugNo
	
	
	!

----- Method: InstallerCruft>>evaluate: (in category 'mantis') -----
evaluate: stream

	stream fileIn.!

----- Method: InstallerCruft>>info (in category 'accessing') -----
info

	self sm ifTrue: [ ^ self smInfo  ].
	self wsm ifNotNil: [ ^ self wsmInfo  ].!

----- Method: InstallerCruft>>mczInstall: (in category 'monticello') -----
mczInstall: urlOrFile

	self log: ('Loading ', urlOrFile, ' ...').

	(urlOrFile beginsWith: 'http:')
		ifTrue: [  MczInstaller installStream: (HTTPSocket httpGet: urlOrFile) ]
		ifFalse: [ MczInstaller installFileNamed: urlOrFile ].
		
	self logCR: ' Loaded'.

	

!

----- Method: InstallerCruft>>preambleCsForRB: (in category 'mantis') -----
preambleCsForRB: aBugNo
"
Installer mantis preambleCsForRB: 5936.
"
	| page text   | 

	self setBug: aBugNo.
	
	page := self maPage.
 
	text := String streamContents: [ :str |	
			
		#('Reporter'  'Summary' 'Description' 'Additional Information' ) 
				do: [ :field |
						| f |
						f := self maRead: page field: field.
			str nextPutAll: f key; nextPutAll: ': '; nextPutAll: f value; cr.
		]
	].
 	
^ text	!

----- Method: InstallerCruft>>skipTests (in category 'mantis') -----
skipTests

!

----- Method: InstallerCruft>>viewUrl (in category 'utils') -----
viewUrl

	^Workspace new contents: (self urlGet contents); openLabel: self urlToDownload.
!

----- Method: JapaneseEnvironment>>setupSqueaklandSpecifics (in category '*45Deprecated-utilities') -----
setupSqueaklandSpecifics
	| server |
	ChangeSet current name: 'Unnamed' translated , '1'.
	ServerDirectory resetServers.
	server := SuperSwikiServer new type: #http;
				 server: 'squeakland.jp';
				 directory: '/super/SuperSwikiProj';
				 acceptsUploads: (Preferences eToyFriendly not);
				 encodingName: 'shift_jis'.
	ServerDirectory servers at: 'Squeakland.JP' put: server.
	Smalltalk garbageCollect!

----- Method: MethodDictionary>>methodArray (in category '*45Deprecated') -----
methodArray
	
	self deprecated: 'Use #array'.
	^array!

----- Method: Number>>isInf (in category '*45Deprecated') -----
isInf
	self deprecated: 'Use #isInfinite instead'.
	^self isInfinite!

----- Method: Utilities class>>addToTrash: (in category '*45Deprecated-scraps') -----
addToTrash: aMorph
	self deprecated: 'Use ScrapBook default >> #addToTrash:'.
	ScrapBook default addToTrash: aMorph.!

----- Method: Utilities class>>applyUpdatesFromDisk (in category '*45Deprecated-fetching updates') -----
applyUpdatesFromDisk
	self deprecated: 'Use UpdateStreamDownloader default >> #applyUpdatesFromDisk:'.
	^UpdateStreamDownloader default applyUpdatesFromDisk!

----- Method: Utilities class>>applyUpdatesFromDiskToUpdateNumber:stopIfGap: (in category '*45Deprecated-fetching updates') -----
applyUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag 
	self deprecated: 'Use UpdateStreamDownloader default >> #applyUpdatesFromDiskToUpdateNumber:stopIfGap:'.
	^UpdateStreamDownloader default applyUpdatesFromDiskToUpdateNumber: lastUpdateNumber stopIfGap: stopIfGapFlag !

----- Method: Utilities class>>assureAbsenceOfUnstableUpdateStream (in category '*45Deprecated-fetching updates') -----
assureAbsenceOfUnstableUpdateStream
	self deprecated: 'Use UpdateStreamDownloader default >> #assureAbsenceOfUnstableUpdateStream'.
	^UpdateStreamDownloader default assureAbsenceOfUnstableUpdateStream!

----- Method: Utilities class>>assureAvailabilityOfUnstableUpdateStream (in category '*45Deprecated-fetching updates') -----
assureAvailabilityOfUnstableUpdateStream
	self deprecated: 'Use UpdateStreamDownloader default >> #assureAvailabilityOfUnstableUpdateStream'.
	^UpdateStreamDownloader default assureAvailabilityOfUnstableUpdateStream!

----- Method: Utilities class>>broadcastUpdatesFrom:to:except: (in category '*45Deprecated-fetching updates') -----
broadcastUpdatesFrom: n1 to: n2 except: skipList
	self deprecated: 'Use UpdateStreamDownloader default >> #broadcastUpdatesFrom:to:except:'.
	^UpdateStreamDownloader default broadcastUpdatesFrom: n1 to: n2 except: skipList!

----- Method: Utilities class>>chooseUpdateList (in category '*45Deprecated-fetching updates') -----
chooseUpdateList
	self deprecated: 'Use UpdateStreamDownloader default >> #chooseUpdateList'.
	^UpdateStreamDownloader default chooseUpdateList!

----- Method: Utilities class>>classFromPattern:withCaption: (in category '*45Deprecated') -----
classFromPattern: pattern withCaption: aCaption
	self deprecated: 'Use UIManager >> #classFromPattern:withCaption:'.
	^ UIManager default classFromPattern: pattern withCaption: aCaption.!

----- Method: Utilities class>>classOrTraitFrom:pattern:label: (in category '*45Deprecated') -----
classOrTraitFrom: environment pattern: pattern label: label
	self deprecated: 'Use UIManager >> #classOrTraitFrom:pattern:label:'.
	^ UIManager default classOrTraitFrom: environment pattern: pattern label: label.!

----- Method: Utilities class>>emptyScrapsBook (in category '*45Deprecated-scraps') -----
emptyScrapsBook
	self deprecated: 'Use ScrapBook default emptyScrapBook'.
	ScrapBook default emptyScrapBook!

----- Method: Utilities class>>fileInFromUpdatesFolder: (in category '*45Deprecated-fetching updates') -----
fileInFromUpdatesFolder: numberList
	self deprecated: 'Use UpdateStreamDownloader default >> #fileInFromUpdatesFolder:'.
	^UpdateStreamDownloader default fileInFromUpdatesFolder: numberList!

----- Method: Utilities class>>getUpdateDirectoryOrNil (in category '*45Deprecated-fetching updates') -----
getUpdateDirectoryOrNil
	self deprecated: 'Use UpdateStreamDownloader default >> #getUpdateDirectoryOrNil'.
	^UpdateStreamDownloader default getUpdateDirectoryOrNil!

----- Method: Utilities class>>getterSelectorFor: (in category '*45Deprecated-etoys') -----
getterSelectorFor: identifier
	self deprecated: 'Use String >> #asSetterSelector'.
	^ identifier asGetterSelector.!

----- Method: Utilities class>>inherentSelectorForGetter: (in category '*45Deprecated-etoys') -----
inherentSelectorForGetter: aGetterSelector
	self deprecated: 'Use String >> inherentSelector'.
	^ aGetterSelector inherentSelector.!

----- Method: Utilities class>>lastUpdateNum: (in category '*45Deprecated-fetching updates') -----
lastUpdateNum: updatesFileStrm
	self deprecated: 'Use UpdateStreamDownloader default >> #lastUpdateNum:'.
	^UpdateStreamDownloader default lastUpdateNum: updatesFileStrm!

----- Method: Utilities class>>maybeEmptyTrash (in category '*45Deprecated-scraps') -----
maybeEmptyTrash
	self deprecated: 'Use ScrapBook >> #maybeEmptyTrash'.
	ScrapBook default maybeEmptyTrash.!

----- Method: Utilities class>>methodDiffFor:class:selector:prettyDiffs: (in category '*45Deprecated-miscellaneous') -----
methodDiffFor: aString class: aClass selector: aSelector prettyDiffs: prettyDiffBoolean
	"Return a string comprising a source-code diff between an existing method and the source-code in aString.  DO prettyDiff if prettyDiffBoolean is true."

	^ (aClass notNil and: [aClass includesSelector: aSelector])
		ifTrue:
			[TextDiffBuilder
				buildDisplayPatchFrom: (aClass sourceCodeAt: aSelector)
				to: aString
				inClass: aClass
				prettyDiffs: prettyDiffBoolean]
		ifFalse:
			[aString copy]!

----- Method: Utilities class>>newUpdatesOn:special:throughNumber: (in category '*45Deprecated-fetching updates') -----
newUpdatesOn: serverList special: indexPrefix throughNumber: aNumber
	self deprecated: 'Use UpdateStreamDownloader default >> #newUpdatesOn:special:throughNumber:'.
	^UpdateStreamDownloader default newUpdatesOn: serverList special: indexPrefix throughNumber: aNumber!

----- Method: Utilities class>>objectStrmFromUpdates: (in category '*45Deprecated-fetching updates') -----
objectStrmFromUpdates: fileName
	self deprecated: 'Use UpdateStreamDownloader default >> #objectStrmFromUpdates:'.
	^UpdateStreamDownloader default objectStrmFromUpdates: fileName!

----- Method: Utilities class>>parseListContents: (in category '*45Deprecated-fetching updates') -----
parseListContents: listContents
	self deprecated: 'Use UpdateStreamDownloader default >> #parseListContents:'.
	^UpdateStreamDownloader default parseListContents: listContents!

----- Method: Utilities class>>position:atVersion: (in category '*45Deprecated-fetching updates') -----
position: updateStrm atVersion: version
	self deprecated: 'Use UpdateStreamDownloader default >> #position:atVersion:'.
	^UpdateStreamDownloader default position: updateStrm atVersion: version!

----- Method: Utilities class>>readNextUpdateFromServer (in category '*45Deprecated-fetching updates') -----
readNextUpdateFromServer
	self deprecated: 'Use UpdateStreamDownloader default >> #readNextUpdateFromServer'.
	^UpdateStreamDownloader default readNextUpdateFromServer!

----- Method: Utilities class>>readNextUpdatesFromDisk: (in category '*45Deprecated-fetching updates') -----
readNextUpdatesFromDisk: n
	self deprecated: 'Use UpdateStreamDownloader default >> #readNextUpdatesFromDisk:'.
	^UpdateStreamDownloader default readNextUpdatesFromDisk: n!

----- Method: Utilities class>>readServer:special:updatesThrough:saveLocally:updateImage: (in category '*45Deprecated-fetching updates') -----
readServer: serverList special: indexPrefix updatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage
	self deprecated: 'Use UpdateStreamDownloader default >> #readServer:special:updatesThrough:saveLocally:updateImage:'.
	^UpdateStreamDownloader default readServer: serverList special: indexPrefix updatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage!

----- Method: Utilities class>>readServerUpdatesSaveLocally:updateImage: (in category '*45Deprecated-fetching updates') -----
readServerUpdatesSaveLocally: saveLocally updateImage: updateImage
	self deprecated: 'Use UpdateStreamDownloader default >> #readServerUpdatesSaveLocally:updateImage:'.
	^UpdateStreamDownloader default readServerUpdatesSaveLocally: saveLocally updateImage: updateImage!

----- Method: Utilities class>>readServerUpdatesThrough:saveLocally:updateImage: (in category '*45Deprecated-fetching updates') -----
readServerUpdatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage
	self deprecated: 'Use UpdateStreamDownloader default >> #readServerUpdatesThrough:saveLocally:updateImage:'.
	^UpdateStreamDownloader default readServerUpdatesThrough: maxNumber saveLocally: saveLocally updateImage: updateImage!

----- Method: Utilities class>>retrieveUrls:ontoQueue:withWaitSema: (in category '*45Deprecated-fetching updates') -----
retrieveUrls: urls ontoQueue: queue withWaitSema: waitSema 
	self deprecated: 'Use UpdateStreamDownloader default >> #retrieveUrls:ontoQueue:withWaitSema:'.
	^UpdateStreamDownloader default retrieveUrls: urls ontoQueue: queue withWaitSema: waitSema !

----- Method: Utilities class>>saveUpdate:onFile: (in category '*45Deprecated-fetching updates') -----
saveUpdate: doc onFile: fileName
	self deprecated: 'Use UpdateStreamDownloader default >> #saveUpdate:onFile:'.
	^UpdateStreamDownloader default saveUpdate: doc onFile: fileName!

----- Method: Utilities class>>scrapsBook (in category '*45Deprecated-scraps') -----
scrapsBook
	self deprecated: 'Use ScrapBook default scrapBook'.
	^ ScrapBook default scrapBook!

----- Method: Utilities class>>serverUrls (in category '*45Deprecated-fetching updates') -----
serverUrls 
	self deprecated: 'Use UpdateStreamDownloader default >> #serverUrls'.
	^UpdateStreamDownloader default serverUrls!

----- Method: Utilities class>>setUpdateServer: (in category '*45Deprecated-fetching updates') -----
setUpdateServer: groupName
	self deprecated: 'Use UpdateStreamDownloader default >> #setUpdateServer:'.
	^UpdateStreamDownloader default setUpdateServer: groupName!

----- Method: Utilities class>>setterSelectorFor: (in category '*45Deprecated-etoys') -----
setterSelectorFor: aName
	self deprecated: 'Use String >> #asSetterSelector'.
	^ aName asString asSetterSelector.!

----- Method: Utilities class>>simpleSetterFor: (in category '*45Deprecated-flaps') -----
simpleSetterFor: aSymbol
	self deprecated: 'Use Symbol >> #asSimpleSetter'.
	^ aSymbol asSimpleSetter.!

----- Method: Utilities class>>summariesForUpdates:through: (in category '*45Deprecated-fetching updates') -----
summariesForUpdates: startNumber through: stopNumber
	self deprecated: 'Use UpdateStreamDownloader default >> #summariesForUpdates:through:'.
	^UpdateStreamDownloader default summariesForUpdates: startNumber through: stopNumber!

----- Method: Utilities class>>updateFromServerThroughUpdateNumber: (in category '*45Deprecated-fetching updates') -----
updateFromServerThroughUpdateNumber: aNumber
	self deprecated: 'Use UpdateStreamDownloader default >> #updateFromServerThroughUpdateNumber:'.
	^UpdateStreamDownloader default updateFromServerThroughUpdateNumber: aNumber!

----- Method: Utilities class>>updateUrlLists (in category '*45Deprecated-fetching updates') -----
updateUrlLists
	self deprecated: 'Use UpdateStreamDownloader default >> #updateUrlLists'.
	^UpdateStreamDownloader default updateUrlLists!

----- Method: Utilities class>>writeList:toStream: (in category '*45Deprecated-fetching updates') -----
writeList: listContents toStream: strm
	self deprecated: 'Use UpdateStreamDownloader default >> #writeList:toStream:'.
	^UpdateStreamDownloader default writeList: listContents toStream: strm!

----- Method: Utilities class>>zapUpdateDownloader (in category '*45Deprecated-fetching updates') -----
zapUpdateDownloader
	self deprecated: 'Use UpdateStreamDownloader default >> #zapUpdateDownloader'.
	^UpdateStreamDownloader default zapUpdateDownloader!

----- Method: Preferences class>>browseToolClass (in category '*45Deprecated') -----
browseToolClass
	"This method is used for returning the appropiate class for the #browserShowsPackagePane preference. Now that preference modifies the registry so here we query directly to the registry"
	self deprecated: 'Use SystemBrowser default'.
	^ SystemBrowser default.!

----- Method: Preferences class>>soundEnablingString (in category '*45Deprecated') -----
soundEnablingString
	self deprecated: 'Ask the sound service for this'.
	^ SoundService soundEnablingString!

----- Method: Preferences class>>toggleSoundEnabling (in category '*45Deprecated') -----
toggleSoundEnabling
	self deprecated: 'Now uses pragma preference, and is stored in SoundService'.
    SoundService toggleSoundEnabled!



More information about the Squeak-dev mailing list